    -----------------------------------------------------------------------------
    -- |
    -- Module      :  MacroPass
    -- Copyright   :  2004 Malcolm Wallace
    -- Licence     :  LGPL
    --
    -- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
    -- Stability   :  experimental
    -- Portability :  All
    --
    -- Perform a cpp.second-pass, accumulating \#define's and \#undef's,
    -- whilst doing symbol replacement and macro expansion.
    -----------------------------------------------------------------------------

    module Language.Preprocessor.Cpphs.MacroPass
      ( macroPass
      , preDefine
      , defineMacro
      , macroPassReturningSymTab
      ) where

    import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro
                                                  , simplifyHashDefines)
    import Language.Preprocessor.Cpphs.Tokenise   (tokenise, WordStyle(..)
                                                  , parseMacroCall)
    import Language.Preprocessor.Cpphs.SymTab     (SymTab, lookupST, insertST
                                                  , emptyST, flattenST)
    import Language.Preprocessor.Cpphs.Position   (Posn, newfile, filename, lineno)
    import Language.Preprocessor.Cpphs.Options    (BoolOptions(..))
    import System.IO.Unsafe (unsafeInterleaveIO)
    import Control.Monad    ((=<<))
    --import System.Time       (getClockTime, toCalendarTime, formatCalendarTime)
    import Data.Time.Clock  (getCurrentTime)
    import Data.Time.Format (formatTime)
    import TimeCompat       (defaultTimeLocale)

    noPos :: Posn
    noPos :: Posn
    noPos = String -> Posn
    newfile String
    "preDefined"

    -- | Walk through the document, replacing calls of macros with the expanded RHS.
    macroPass :: [(String,String)]  -- ^ Pre-defined symbols and their values
              -> BoolOptions        -- ^ Options that alter processing style
              -> [(Posn,String)]    -- ^ The input file content
              -> IO String          -- ^ The file after processing
    macroPass :: [(String, String)] -> BoolOptions -> [(Posn, String)] -> IO String
    macroPass [(String, String)]
    syms BoolOptions
    options =
        ([Either (SymTab HashDefine) String] -> String)
    -> IO [Either (SymTab HashDefine) String] -> IO String
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> String
    forall {a}. [a] -> [a]
    safetail              -- to remove extra "\n" inserted below
             (String -> String)
    -> ([Either (SymTab HashDefine) String] -> String)
    -> [Either (SymTab HashDefine) String]
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
             ([String] -> String)
    -> ([Either (SymTab HashDefine) String] -> [String])
    -> [Either (SymTab HashDefine) String]
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either (SymTab HashDefine) String] -> [String]
    forall a b. [Either a b] -> [b]
    onlyRights)
        (IO [Either (SymTab HashDefine) String] -> IO String)
    -> ([(Posn, String)] -> IO [Either (SymTab HashDefine) String])
    -> [(Posn, String)]
    -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess (BoolOptions -> Bool
    pragma BoolOptions
    options) (BoolOptions -> Bool
    layout BoolOptions
    options) (BoolOptions -> Bool
    lang BoolOptions
    options)
                       (BoolOptions -> [(String, String)] -> SymTab HashDefine
    preDefine BoolOptions
    options [(String, String)]
    syms)
        ([WordStyle] -> IO [Either (SymTab HashDefine) String])
    -> ([(Posn, String)] -> [WordStyle])
    -> [(Posn, String)]
    -> IO [Either (SymTab HashDefine) String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool -> Bool -> Bool -> [(Posn, String)] -> [WordStyle]
    tokenise (BoolOptions -> Bool
    stripEol BoolOptions
    options) (BoolOptions -> Bool
    stripC89 BoolOptions
    options)
                   (BoolOptions -> Bool
    ansi BoolOptions
    options) (BoolOptions -> Bool
    lang BoolOptions
    options)
        ([(Posn, String)] -> [WordStyle])
    -> ([(Posn, String)] -> [(Posn, String)])
    -> [(Posn, String)]
    -> [WordStyle]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Posn
    noPos,String
    "")(Posn, String) -> [(Posn, String)] -> [(Posn, String)]
    forall a. a -> [a] -> [a]
    :)     -- ensure recognition of "\n#" at start of file
      where
        safetail :: [a] -> [a]
    safetail [] = []
        safetail (a
    _:[a]
    xs) = [a]
    xs

    -- | auxiliary
    onlyRights :: [Either a b] -> [b]
    onlyRights :: forall a b. [Either a b] -> [b]
    onlyRights = (Either a b -> [b]) -> [Either a b] -> [b]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\Either a b
    x->case Either a b
    x of Right b
    t-> [b
    t]; Left a
    _-> [];)

    -- | Walk through the document, replacing calls of macros with the expanded RHS.
    --   Additionally returns the active symbol table after processing.
    macroPassReturningSymTab
              :: [(String,String)]  -- ^ Pre-defined symbols and their values
              -> BoolOptions        -- ^ Options that alter processing style
              -> [(Posn,String)]    -- ^ The input file content
              -> IO (String,[(String,String)])
                                    -- ^ The file and symbol table after processing
    macroPassReturningSymTab :: [(String, String)]
    -> BoolOptions
    -> [(Posn, String)]
    -> IO (String, [(String, String)])
    macroPassReturningSymTab [(String, String)]
    syms BoolOptions
    options =
        ([Either (SymTab HashDefine) String]
     -> (String, [(String, String)]))
    -> IO [Either (SymTab HashDefine) String]
    -> IO (String, [(String, String)])
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([String] -> String)
    -> ([String], [(String, String)]) -> (String, [(String, String)])
    forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
    mapFst (String -> String
    forall {a}. [a] -> [a]
    safetail              -- to remove extra "\n" inserted below
                     (String -> String) -> ([String] -> String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat)
             (([String], [(String, String)]) -> (String, [(String, String)]))
    -> ([Either (SymTab HashDefine) String]
        -> ([String], [(String, String)]))
    -> [Either (SymTab HashDefine) String]
    -> (String, [(String, String)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either (SymTab HashDefine) String]
    -> ([String], [(String, String)])
    forall {a}.
    [Either (SymTab HashDefine) a] -> ([a], [(String, String)])
    walk)
        (IO [Either (SymTab HashDefine) String]
     -> IO (String, [(String, String)]))
    -> ([(Posn, String)] -> IO [Either (SymTab HashDefine) String])
    -> [(Posn, String)]
    -> IO (String, [(String, String)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess (BoolOptions -> Bool
    pragma BoolOptions
    options) (BoolOptions -> Bool
    layout BoolOptions
    options) (BoolOptions -> Bool
    lang BoolOptions
    options)
                       (BoolOptions -> [(String, String)] -> SymTab HashDefine
    preDefine BoolOptions
    options [(String, String)]
    syms)
        ([WordStyle] -> IO [Either (SymTab HashDefine) String])
    -> ([(Posn, String)] -> [WordStyle])
    -> [(Posn, String)]
    -> IO [Either (SymTab HashDefine) String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool -> Bool -> Bool -> [(Posn, String)] -> [WordStyle]
    tokenise (BoolOptions -> Bool
    stripEol BoolOptions
    options) (BoolOptions -> Bool
    stripC89 BoolOptions
    options)
                   (BoolOptions -> Bool
    ansi BoolOptions
    options) (BoolOptions -> Bool
    lang BoolOptions
    options)
        ([(Posn, String)] -> [WordStyle])
    -> ([(Posn, String)] -> [(Posn, String)])
    -> [(Posn, String)]
    -> [WordStyle]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Posn
    noPos,String
    "")(Posn, String) -> [(Posn, String)] -> [(Posn, String)]
    forall a. a -> [a] -> [a]
    :)     -- ensure recognition of "\n#" at start of file
      where
        safetail :: [a] -> [a]
    safetail [] = []
        safetail (a
    _:[a]
    xs) = [a]
    xs
        walk :: [Either (SymTab HashDefine) a] -> ([a], [(String, String)])
    walk (Right a
    x: [Either (SymTab HashDefine) a]
    rest) = let ([a]
    xs,   [(String, String)]
    foo) = [Either (SymTab HashDefine) a] -> ([a], [(String, String)])
    walk [Either (SymTab HashDefine) a]
    rest
                               in  (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs, [(String, String)]
    foo)
        walk (Left  SymTab HashDefine
    x: [])   =     ( [] , [HashDefine] -> [(String, String)]
    simplifyHashDefines (SymTab HashDefine -> [HashDefine]
    forall v. SymTab v -> [v]
    flattenST SymTab HashDefine
    x) )
        walk (Left  SymTab HashDefine
    x: [Either (SymTab HashDefine) a]
    rest) = [Either (SymTab HashDefine) a] -> ([a], [(String, String)])
    walk [Either (SymTab HashDefine) a]
    rest
        mapFst :: (t -> a) -> (t, b) -> (a, b)
    mapFst t -> a
    f (t
    a,b
    b) = (t -> a
    f t
    a, b
    b)

    -- | Turn command-line definitions (from @-D@) into 'HashDefine's.
    preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine
    preDefine :: BoolOptions -> [(String, String)] -> SymTab HashDefine
    preDefine BoolOptions
    options [(String, String)]
    defines =
        ((String, String) -> SymTab HashDefine -> SymTab HashDefine)
    -> SymTab HashDefine -> [(String, String)] -> SymTab HashDefine
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((String, HashDefine) -> SymTab HashDefine -> SymTab HashDefine
    forall v. (String, v) -> SymTab v -> SymTab v
    insertST ((String, HashDefine) -> SymTab HashDefine -> SymTab HashDefine)
    -> ((String, String) -> (String, HashDefine))
    -> (String, String)
    -> SymTab HashDefine
    -> SymTab HashDefine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BoolOptions -> String -> (String, HashDefine)
    defineMacro BoolOptions
    options (String -> (String, HashDefine))
    -> ((String, String) -> String)
    -> (String, String)
    -> (String, HashDefine)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\ (String
    s,String
    d)-> String
    sString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    d))
              SymTab HashDefine
    forall v. SymTab v
    emptyST [(String, String)]
    defines

    -- | Turn a string representing a macro definition into a 'HashDefine'.
    defineMacro :: BoolOptions -> String -> (String,HashDefine)
    defineMacro :: BoolOptions -> String -> (String, HashDefine)
    defineMacro BoolOptions
    opts String
    s =
        let (Cmd (Just HashDefine
    hd):[WordStyle]
    _) = Bool -> Bool -> Bool -> Bool -> [(Posn, String)] -> [WordStyle]
    tokenise Bool
    True Bool
    True (BoolOptions -> Bool
    ansi BoolOptions
    opts) (BoolOptions -> Bool
    lang BoolOptions
    opts)
                                         [(Posn
    noPos,String
    "\n#define "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    sString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "\n")]
        in (HashDefine -> String
    name HashDefine
    hd, HashDefine
    hd)

    -- | Trundle through the document, one word at a time, using the WordStyle
    --   classification introduced by 'tokenise' to decide whether to expand a
    --   word or macro.  Encountering a \#define or \#undef causes that symbol to
    --   be overwritten in the symbol table.  Any other remaining cpp directives
    --   are discarded and replaced with blanks, except for \#line markers.
    --   All valid identifiers are checked for the presence of a definition
    --   of that name in the symbol table, and if so, expanded appropriately.
    --   (Bool arguments are: keep pragmas?  retain layout?  haskell language?)
    --   The result lazily intersperses output text with symbol tables.  Lines
    --   are emitted as they are encountered.  A symbol table is emitted after
    --   each change to the defined symbols, and always at the end of processing.
    macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle]
                 -> IO [Either (SymTab HashDefine) String]
    macroProcess :: Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    _ Bool
    _ Bool
    _ SymTab HashDefine
    st        []          = [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [SymTab HashDefine -> Either (SymTab HashDefine) String
    forall a b. a -> Either a b
    Left SymTab HashDefine
    st]
    macroProcess Bool
    p Bool
    y Bool
    l SymTab HashDefine
    st (Other String
    x: [WordStyle]
    ws)      = String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    x    (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    p Bool
    y Bool
    l SymTab HashDefine
    st [WordStyle]
    ws
    macroProcess Bool
    p Bool
    y Bool
    l SymTab HashDefine
    st (Cmd Maybe HashDefine
    Nothing: [WordStyle]
    ws)  = String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    "\n" (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    p Bool
    y Bool
    l SymTab HashDefine
    st [WordStyle]
    ws
    macroProcess Bool
    p Bool
    y Bool
    l SymTab HashDefine
    st (Cmd (Just (LineDrop String
    x)): [WordStyle]
    ws)
                                             = String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    "\n" (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $
                                               String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    x    (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    p Bool
    y Bool
    l SymTab HashDefine
    st [WordStyle]
    ws
    macroProcess Bool
    pragma Bool
    y Bool
    l SymTab HashDefine
    st (Cmd (Just (Pragma String
    x)): [WordStyle]
    ws)
                   | Bool
    pragma    = String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    "\n" (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    x (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pragma Bool
    y Bool
    l SymTab HashDefine
    st [WordStyle]
    ws
                   | Bool
    otherwise = String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    "\n" (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $          Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pragma Bool
    y Bool
    l SymTab HashDefine
    st [WordStyle]
    ws
    macroProcess Bool
    p Bool
    layout Bool
    lang SymTab HashDefine
    st (Cmd (Just HashDefine
    hd): [WordStyle]
    ws) =
        let n :: Int
    n = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + HashDefine -> Int
    linebreaks HashDefine
    hd
            newST :: SymTab HashDefine
    newST = (String, HashDefine) -> SymTab HashDefine -> SymTab HashDefine
    forall v. (String, v) -> SymTab v -> SymTab v
    insertST (HashDefine -> String
    name HashDefine
    hd, HashDefine
    hd) SymTab HashDefine
    st
        in
        String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    n Char
    '\n') (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $
        SymTab HashDefine
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall b a. b -> IO [Either b a] -> IO [Either b a]
    emitSymTab SymTab HashDefine
    newST (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $
        Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    p Bool
    layout Bool
    lang SymTab HashDefine
    newST [WordStyle]
    ws
    macroProcess Bool
    pr Bool
    layout Bool
    lang SymTab HashDefine
    st (Ident Posn
    p String
    x: [WordStyle]
    ws) =
        case String
    x of
          String
    "__FILE__" -> String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit (String -> String
    forall a. Show a => a -> String
    show (Posn -> String
    filename Posn
    p))(IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pr Bool
    layout Bool
    lang SymTab HashDefine
    st [WordStyle]
    ws
          String
    "__LINE__" -> String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit (Int -> String
    forall a. Show a => a -> String
    show (Posn -> Int
    lineno Posn
    p))  (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pr Bool
    layout Bool
    lang SymTab HashDefine
    st [WordStyle]
    ws
          String
    "__DATE__" -> do w <- String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String)
    -> (UTCTime -> String) -> UTCTime -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                             -- formatCalendarTime defaultTimeLocale "\"%d %b %Y\""
                             -- =<< toCalendarTime =<< getClockTime
                                TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "\"%d %b %Y\""
                                (UTCTime -> IO String) -> IO UTCTime -> IO String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO UTCTime
    getCurrentTime
                           emit w $ macroProcess pr layout lang st ws
          String
    "__TIME__" -> do w <- String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String)
    -> (UTCTime -> String) -> UTCTime -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                             -- formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""
                             -- =<< toCalendarTime =<< getClockTime
                                TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "\"%H:%M:%S\""
                                (UTCTime -> IO String) -> IO UTCTime -> IO String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO UTCTime
    getCurrentTime
                           emit w $ macroProcess pr layout lang st ws
          String
    _ ->
            case String -> SymTab HashDefine -> Maybe HashDefine
    forall v. String -> SymTab v -> Maybe v
    lookupST String
    x SymTab HashDefine
    st of
                Maybe HashDefine
    Nothing -> String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    x (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pr Bool
    layout Bool
    lang SymTab HashDefine
    st [WordStyle]
    ws
                Just HashDefine
    hd ->
                    case HashDefine
    hd of
                        AntiDefined {name :: HashDefine -> String
    name=String
    n} -> String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    n (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $
                                                Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pr Bool
    layout Bool
    lang SymTab HashDefine
    st [WordStyle]
    ws
                        SymbolReplacement {replacement :: HashDefine -> String
    replacement=String
    r} ->
                            let r' :: String
    r' = if Bool
    layout then String
    r else (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '\n') String
    r in
                            -- one-level expansion only:
                            -- emit r' $ macroProcess layout st ws
                            -- multi-level expansion:
                            Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pr Bool
    layout Bool
    lang SymTab HashDefine
    st
                                         (Bool -> Bool -> Bool -> Bool -> [(Posn, String)] -> [WordStyle]
    tokenise Bool
    True Bool
    True Bool
    False Bool
    lang [(Posn
    p,String
    r')]
                                          [WordStyle] -> [WordStyle] -> [WordStyle]
    forall a. [a] -> [a] -> [a]
    ++ [WordStyle]
    ws)
                        MacroExpansion {} ->
                            case Posn -> [WordStyle] -> Maybe ([[WordStyle]], [WordStyle])
    parseMacroCall Posn
    p [WordStyle]
    ws of
                                Maybe ([[WordStyle]], [WordStyle])
    Nothing -> String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    x (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $
                                           Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pr Bool
    layout Bool
    lang SymTab HashDefine
    st [WordStyle]
    ws
                                Just ([[WordStyle]]
    args,[WordStyle]
    ws') ->
                                    if [[WordStyle]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[WordStyle]]
    args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (HashDefine -> [String]
    arguments HashDefine
    hd) then
                                         String
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit String
    x (IO [Either (SymTab HashDefine) String]
     -> IO [Either (SymTab HashDefine) String])
    -> IO [Either (SymTab HashDefine) String]
    -> IO [Either (SymTab HashDefine) String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pr Bool
    layout Bool
    lang SymTab HashDefine
    st [WordStyle]
    ws
                                    else do args' <- ([WordStyle] -> IO String) -> [[WordStyle]] -> IO [String]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (([Either (SymTab HashDefine) String] -> String)
    -> IO [Either (SymTab HashDefine) String] -> IO String
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String)
    -> ([Either (SymTab HashDefine) String] -> [String])
    -> [Either (SymTab HashDefine) String]
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either (SymTab HashDefine) String] -> [String]
    forall a b. [Either a b] -> [b]
    onlyRights)
                                                           (IO [Either (SymTab HashDefine) String] -> IO String)
    -> ([WordStyle] -> IO [Either (SymTab HashDefine) String])
    -> [WordStyle]
    -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool
    -> Bool
    -> Bool
    -> SymTab HashDefine
    -> [WordStyle]
    -> IO [Either (SymTab HashDefine) String]
    macroProcess Bool
    pr Bool
    layout
                                                                            Bool
    lang SymTab HashDefine
    st)
                                                          [[WordStyle]]
    args
                                            -- one-level expansion only:
                                            -- emit (expandMacro hd args' layout) $
                                            --         macroProcess layout st ws'
                                            -- multi-level expansion:
                                            macroProcess pr layout lang st
                                                (tokenise True True False lang
                                                   [(p,expandMacro hd args' layout)]
                                                ++ ws')

    -- | Useful helper function.
    emit :: a -> IO [Either b a] -> IO [Either b a]
    emit :: forall a b. a -> IO [Either b a] -> IO [Either b a]
    emit a
    x IO [Either b a]
    io = do xs <- IO [Either b a] -> IO [Either b a]
    forall a. IO a -> IO a
    unsafeInterleaveIO IO [Either b a]
    io
                   return (Right x:xs)
    -- | Useful helper function.
    emitSymTab :: b -> IO [Either b a] -> IO [Either b a]
    emitSymTab :: forall b a. b -> IO [Either b a] -> IO [Either b a]
    emitSymTab b
    x IO [Either b a]
    io = do xs <- IO [Either b a] -> IO [Either b a]
    forall a. IO a -> IO a
    unsafeInterleaveIO IO [Either b a]
    io
                         return (Left x:xs)