1----------------------------------------------------------------------------- 2-- | 3-- Module : MacroPass 4-- Copyright : 2004 Malcolm Wallace 5-- Licence : LGPL 6-- 7-- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk> 8-- Stability : experimental 9-- Portability : All 10-- 11-- Perform a cpp.second-pass, accumulating \#define's and \#undef's, 12-- whilst doing symbol replacement and macro expansion. 13----------------------------------------------------------------------------- 14 15module Language.Preprocessor.Cpphs.MacroPass 16 ( macroPass 17 , preDefine 18 , defineMacro 19 , macroPassReturningSymTab 20 ) where 21 22import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro 23 , simplifyHashDefines) 24import Language.Preprocessor.Cpphs.Tokenise (tokenise, WordStyle(..) 25 , parseMacroCall) 26import Language.Preprocessor.Cpphs.SymTab (SymTab, lookupST, insertST 27 , emptyST, flattenST) 28import Language.Preprocessor.Cpphs.Position (Posn, newfile, filename, lineno) 29import Language.Preprocessor.Cpphs.Options (BoolOptions(..)) 30import System.IO.Unsafe (unsafeInterleaveIO) 31import Control.Monad ((=<<)) 32--import System.Time (getClockTime, toCalendarTime, formatCalendarTime) 33import Data.Time.Clock (getCurrentTime) 34import Data.Time.Format (formatTime) 35import TimeCompat (defaultTimeLocale) 36 37noPos :: Posn 38noPos = newfile "preDefined" 39 40-- | Walk through the document, replacing calls of macros with the expanded RHS. 41macroPass :: [(String,String)] -- ^ Pre-defined symbols and their values 42 -> BoolOptions -- ^ Options that alter processing style 43 -> [(Posn,String)] -- ^ The input file content 44 -> IO String -- ^ The file after processing 45macroPass syms options = 46 fmap (safetail -- to remove extra "\n" inserted below 47 . concat 48 . onlyRights) 49 . macroProcess (pragma options) (layout options) (lang options) 50 (preDefine options syms) 51 . tokenise (stripEol options) (stripC89 options) 52 (ansi options) (lang options) 53 . ((noPos,""):) -- ensure recognition of "\n#" at start of file 54 where 55 safetail [] = [] 56 safetail (_:xs) = xs 57 58-- | auxiliary 59onlyRights :: [Either a b] -> [b] 60onlyRights = concatMap (\x->case x of Right t-> [t]; Left _-> [];) 61 62-- | Walk through the document, replacing calls of macros with the expanded RHS. 63-- Additionally returns the active symbol table after processing. 64macroPassReturningSymTab 65 :: [(String,String)] -- ^ Pre-defined symbols and their values 66 -> BoolOptions -- ^ Options that alter processing style 67 -> [(Posn,String)] -- ^ The input file content 68 -> IO (String,[(String,String)]) 69 -- ^ The file and symbol table after processing 70macroPassReturningSymTab syms options = 71 fmap (mapFst (safetail -- to remove extra "\n" inserted below 72 . concat) 73 . walk) 74 . macroProcess (pragma options) (layout options) (lang options) 75 (preDefine options syms) 76 . tokenise (stripEol options) (stripC89 options) 77 (ansi options) (lang options) 78 . ((noPos,""):) -- ensure recognition of "\n#" at start of file 79 where 80 safetail [] = [] 81 safetail (_:xs) = xs 82 walk (Right x: rest) = let (xs, foo) = walk rest 83 in (x:xs, foo) 84 walk (Left x: []) = ( [] , simplifyHashDefines (flattenST x) ) 85 walk (Left x: rest) = walk rest 86 mapFst f (a,b) = (f a, b) 87 88 89-- | Turn command-line definitions (from @-D@) into 'HashDefine's. 90preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine 91preDefine options defines = 92 foldr (insertST . defineMacro options . (\ (s,d)-> s++" "++d)) 93 emptyST defines 94 95-- | Turn a string representing a macro definition into a 'HashDefine'. 96defineMacro :: BoolOptions -> String -> (String,HashDefine) 97defineMacro opts s = 98 let (Cmd (Just hd):_) = tokenise True True (ansi opts) (lang opts) 99 [(noPos,"\n#define "++s++"\n")] 100 in (name hd, hd) 101 102 103-- | Trundle through the document, one word at a time, using the WordStyle 104-- classification introduced by 'tokenise' to decide whether to expand a 105-- word or macro. Encountering a \#define or \#undef causes that symbol to 106-- be overwritten in the symbol table. Any other remaining cpp directives 107-- are discarded and replaced with blanks, except for \#line markers. 108-- All valid identifiers are checked for the presence of a definition 109-- of that name in the symbol table, and if so, expanded appropriately. 110-- (Bool arguments are: keep pragmas? retain layout? haskell language?) 111-- The result lazily intersperses output text with symbol tables. Lines 112-- are emitted as they are encountered. A symbol table is emitted after 113-- each change to the defined symbols, and always at the end of processing. 114macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle] 115 -> IO [Either (SymTab HashDefine) String] 116macroProcess _ _ _ st [] = return [Left st] 117macroProcess p y l st (Other x: ws) = emit x $ macroProcess p y l st ws 118macroProcess p y l st (Cmd Nothing: ws) = emit "\n" $ macroProcess p y l st ws 119macroProcess p y l st (Cmd (Just (LineDrop x)): ws) 120 = emit "\n" $ 121 emit x $ macroProcess p y l st ws 122macroProcess pragma y l st (Cmd (Just (Pragma x)): ws) 123 | pragma = emit "\n" $ emit x $ macroProcess pragma y l st ws 124 | otherwise = emit "\n" $ macroProcess pragma y l st ws 125macroProcess p layout lang st (Cmd (Just hd): ws) = 126 let n = 1 + linebreaks hd 127 newST = insertST (name hd, hd) st 128 in 129 emit (replicate n '\n') $ 130 emitSymTab newST $ 131 macroProcess p layout lang newST ws 132macroProcess pr layout lang st (Ident p x: ws) = 133 case x of 134 "__FILE__" -> emit (show (filename p))$ macroProcess pr layout lang st ws 135 "__LINE__" -> emit (show (lineno p)) $ macroProcess pr layout lang st ws 136 "__DATE__" -> do w <- return . 137 -- formatCalendarTime defaultTimeLocale "\"%d %b %Y\"" 138 -- =<< toCalendarTime =<< getClockTime 139 formatTime defaultTimeLocale "\"%d %b %Y\"" 140 =<< getCurrentTime 141 emit w $ macroProcess pr layout lang st ws 142 "__TIME__" -> do w <- return . 143 -- formatCalendarTime defaultTimeLocale "\"%H:%M:%S\"" 144 -- =<< toCalendarTime =<< getClockTime 145 formatTime defaultTimeLocale "\"%H:%M:%S\"" 146 =<< getCurrentTime 147 emit w $ macroProcess pr layout lang st ws 148 _ -> 149 case lookupST x st of 150 Nothing -> emit x $ macroProcess pr layout lang st ws 151 Just hd -> 152 case hd of 153 AntiDefined {name=n} -> emit n $ 154 macroProcess pr layout lang st ws 155 SymbolReplacement {replacement=r} -> 156 let r' = if layout then r else filter (/='\n') r in 157 -- one-level expansion only: 158 -- emit r' $ macroProcess layout st ws 159 -- multi-level expansion: 160 macroProcess pr layout lang st 161 (tokenise True True False lang [(p,r')] 162 ++ ws) 163 MacroExpansion {} -> 164 case parseMacroCall p ws of 165 Nothing -> emit x $ 166 macroProcess pr layout lang st ws 167 Just (args,ws') -> 168 if length args /= length (arguments hd) then 169 emit x $ macroProcess pr layout lang st ws 170 else do args' <- mapM (fmap (concat.onlyRights) 171 . macroProcess pr layout 172 lang st) 173 args 174 -- one-level expansion only: 175 -- emit (expandMacro hd args' layout) $ 176 -- macroProcess layout st ws' 177 -- multi-level expansion: 178 macroProcess pr layout lang st 179 (tokenise True True False lang 180 [(p,expandMacro hd args' layout)] 181 ++ ws') 182 183-- | Useful helper function. 184emit :: a -> IO [Either b a] -> IO [Either b a] 185emit x io = do xs <- unsafeInterleaveIO io 186 return (Right x:xs) 187-- | Useful helper function. 188emitSymTab :: b -> IO [Either b a] -> IO [Either b a] 189emitSymTab x io = do xs <- unsafeInterleaveIO io 190 return (Left x:xs) 191