1----------------------------------------------------------------------------- 2-- | 3-- Module : HashDefine 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-- What structures are declared in a \#define. 12----------------------------------------------------------------------------- 13 14module Language.Preprocessor.Cpphs.HashDefine 15 ( HashDefine(..) 16 , ArgOrText(..) 17 , expandMacro 18 , parseHashDefine 19 , simplifyHashDefines 20 ) where 21 22import Data.Char (isSpace) 23import Data.List (intercalate) 24 25data HashDefine 26 = LineDrop 27 { name :: String } 28 | Pragma 29 { name :: String } 30 | AntiDefined 31 { name :: String 32 , linebreaks :: Int 33 } 34 | SymbolReplacement 35 { name :: String 36 , replacement :: String 37 , linebreaks :: Int 38 } 39 | MacroExpansion 40 { name :: String 41 , arguments :: [String] 42 , expansion :: [(ArgOrText,String)] 43 , linebreaks :: Int 44 } 45 deriving (Eq,Show) 46 47-- | 'smart' constructor to avoid warnings from ghc (undefined fields) 48symbolReplacement :: HashDefine 49symbolReplacement = 50 SymbolReplacement 51 { name=undefined, replacement=undefined, linebreaks=undefined } 52 53-- | Macro expansion text is divided into sections, each of which is classified 54-- as one of three kinds: a formal argument (Arg), plain text (Text), 55-- or a stringised formal argument (Str). 56data ArgOrText = Arg | Text | Str deriving (Eq,Show) 57 58-- | Expand an instance of a macro. 59-- Precondition: got a match on the macro name. 60expandMacro :: HashDefine -> [String] -> Bool -> String 61expandMacro macro parameters layout = 62 let env = zip (arguments macro) parameters 63 replace (Arg,s) = maybe ("") id (lookup s env) 64 replace (Str,s) = maybe (str "") str (lookup s env) 65 replace (Text,s) = if layout then s else filter (/='\n') s 66 str s = '"':s++"\"" 67 checkArity | length (arguments macro) == 1 && length parameters <= 1 68 || length (arguments macro) == length parameters = id 69 | otherwise = error ("macro "++name macro++" expected "++ 70 show (length (arguments macro))++ 71 " arguments, but was given "++ 72 show (length parameters)) 73 in 74 checkArity $ concatMap replace (expansion macro) 75 76-- | Parse a \#define, or \#undef, ignoring other \# directives 77parseHashDefine :: Bool -> [String] -> Maybe HashDefine 78parseHashDefine ansi def = (command . skip) def 79 where 80 skip xss@(x:xs) | all isSpace x = skip xs 81 | otherwise = xss 82 skip [] = [] 83 command ("line":xs) = Just (LineDrop ("#line"++concat xs)) 84 command ("pragma":xs) = Just (Pragma ("#pragma"++concat xs)) 85 command ("define":xs) = Just (((define . skip) xs) { linebreaks=count def }) 86 command ("undef":xs) = Just (((undef . skip) xs)) 87 command _ = Nothing 88 undef (sym:_) = AntiDefined { name=sym, linebreaks=0 } 89 define (sym:xs) = case {-skip-} xs of 90 ("(":ys) -> (macroHead sym [] . skip) ys 91 ys -> symbolReplacement 92 { name=sym 93 , replacement = concatMap snd 94 (classifyRhs [] (chop (skip ys))) } 95 macroHead sym args (",":xs) = (macroHead sym args . skip) xs 96 macroHead sym args (")":xs) = MacroExpansion 97 { name =sym , arguments = reverse args 98 , expansion = classifyRhs args (skip xs) 99 , linebreaks = undefined } 100 macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs 101 macroHead sym args [] = error ("incomplete macro definition:\n" 102 ++" #define "++sym++"(" 103 ++intercalate "," args) 104 classifyRhs args ("#":x:xs) 105 | ansi && 106 x `elem` args = (Str,x): classifyRhs args xs 107 classifyRhs args ("##":xs) 108 | ansi = classifyRhs args xs 109 classifyRhs args (s:"##":s':xs) 110 | ansi && all isSpace s && all isSpace s' 111 = classifyRhs args xs 112 classifyRhs args (word:xs) 113 | word `elem` args = (Arg,word): classifyRhs args xs 114 | otherwise = (Text,word): classifyRhs args xs 115 classifyRhs _ [] = [] 116 count = length . filter (=='\n') . concat 117 chop = reverse . dropWhile (all isSpace) . reverse 118 119-- | Pretty-print hash defines to a simpler format, as key-value pairs. 120simplifyHashDefines :: [HashDefine] -> [(String,String)] 121simplifyHashDefines = concatMap simp 122 where 123 simp hd@LineDrop{} = [] 124 simp hd@Pragma{} = [] 125 simp hd@AntiDefined{} = [] 126 simp hd@SymbolReplacement{} = [(name hd, replacement hd)] 127 simp hd@MacroExpansion{} = [(name hd++"("++intercalate "," (arguments hd) 128 ++")" 129 ,concatMap snd (expansion hd))] 130