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