-----------------------------------------------------------------------------
-- |
-- 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 = [Char] -> Posn
newfile [Char]
"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 :: [([Char], [Char])] -> BoolOptions -> [(Posn, [Char])] -> IO [Char]
macroPass [([Char], [Char])]
syms BoolOptions
options =
    ([Either (SymTab HashDefine) [Char]] -> [Char])
-> IO [Either (SymTab HashDefine) [Char]] -> IO [Char]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char]
forall {a}. [a] -> [a]
safetail              -- to remove extra "\n" inserted below
         ([Char] -> [Char])
-> ([Either (SymTab HashDefine) [Char]] -> [Char])
-> [Either (SymTab HashDefine) [Char]]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
         ([[Char]] -> [Char])
-> ([Either (SymTab HashDefine) [Char]] -> [[Char]])
-> [Either (SymTab HashDefine) [Char]]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (SymTab HashDefine) [Char]] -> [[Char]]
forall a b. [Either a b] -> [b]
onlyRights)
    (IO [Either (SymTab HashDefine) [Char]] -> IO [Char])
-> ([(Posn, [Char])] -> IO [Either (SymTab HashDefine) [Char]])
-> [(Posn, [Char])]
-> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
macroProcess (BoolOptions -> Bool
pragma BoolOptions
options) (BoolOptions -> Bool
layout BoolOptions
options) (BoolOptions -> Bool
lang BoolOptions
options)
                   (BoolOptions -> [([Char], [Char])] -> SymTab HashDefine
preDefine BoolOptions
options [([Char], [Char])]
syms)
    ([WordStyle] -> IO [Either (SymTab HashDefine) [Char]])
-> ([(Posn, [Char])] -> [WordStyle])
-> [(Posn, [Char])]
-> IO [Either (SymTab HashDefine) [Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> Bool -> Bool -> [(Posn, [Char])] -> [WordStyle]
tokenise (BoolOptions -> Bool
stripEol BoolOptions
options) (BoolOptions -> Bool
stripC89 BoolOptions
options)
               (BoolOptions -> Bool
ansi BoolOptions
options) (BoolOptions -> Bool
lang BoolOptions
options)
    ([(Posn, [Char])] -> [WordStyle])
-> ([(Posn, [Char])] -> [(Posn, [Char])])
-> [(Posn, [Char])]
-> [WordStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Posn
noPos,[Char]
"")(Posn, [Char]) -> [(Posn, [Char])] -> [(Posn, [Char])]
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 :: [([Char], [Char])]
-> BoolOptions
-> [(Posn, [Char])]
-> IO ([Char], [([Char], [Char])])
macroPassReturningSymTab [([Char], [Char])]
syms BoolOptions
options =
    ([Either (SymTab HashDefine) [Char]]
 -> ([Char], [([Char], [Char])]))
-> IO [Either (SymTab HashDefine) [Char]]
-> IO ([Char], [([Char], [Char])])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([[Char]] -> [Char])
-> ([[Char]], [([Char], [Char])]) -> ([Char], [([Char], [Char])])
forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
mapFst ([Char] -> [Char]
forall {a}. [a] -> [a]
safetail              -- to remove extra "\n" inserted below
                 ([Char] -> [Char]) -> ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
         (([[Char]], [([Char], [Char])]) -> ([Char], [([Char], [Char])]))
-> ([Either (SymTab HashDefine) [Char]]
    -> ([[Char]], [([Char], [Char])]))
-> [Either (SymTab HashDefine) [Char]]
-> ([Char], [([Char], [Char])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (SymTab HashDefine) [Char]]
-> ([[Char]], [([Char], [Char])])
forall {a}.
[Either (SymTab HashDefine) a] -> ([a], [([Char], [Char])])
walk)
    (IO [Either (SymTab HashDefine) [Char]]
 -> IO ([Char], [([Char], [Char])]))
-> ([(Posn, [Char])] -> IO [Either (SymTab HashDefine) [Char]])
-> [(Posn, [Char])]
-> IO ([Char], [([Char], [Char])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
macroProcess (BoolOptions -> Bool
pragma BoolOptions
options) (BoolOptions -> Bool
layout BoolOptions
options) (BoolOptions -> Bool
lang BoolOptions
options)
                   (BoolOptions -> [([Char], [Char])] -> SymTab HashDefine
preDefine BoolOptions
options [([Char], [Char])]
syms)
    ([WordStyle] -> IO [Either (SymTab HashDefine) [Char]])
-> ([(Posn, [Char])] -> [WordStyle])
-> [(Posn, [Char])]
-> IO [Either (SymTab HashDefine) [Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> Bool -> Bool -> [(Posn, [Char])] -> [WordStyle]
tokenise (BoolOptions -> Bool
stripEol BoolOptions
options) (BoolOptions -> Bool
stripC89 BoolOptions
options)
               (BoolOptions -> Bool
ansi BoolOptions
options) (BoolOptions -> Bool
lang BoolOptions
options)
    ([(Posn, [Char])] -> [WordStyle])
-> ([(Posn, [Char])] -> [(Posn, [Char])])
-> [(Posn, [Char])]
-> [WordStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Posn
noPos,[Char]
"")(Posn, [Char]) -> [(Posn, [Char])] -> [(Posn, [Char])]
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], [([Char], [Char])])
walk (Right a
x: [Either (SymTab HashDefine) a]
rest) = let ([a]
xs,   [([Char], [Char])]
foo) = [Either (SymTab HashDefine) a] -> ([a], [([Char], [Char])])
walk [Either (SymTab HashDefine) a]
rest
                           in  (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, [([Char], [Char])]
foo)
    walk (Left  SymTab HashDefine
x: [])   =     ( [] , [HashDefine] -> [([Char], [Char])]
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], [([Char], [Char])])
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 -> [([Char], [Char])] -> SymTab HashDefine
preDefine BoolOptions
options [([Char], [Char])]
defines =
    (([Char], [Char]) -> SymTab HashDefine -> SymTab HashDefine)
-> SymTab HashDefine -> [([Char], [Char])] -> 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 (([Char], HashDefine) -> SymTab HashDefine -> SymTab HashDefine
forall v. ([Char], v) -> SymTab v -> SymTab v
insertST (([Char], HashDefine) -> SymTab HashDefine -> SymTab HashDefine)
-> (([Char], [Char]) -> ([Char], HashDefine))
-> ([Char], [Char])
-> SymTab HashDefine
-> SymTab HashDefine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolOptions -> [Char] -> ([Char], HashDefine)
defineMacro BoolOptions
options ([Char] -> ([Char], HashDefine))
-> (([Char], [Char]) -> [Char])
-> ([Char], [Char])
-> ([Char], HashDefine)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ ([Char]
s,[Char]
d)-> [Char]
s[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
d))
          SymTab HashDefine
forall v. SymTab v
emptyST [([Char], [Char])]
defines

-- | Turn a string representing a macro definition into a 'HashDefine'.
defineMacro :: BoolOptions -> String -> (String,HashDefine)
defineMacro :: BoolOptions -> [Char] -> ([Char], HashDefine)
defineMacro BoolOptions
opts [Char]
s =
    let (Cmd (Just HashDefine
hd):[WordStyle]
_) = Bool -> Bool -> Bool -> Bool -> [(Posn, [Char])] -> [WordStyle]
tokenise Bool
True Bool
True (BoolOptions -> Bool
ansi BoolOptions
opts) (BoolOptions -> Bool
lang BoolOptions
opts)
                                     [(Posn
noPos,[Char]
"\n#define "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
s[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n")]
    in (HashDefine -> [Char]
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) [Char]]
macroProcess Bool
_ Bool
_ Bool
_ SymTab HashDefine
st        []          = [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [SymTab HashDefine -> Either (SymTab HashDefine) [Char]
forall a b. a -> Either a b
Left SymTab HashDefine
st]
macroProcess Bool
p Bool
y Bool
l SymTab HashDefine
st (Other [Char]
x: [WordStyle]
ws)      = [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
x    (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
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)  = [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
"\n" (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
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 [Char]
x)): [WordStyle]
ws)
                                         = [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
"\n" (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$
                                           [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
x    (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
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 [Char]
x)): [WordStyle]
ws)
               | Bool
pragma    = [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
"\n" (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
x (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
macroProcess Bool
pragma Bool
y Bool
l SymTab HashDefine
st [WordStyle]
ws
               | Bool
otherwise = [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
"\n" (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$          Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
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 = ([Char], HashDefine) -> SymTab HashDefine -> SymTab HashDefine
forall v. ([Char], v) -> SymTab v -> SymTab v
insertST (HashDefine -> [Char]
name HashDefine
hd, HashDefine
hd) SymTab HashDefine
st
    in
    [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
n Char
'\n') (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$
    SymTab HashDefine
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall b a. b -> IO [Either b a] -> IO [Either b a]
emitSymTab SymTab HashDefine
newST (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$
    Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
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 [Char]
x: [WordStyle]
ws) =
    case [Char]
x of
      [Char]
"__FILE__" -> [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit ([Char] -> [Char]
forall a. Show a => a -> [Char]
show (Posn -> [Char]
filename Posn
p))(IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
macroProcess Bool
pr Bool
layout Bool
lang SymTab HashDefine
st [WordStyle]
ws
      [Char]
"__LINE__" -> [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit (Int -> [Char]
forall a. Show a => a -> [Char]
show (Posn -> Int
lineno Posn
p))  (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
macroProcess Bool
pr Bool
layout Bool
lang SymTab HashDefine
st [WordStyle]
ws
      [Char]
"__DATE__" -> do w <- [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char])
-> (UTCTime -> [Char]) -> UTCTime -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         -- formatCalendarTime defaultTimeLocale "\"%d %b %Y\""
                         -- =<< toCalendarTime =<< getClockTime
                            TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"\"%d %b %Y\""
                            (UTCTime -> IO [Char]) -> IO UTCTime -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
                       emit w $ macroProcess pr layout lang st ws
      [Char]
"__TIME__" -> do w <- [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char])
-> (UTCTime -> [Char]) -> UTCTime -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         -- formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""
                         -- =<< toCalendarTime =<< getClockTime
                            TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"\"%H:%M:%S\""
                            (UTCTime -> IO [Char]) -> IO UTCTime -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
                       emit w $ macroProcess pr layout lang st ws
      [Char]
_ ->
        case [Char] -> SymTab HashDefine -> Maybe HashDefine
forall v. [Char] -> SymTab v -> Maybe v
lookupST [Char]
x SymTab HashDefine
st of
            Maybe HashDefine
Nothing -> [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
x (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
macroProcess Bool
pr Bool
layout Bool
lang SymTab HashDefine
st [WordStyle]
ws
            Just HashDefine
hd ->
                case HashDefine
hd of
                    AntiDefined {name :: HashDefine -> [Char]
name=[Char]
n} -> [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
n (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$
                                            Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
macroProcess Bool
pr Bool
layout Bool
lang SymTab HashDefine
st [WordStyle]
ws
                    SymbolReplacement {replacement :: HashDefine -> [Char]
replacement=[Char]
r} ->
                        let r' :: [Char]
r' = if Bool
layout then [Char]
r else (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') [Char]
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) [Char]]
macroProcess Bool
pr Bool
layout Bool
lang SymTab HashDefine
st
                                     (Bool -> Bool -> Bool -> Bool -> [(Posn, [Char])] -> [WordStyle]
tokenise Bool
True Bool
True Bool
False Bool
lang [(Posn
p,[Char]
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 -> [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
x (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$
                                       Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
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
/= [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HashDefine -> [[Char]]
arguments HashDefine
hd) then
                                     [Char]
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. a -> IO [Either b a] -> IO [Either b a]
emit [Char]
x (IO [Either (SymTab HashDefine) [Char]]
 -> IO [Either (SymTab HashDefine) [Char]])
-> IO [Either (SymTab HashDefine) [Char]]
-> IO [Either (SymTab HashDefine) [Char]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
macroProcess Bool
pr Bool
layout Bool
lang SymTab HashDefine
st [WordStyle]
ws
                                else do args' <- ([WordStyle] -> IO [Char]) -> [[WordStyle]] -> IO [[Char]]
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) [Char]] -> [Char])
-> IO [Either (SymTab HashDefine) [Char]] -> IO [Char]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ([Either (SymTab HashDefine) [Char]] -> [[Char]])
-> [Either (SymTab HashDefine) [Char]]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (SymTab HashDefine) [Char]] -> [[Char]]
forall a b. [Either a b] -> [b]
onlyRights)
                                                       (IO [Either (SymTab HashDefine) [Char]] -> IO [Char])
-> ([WordStyle] -> IO [Either (SymTab HashDefine) [Char]])
-> [WordStyle]
-> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Bool
-> Bool
-> SymTab HashDefine
-> [WordStyle]
-> IO [Either (SymTab HashDefine) [Char]]
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)