module Language.Preprocessor.Cpphs.MacroPass
( macroPass
, preDefine
) where
import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro)
import Language.Preprocessor.Cpphs.Tokenise (tokenise, WordStyle(..), parseMacroCall)
import Language.Preprocessor.Cpphs.SymTab (SymTab, lookupST, insertST, emptyST)
import Language.Preprocessor.Cpphs.Position (Posn, newfile, filename, lineno)
import System.IO.Unsafe (unsafePerformIO)
import Time (getClockTime, toCalendarTime, formatCalendarTime)
import Locale (defaultTimeLocale)
noPos :: Posn
noPos = newfile "preDefined"
macroPass :: [(String,String)]
-> Bool
-> Bool
-> Bool
-> Bool
-> [(Posn,String)]
-> String
macroPass syms strip hashes layout language =
safetail
. concat
. macroProcess layout language (preDefine hashes language syms)
. tokenise strip hashes language
. ((noPos,""):)
where
safetail [] = []
safetail (_:xs) = xs
preDefine :: Bool -> Bool -> [(String,String)] -> SymTab HashDefine
preDefine hashes lang defines =
foldr (insertST.defval) emptyST defines
where
defval (s,d) =
let (Cmd (Just hd):_) = tokenise True hashes lang
[(noPos,"\n#define "++s++" "++d++"\n")]
in (name hd, hd)
macroProcess :: Bool -> Bool -> SymTab HashDefine -> [WordStyle] -> [String]
macroProcess _ _ _ [] = []
macroProcess y l st (Other x: ws) = x: macroProcess y l st ws
macroProcess y l st (Cmd Nothing: ws) = "\n": macroProcess y l st ws
macroProcess y l st (Cmd (Just (LineDrop x)): ws)= "\n":x:macroProcess y l st ws
macroProcess layout lang st (Cmd (Just hd): ws) =
let n = 1 + linebreaks hd in
replicate n "\n" ++ macroProcess layout lang (insertST (name hd, hd) st) ws
macroProcess layout lang st (Ident p x: ws) =
case x of
"__FILE__" -> show (filename p): macroProcess layout lang st ws
"__LINE__" -> show (lineno p): macroProcess layout lang st ws
"__DATE__" -> formatCalendarTime defaultTimeLocale "\"%d %b %Y\""
(unsafePerformIO (getClockTime>>=toCalendarTime)):
macroProcess layout lang st ws
"__TIME__" -> formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""
(unsafePerformIO (getClockTime>>=toCalendarTime)):
macroProcess layout lang st ws
_ ->
case lookupST x st of
Nothing -> x: macroProcess layout lang st ws
Just hd ->
case hd of
SymbolReplacement _ r _ ->
let r' = if layout then r else filter (/='\n') r in
macroProcess layout lang st
(tokenise True False lang [(p,r')]
++ ws)
MacroExpansion _ _ _ _ ->
case parseMacroCall ws of
Nothing -> x: macroProcess layout lang st ws
Just (args,ws') ->
if length args /= length (arguments hd) then
x: macroProcess layout lang st ws
else
macroProcess layout lang st
(tokenise True False lang
[(p,expandMacro hd args layout)]
++ ws')