Macro expansion text is divided into sections, each of which is classified
- as one of three kinds: a formal argument (Arg), plain text (Text),
- or a stringised formal argument (Str).
-
Attempt to read the given file from any location within the search path.
- The first location found is returned, together with the file content.
- (The directory of the calling file is always searched first, then
- the current directory, finally any specified search path.)
-
The purpose of this module is to lex a source file (language
- unspecified) into tokens such that cpp can recognise a replaceable
- symbol or macro-use, and do the right thing.
-
linesCpp is, broadly speaking, Prelude.lines, except that
- on a line beginning with a #, line continuation characters are
- recognised. In a line continuation, the newline character is
- preserved, but the backslash is not.
-
tokenise is, broadly-speaking, Prelude.words, except that:
- * the input is already divided into lines
- * each word-like token is categorised as one of {Ident,Other,Cmd}
- * #define's are parsed and returned out-of-band using the Cmd variant
- * All whitespace is preserved intact as tokens.
- * C-comments are converted to white-space (depending on first param)
- * Parens and commas are tokens in their own right.
- * Any cpp line continuations are respected.
- No errors can be raised.
- The inverse of tokenise is (concatMap deWordStyle).
-
Each token is classified as one of Ident, Other, or Cmd:
- * Ident is a word that could potentially match a macro name.
- * Cmd is a complete cpp directive (#define etc).
- * Other is anything else.
-
-----------------------------------------------------------------------------
--- |
--- 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
- ) 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 Language.Preprocessor.Cpphs.Options (BoolOptions(..))
-import System.IO.Unsafe (unsafePerformIO)
-import Time (getClockTime, toCalendarTime, formatCalendarTime)
-import Locale (defaultTimeLocale)
-
-noPos :: Posn
-noPos = newfile "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
- -> String -- ^ The file after processing
-macroPass syms options =
- safetail -- to remove extra "\n" inserted below
- . concat
- . macroProcess (pragma options) (layout options) (lang options)
- (preDefine options syms)
- . tokenise (stripEol options) (stripC89 options)
- (ansi options) (lang options)
- . ((noPos,""):) -- ensure recognition of "\n#" at start of file
-where
- safetail [] = []
- safetail (_:xs) = xs
-
-
--- | Turn command-line definitions (from @-D@) into 'HashDefine's.
-preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine
-preDefine options defines =
- foldr (insertST . defineMacro options . (\ (s,d)-> s++" "++d))
- emptyST defines
-
--- | Turn a string representing a macro definition into a 'HashDefine'.
-defineMacro :: BoolOptions -> String -> (String,HashDefine)
-defineMacro opts s =
-let (Cmd (Just hd):_) = tokenise True True (ansi opts) (lang opts)
- [(noPos,"\n#define "++s++"\n")]
-in (name hd, 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?)
-macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle]
- -> [String]
-macroProcess ____ [] = []
-macroProcess p y l st (Other x: ws) = x: macroProcess p y l st ws
-macroProcess p y l st (Cmd Nothing: ws) = "\n": macroProcess p y l st ws
-macroProcess p y l st (Cmd (Just (LineDrop x)): ws)
- = "\n":x:macroProcess p y l st ws
-macroProcess pragma y l st (Cmd (Just (Pragma x)): ws)
- | pragma = "\n":x:macroProcess pragma y l st ws
- | otherwise = "\n": macroProcess pragma y l st ws
-macroProcess p layout lang st (Cmd (Just hd): ws) =
-let n = 1 + linebreaks hd in
- replicate n "\n" ++macroProcess p layout lang (insertST (name hd, hd) st) ws
-macroProcess pr layout lang st (Ident p x: ws) =
-case x of
- "__FILE__" -> show (filename p): macroProcess pr layout lang st ws
- "__LINE__" -> show (lineno p): macroProcess pr layout lang st ws
- "__DATE__" -> formatCalendarTime defaultTimeLocale "\"%d %b %Y\""
- (unsafePerformIO (getClockTime>>=toCalendarTime)):
- macroProcess pr layout lang st ws
- "__TIME__" -> formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""
- (unsafePerformIO (getClockTime>>=toCalendarTime)):
- macroProcess pr layout lang st ws
-_ ->
-case lookupST x st of
- Nothing -> x: macroProcess pr layout lang st ws
- Just hd ->
-case hd of
- SymbolReplacement {replacement=r} ->
-let r' = if layout then r else filter (/='\n') r in
- -- one-level expansion only:
- -- r' : macroProcess layout st ws
- -- multi-level expansion:
- macroProcess pr layout lang st
- (tokenise True True False lang [(p,r')]
- ++ ws)
- MacroExpansion {} ->
-case parseMacroCall p ws of
- Nothing -> x: macroProcess pr layout lang st ws
- Just (args,ws') ->
-if length args /= length (arguments hd) then
- x: macroProcess pr layout lang st ws
-elselet args' = map (concat
- . macroProcess pr layout
- lang st)
- args in
- -- one-level expansion only:
- -- 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')
-
-
-----------------------------------------------------------------------------
--- |
--- Module : Position
--- Copyright : 2000-2004 Malcolm Wallace
--- Licence : LGPL
---
--- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability : experimental
--- Portability : All
---
--- Simple file position information, with recursive inclusion points.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.Position
- ( Posn(..)
- , newfile
- , addcol, newline, tab, newlines, newpos
- , cppline
- , filename, lineno, directory
- ) where
-
--- | Source positions contain a filename, line, column, and an
--- inclusion point, which is itself another source position,
--- recursively.
-data Posn = Pn String !Int !Int (Maybe Posn)
-deriving (Eq)
-
-instance Show Posn where
- showsPrec _ (Pn f l c i) = showString f .
- showString " at line " . shows l .
- showString " col " . shows c .
- ( case i of
- Nothing -> id
- Just p -> showString "\n used by " .
- shows p )
-
--- | Constructor
-newfile :: String -> Posn
-newfile name = Pn name 1 1 Nothing
-
--- | Updates
-addcol :: Int -> Posn -> Posn
-addcol n (Pn f r c i) = Pn f r (c+n) i
-
-newline, tab :: Posn -> Posn
---newline (Pn f r _ i) = Pn f (r+1) 1 i
-newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i
-tab (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i
-
-newlines :: Int -> Posn -> Posn
-newlines n (Pn f r _ i) = Pn f (r+n) 1 i
-
-newpos :: Int -> Maybe String -> Posn -> Posn
-newpos r Nothing (Pn f _ c i) = Pn f r c i
-newpos r (Just ('"':f)) (Pn __ c i) = Pn (init f) r c i
-newpos r (Just f) (Pn __ c i) = Pn f r c i
-
--- | Projections
-
-lineno :: Posn -> Int
-filename :: Posn -> String
-directory :: Posn -> FilePath
-
-lineno (Pn _ r __) = r
-filename (Pn f ___) = f
-directory (Pn f ___) = dirname f
-
-
--- | cpp-style printing
-cppline :: Posn -> String
-cppline (Pn f r __) = "#line "++show r++" "++show f
-
-
--- | Strip non-directory suffix from file name (analogous to the shell
--- command of the same name).
-dirname :: String -> String
-dirname = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse
-where safetail [] = []
- safetail (_:x) = x
-
-
-----------------------------------------------------------------------------
--- |
--- Module : SymTab
--- Copyright : 2000-2004 Malcolm Wallace
--- Licence : LGPL
---
--- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability : Stable
--- Portability : All
---
--- Symbol Table, based on index trees using a hash on the key.
--- Keys are always Strings. Stored values can be any type.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.SymTab
- ( SymTab
- , emptyST
- , insertST
- , deleteST
- , lookupST
- , definedST
- , IndTree
- ) where
-
--- | Symbol Table. Stored values are polymorphic, but the keys are
--- always strings.
-type SymTab v = IndTree [(String,v)]
-
-emptyST :: SymTab v
-insertST :: (String,v) -> SymTab v -> SymTab v
-deleteST :: String -> SymTab v -> SymTab v
-lookupST :: String -> SymTab v -> Maybe v
-definedST :: String -> SymTab v -> Bool
-
-emptyST = itgen maxHash []
-insertST (s,v) ss = itiap (hash s) ((s,v):) ss id
-deleteST s ss = itiap (hash s) (filter ((/=s).fst)) ss id
-lookupST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
-inif null vs then Nothing
-else (Just . snd . head) vs
-definedST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
-in (not . null) vs
-
-
-----
--- | Index Trees (storing indexes at nodes).
-
-data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t)
-deriving Show
-
-itgen :: Int -> a -> IndTree a
-itgen 1 x = Leaf x
-itgen n x =
-let n' = n `div` 2
-in Fork n' (itgen n' x) (itgen (n-n') x)
-
-itiap :: --Eval a =>
- Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b
-itiap _ f (Leaf x) k = let fx = f x in {-seq fx-} (k (Leaf fx))
-itiap i f (Fork n lt rt) k =
-if i<n then
- itiap i f lt $ \lt' -> k (Fork n lt' rt)
-else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt')
-
-itind :: Int -> IndTree a -> a
-itind _ (Leaf x) = x
-itind i (Fork n lt rt) = if i<n then itind i lt else itind (i-n) rt
-
-
-----
--- Hash values
-
-maxHash :: Int -- should be prime
-maxHash = 101
-
-class Hashable a where
- hashWithMax :: Int -> a -> Int
- hash :: a -> Int
- hash = hashWithMax maxHash
-
-instance Enum a => Hashable [a] where
- hashWithMax m = h 0
-where h a [] = a
- h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs
-
-----
-
-----------------------------------------------------------------------------
--- |
--- Module : Tokenise
--- Copyright : 2004 Malcolm Wallace
--- Licence : LGPL
---
--- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability : experimental
--- Portability : All
---
--- The purpose of this module is to lex a source file (language
--- unspecified) into tokens such that cpp can recognise a replaceable
--- symbol or macro-use, and do the right thing.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.Tokenise
- ( linesCpp
- , reslash
- , tokenise
- , WordStyle(..)
- , deWordStyle
- , parseMacroCall
- ) where
-
-import Char
-import Language.Preprocessor.Cpphs.HashDefine
-import Language.Preprocessor.Cpphs.Position
-
--- | A Mode value describes whether to tokenise a la Haskell, or a la Cpp.
--- The main difference is that in Cpp mode we should recognise line
--- continuation characters.
-data Mode = Haskell | Cpp
-
--- | linesCpp is, broadly speaking, Prelude.lines, except that
--- on a line beginning with a \#, line continuation characters are
--- recognised. In a line continuation, the newline character is
--- preserved, but the backslash is not.
-linesCpp :: String -> [String]
-linesCpp [] = []
-linesCpp (x:xs) | x=='#' = tok Cpp ['#'] xs
- | otherwise = tok Haskell [] (x:xs)
-where
- tok Cpp acc ('\\':'\n':ys) = tok Cpp ('\n':acc) ys
- tok _ acc ('\n':'#':ys) = reverse acc: tok Cpp ['#'] ys
- tok _ acc ('\n':ys) = reverse acc: tok Haskell [] ys
- tok _ acc [] = reverse acc: []
- tok mode acc (y:ys) = tok mode (y:acc) ys
-
--- | Put back the line-continuation characters.
-reslash :: String -> String
-reslash ('\n':xs) = '\\':'\n':reslash xs
-reslash (x:xs) = x: reslash xs
-reslash [] = []
-
-----
--- | Submodes are required to deal correctly with nesting of lexical
--- structures.
-data SubMode = Any | Pred (Char->Bool) (Posn->String->WordStyle)
- | String Char | LineComment | NestComment Int
- | CComment | CLineComment
-
--- | Each token is classified as one of Ident, Other, or Cmd:
--- * Ident is a word that could potentially match a macro name.
--- * Cmd is a complete cpp directive (\#define etc).
--- * Other is anything else.
-data WordStyle = Ident Posn String | Other String | Cmd (Maybe HashDefine)
-deriving (Eq,Show)
-other :: Posn -> String -> WordStyle
-other _ s = Other s
-
-deWordStyle :: WordStyle -> String
-deWordStyle (Ident _ i) = i
-deWordStyle (Other i) = i
-deWordStyle (Cmd _) = "\n"
-
--- | tokenise is, broadly-speaking, Prelude.words, except that:
--- * the input is already divided into lines
--- * each word-like "token" is categorised as one of {Ident,Other,Cmd}
--- * \#define's are parsed and returned out-of-band using the Cmd variant
--- * All whitespace is preserved intact as tokens.
--- * C-comments are converted to white-space (depending on first param)
--- * Parens and commas are tokens in their own right.
--- * Any cpp line continuations are respected.
--- No errors can be raised.
--- The inverse of tokenise is (concatMap deWordStyle).
-tokenise :: Bool -> Bool -> Bool -> Bool -> [(Posn,String)] -> [WordStyle]
-tokenise ____ [] = []
-tokenise stripEol stripComments ansi lang ((pos,str):pos_strs) =
- (if lang then haskell else plaintext) Any [] pos pos_strs str
-where
- -- rules to lex Haskell
- haskell :: SubMode -> String -> Posn -> [(Posn,String)]
- -> String -> [WordStyle]
- haskell Any acc p ls ('\n':'#':xs) = emit acc $ -- emit "\n" $
- cpp Any haskell [] [] p ls xs
- -- warning: non-maximal munch on comment
- haskell Any acc p ls ('-':'-':xs) = emit acc $
- haskell LineComment "--" p ls xs
- haskell Any acc p ls ('{':'-':xs) = emit acc $
- haskell (NestComment 0) "-{" p ls xs
- haskell Any acc p ls ('/':'*':xs)
- | stripComments = emit acc $
- haskell CComment " " p ls xs
- haskell Any acc p ls ('/':'/':xs)
- | stripEol = emit acc $
- haskell CLineComment " " p ls xs
- haskell Any acc p ls ('"':xs) = emit acc $
- haskell (String '"') ['"'] p ls xs
- haskell Any acc p ls ('\'':xs) = emit acc $
- haskell (String '\'') "'" p ls xs
- haskell Any acc p ls (x:xs) | single x = emit acc $ emit [x] $
- haskell Any [] p ls xs
- haskell Any acc p ls (x:xs) | space x = emit acc $
- haskell (Pred space other) [x]
- p ls xs
- haskell Any acc p ls (x:xs) | symbol x = emit acc $
- haskell (Pred symbol other) [x]
- p ls xs
- -- haskell Any [] p ls (x:xs) | ident0 x = id $
- haskell Any acc p ls (x:xs) | ident0 x = emit acc $
- haskell (Pred ident1 Ident) [x]
- p ls xs
- haskell Any acc p ls (x:xs) = haskell Any (x:acc) p ls xs
-
- haskell pre@(Pred pred ws) acc p ls (x:xs)
- | pred x = haskell pre (x:acc) p ls xs
- haskell (Pred _ ws) acc p ls xs = ws p (reverse acc):
- haskell Any [] p ls xs
- haskell (String c) acc p ls ('\\':x:xs)
- | x=='\\' = haskell (String c) ('\\':'\\':acc) p ls xs
- | x==c = haskell (String c) (c:'\\':acc) p ls xs
- haskell (String c) acc p ls (x:xs)
- | x==c = emit (c:acc) $ haskell Any [] p ls xs
- | otherwise = haskell (String c) (x:acc) p ls xs
- haskell LineComment acc p ls xs@('\n':_) = emit acc $ haskell Any [] p ls xs
- haskell LineComment acc p ls (x:xs) = haskell LineComment (x:acc) p ls xs
- haskell (NestComment n) acc p ls ('{':'-':xs)
- = haskell (NestComment (n+1))
- ("-{"++acc) p ls xs
- haskell (NestComment 0) acc p ls ('-':'}':xs)
- = emit ("}-"++acc) $ haskell Any [] p ls xs
- haskell (NestComment n) acc p ls ('-':'}':xs)
- = haskell (NestComment (n-1))
- ("}-"++acc) p ls xs
- haskell (NestComment n) acc p ls (x:xs) = haskell (NestComment n) (x:acc)
- p ls xs
- haskell CComment acc p ls ('*':'/':xs) = emit (" "++acc) $
- haskell Any [] p ls xs
- haskell CComment acc p ls (_:xs) = haskell CComment (' ':acc) p ls xs
- haskell CLineComment acc p ls xs@('\n':_)= emit acc $ haskell Any [] p ls xs
- haskell CLineComment acc p ls (_:xs) = haskell CLineComment (' ':acc)
- p ls xs
- haskell mode acc _ ((p,l):ls) [] = haskell mode acc p ls ('\n':l)
- haskell _ acc _ [] [] = emit acc $ []
-
- -- rules to lex Cpp
- cpp :: SubMode -> (SubMode -> String -> Posn -> [(Posn,String)]
- -> String -> [WordStyle])
- -> String -> [String] -> Posn -> [(Posn,String)]
- -> String -> [WordStyle]
- cpp mode next word line pos remaining input =
- lexcpp mode word line remaining input
-where
- lexcpp Any w l ls ('/':'*':xs) = lexcpp (NestComment 0) "" (w*/*l) ls xs
- lexcpp Any w l ls ('/':'/':xs) = lexcpp LineComment " " (w*/*l) ls xs
- lexcpp Any w l ((p,l'):ls) ('\\':[]) = cpp Any next [] ("\n":w*/*l) p ls l'
- lexcpp Any w l ls ('\\':'\n':xs) = lexcpp Any [] ("\n":w*/*l) ls xs
- lexcpp Any w l ls xs@('\n':_) = Cmd (parseHashDefine ansi
- (reverse (w*/*l))):
- next Any [] pos ls xs
- -- lexcpp Any w l ls ('"':xs) = lexcpp (String '"') ['"'] (w*/*l) ls xs
- -- lexcpp Any w l ls ('\'':xs) = lexcpp (String '\'') "'" (w*/*l) ls xs
- lexcpp Any w l ls ('"':xs) = lexcpp Any [] ("\"":(w*/*l)) ls xs
- lexcpp Any w l ls ('\'':xs) = lexcpp Any [] ("'": (w*/*l)) ls xs
- lexcpp Any [] l ls (x:xs)
- | ident0 x = lexcpp (Pred ident1 Ident) [x] l ls xs
- -- lexcpp Any w l ls (x:xs) | ident0 x = lexcpp (Pred ident1 Ident) [x] (w*/*l) ls xs
- lexcpp Any w l ls (x:xs)
- | single x = lexcpp Any [] ([x]:w*/*l) ls xs
- | space x = lexcpp (Pred space other) [x] (w*/*l) ls xs
- | symbol x = lexcpp (Pred symbol other) [x] (w*/*l) ls xs
- | otherwise = lexcpp Any (x:w) l ls xs
- lexcpp pre@(Pred pred _) w l ls (x:xs)
- | pred x = lexcpp pre (x:w) l ls xs
- lexcpp (Pred __) w l ls xs = lexcpp Any [] (w*/*l) ls xs
- lexcpp (String c) w l ls ('\\':x:xs)
- | x=='\\' = lexcpp (String c) ('\\':'\\':w) l ls xs
- | x==c = lexcpp (String c) (c:'\\':w) l ls xs
- lexcpp (String c) w l ls (x:xs)
- | x==c = lexcpp Any [] ((c:w)*/*l) ls xs
- | otherwise = lexcpp (String c) (x:w) l ls xs
- lexcpp LineComment w l ((p,l'):ls) ('\\':[])
- = cpp LineComment next [] (('\n':w)*/*l) pos ls l'
- lexcpp LineComment w l ls ('\\':'\n':xs)
- = lexcpp LineComment [] (('\n':w)*/*l) ls xs
- lexcpp LineComment w l ls xs@('\n':_) = lexcpp Any w l ls xs
- lexcpp LineComment w l ls (_:xs) = lexcpp LineComment (' ':w) l ls xs
- lexcpp (NestComment _) w l ls ('*':'/':xs)
- = lexcpp Any [] (w*/*l) ls xs
- lexcpp (NestComment n) w l ls (_:xs) = lexcpp (NestComment n) (' ':w) l
- ls xs
- lexcpp mode w l ((p,l'):ls) [] = cpp mode next w l p ls ('\n':l')
- lexcpp ___ [] [] = []
-
- -- rules to lex non-Haskell, non-cpp text
- plaintext :: SubMode -> String -> Posn -> [(Posn,String)]
- -> String -> [WordStyle]
- plaintext Any acc p ls ('\n':'#':xs) = emit acc $ -- emit "\n" $
- cpp Any plaintext [] [] p ls xs
- plaintext Any acc p ls ('/':'*':xs)
- | stripComments = emit acc $
- plaintext CComment " " p ls xs
- plaintext Any acc p ls ('/':'/':xs)
- | stripEol = emit acc $
- plaintext CLineComment " " p ls xs
- plaintext Any acc p ls (x:xs) | single x = emit acc $ emit [x] $
- plaintext Any [] p ls xs
- plaintext Any acc p ls (x:xs) | space x = emit acc $
- plaintext (Pred space other) [x]
- p ls xs
- plaintext Any acc p ls (x:xs) | ident0 x = emit acc $
- plaintext (Pred ident1 Ident) [x]
- p ls xs
- plaintext Any acc p ls (x:xs) = plaintext Any (x:acc) p ls xs
- plaintext pre@(Pred pred ws) acc p ls (x:xs)
- | pred x = plaintext pre (x:acc) p ls xs
- plaintext (Pred _ ws) acc p ls xs = ws p (reverse acc):
- plaintext Any [] p ls xs
- plaintext CComment acc p ls ('*':'/':xs) = emit (" "++acc) $
- plaintext Any [] p ls xs
- plaintext CComment acc p ls (_:xs) = plaintext CComment (' ':acc) p ls xs
- plaintext CLineComment acc p ls xs@('\n':_)
- = emit acc $ plaintext Any [] p ls xs
- plaintext CLineComment acc p ls (_:xs)= plaintext CLineComment (' ':acc)
- p ls xs
- plaintext mode acc _ ((p,l):ls) [] = plaintext mode acc p ls ('\n':l)
- plaintext _ acc _ [] [] = emit acc $ []
-
- -- predicates for lexing Haskell.
- ident0 x = isAlpha x || x `elem` "_`"
- ident1 x = isAlphaNum x || x `elem` "'_`"
- symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~"
- single x = x `elem` "(),[];{}"
- space x = x `elem` " \t"
- -- emit a token (if there is one) from the accumulator
- emit "" = id
- emit xs = (Other (reverse xs):)
- -- add a reversed word to the accumulator
- "" */* l = l
- w */* l = reverse w : l
- -- help out broken Haskell compilers which need balanced numbers of C
- -- comments in order to do import chasing :-) -----> */*
-
-
--- | Parse a possible macro call, returning argument list and remaining input
-parseMacroCall :: Posn -> [WordStyle] -> Maybe ([[WordStyle]],[WordStyle])
-parseMacroCall p = call . skip
-where
- skip (Other x:xs) | all isSpace x = skip xs
- skip xss = xss
- call (Other "(":xs) = (args (0::Int) [] [] . skip) xs
- call _ = Nothing
- args 0 w acc ( Other ")" :xs) = Just (reverse (addone w acc), xs)
- args 0 w acc ( Other "," :xs) = args 0 [] (addone w acc) (skip xs)
- args n w acc (x@(Other "("):xs) = args (n+1) (x:w) acc xs
- args n w acc (x@(Other ")"):xs) = args (n-1) (x:w) acc xs
- args n w acc ( Ident _ v :xs) = args n (Ident p v:w) acc xs
- args n w acc (x@(Other _) :xs) = args n (x:w) acc xs
- args ____ = Nothing
- addone w acc = reverse (skip w): acc
-
-
-- | Part of this code is from "Report on the Programming Language Haskell",
--- version 1.2, appendix C.
-module Language.Preprocessor.Unlit (unlit) where
-
-import Char
-
-data Classified = Program String | Blank | Comment
- | Include Int String | Pre String
-
-classify :: [String] -> [Classified]
-classify [] = []
-classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs
-where allProg [] = [] -- Should give an error message,
- -- but I have no good position information.
- allProg (('\\':x):xs) | x == "end{code}" = Blank : classify xs
- allProg (x:xs) = Program x:allProg xs
-classify (('>':x):xs) = Program (' ':x) : classify xs
-classify (('#':x):xs) = (case words x of
- (line:rest) | all isDigit line
- -> Include (read line) (unwords rest)
-_ -> Pre x
- ) : classify xs
-classify (x:xs) | all isSpace x = Blank:classify xs
-classify (x:xs) = Comment:classify xs
-
-unclassify :: Classified -> String
-unclassify (Program s) = s
-unclassify (Pre s) = '#':s
-unclassify (Include i f) = '#':' ':show i ++ ' ':f
-unclassify Blank = ""
-unclassify Comment = ""
-
--- | 'unlit' takes a filename (for error reports), and transforms the
--- given string, to eliminate the literate comments from the program text.
-unlit :: FilePath -> String -> String
-unlit file lhs = (unlines
- . map unclassify
- . adjacent file (0::Int) Blank
- . classify) (inlines lhs)
-
-adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified]
-adjacent file 0 _ (x :xs) = x : adjacent file 1 x xs -- force evaluation of line number
-adjacent file n y@(Program _) (x@Comment :xs) = error (message file n "program" "comment")
-adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs
-adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
-adjacent file n y@Comment (x@(Program _) :xs) = error (message file n "comment" "program")
-adjacent file n y@Comment (x@(Include i f):xs) = x: adjacent f i y xs
-adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
-adjacent file n y@Blank (x@(Include i f):xs) = x: adjacent f i y xs
-adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
-adjacent file n _ (x@next :xs) = x: adjacent file (n+1) x xs
-adjacent file n _ [] = []
-
-message :: String -> Int -> String -> String -> String
-message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
-message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
-message file n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n"
-
-
--- Re-implementation of 'lines', for better efficiency (but decreased laziness).
--- Also, importantly, accepts non-standard DOS and Mac line ending characters.
-inlines :: String -> [String]
-inlines s = lines' s id
-where
- lines' [] acc = [acc []]
- lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS
- lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS
- lines' ('\n':s) acc = acc [] : lines' s id -- Unix
- lines' (c:s) acc = lines' s (acc . (c:))
-
-
Graham Hutton Erik Meijer
- University of Nottingham University of Utrecht
-
This Haskell script defines a library of parser combinators, and is
- taken from sections 1-6 of our article Monadic Parser Combinators.
- Some changes to the library have been made in the move from Gofer
- to Haskell:
-
Do notation is used in place of monad comprehension notation;
-
The parser datatype is defined using newtype, to avoid the overhead
- of tagging and untagging parsers with the P constructor.
-
{-
--- The main program wrapper for cpphs, a simple C pre-processor
--- written in Haskell.
-
--- Author: Malcolm Wallace, 2004
--- This file is licensed under the GPL. Note however, that all other
--- modules used by it are either distributed under the LGPL, or are Haskell'98.
---
--- Thus, when compiled as a standalone executable, this program will fall
--- under the GPL.
--}
-module Main where
-
-import System ( getArgs, getProgName, exitWith, ExitCode(..) )
-import Maybe
-import Language.Preprocessor.Cpphs ( runCpphs, CpphsOptions(..), parseOptions )
-import IO ( stdout, IOMode(WriteMode), openFile, hPutStr, hFlush, hClose )
-import Monad ( when )
-import List ( isPrefixOf )
-
-version :: String
-version = "1.6"
-
-main :: IO ()
-main = do
- args <- getArgs
- args <- return $ if "--cpp" `elem` args then convertArgs args else args
-
- prog <- getProgName
- when ("--version" `elem` args)
- (do putStrLn (prog++" "++version)
- exitWith ExitSuccess)
- when ("--help" `elem` args)
- (do putStrLn ("Usage: "++prog
- ++" [file ...] [ -Dsym | -Dsym=val | -Ipath ]* [-Ofile]\n"
- ++"\t\t[--nomacro] [--noline] [--pragma] [--text]\n"
- ++"\t\t[--strip] [--strip-eol] [--hashes] [--layout] [--unlit]\n"
- ++"\t\t[ --cpp std-cpp-options ] [--include=filename]")
- exitWith ExitSuccess)
-
-let parsedArgs = parseOptions args
- options = fromRight parsedArgs
- ins = infiles options
- outs = outfiles options
- out = listToMaybe outs
-
- when (isLeft parsedArgs)
- (do putStrLn $ "Unknown option "++fromLeft parsedArgs
- ++", for valid options try "++prog++" --help\n"
- exitWith (ExitFailure 1))
- when (length outs > 1)
- (do putStrLn $ "At most one output file (-O) can be specified"
- exitWith (ExitFailure 2))
-if null ins then execute options out Nothing
-else mapM_ (execute options out) (map Just ins)
-
--- | Execute the preprocessor.
--- If the filepath is Nothing then default to stdout\/stdin as appropriate.
-execute :: CpphsOptions -> Maybe FilePath -> Maybe FilePath -> IO ()
-execute opts ofile infile =
-let (filename, readIt) = case infile of
- Just x -> (x, readFile x)
- Nothing -> ("stdin", getContents)
- output Nothing x = do putStr x; hFlush stdout
- output (Just f) x = writeFile f x
-indo contents <- readIt
- output ofile (runCpphs opts filename contents)
-
-isLeft (Left _) = True
-isLeft _ = False
-
-fromLeft (Left x) = x
-fromRight (Right x) = x
-
--- | Convert commandline options to remain compatible with cpp.
--- Based on a shell script cpphs.compat
-data ConvertArgs = ConvertArgs { traditional, strip :: Bool
- , infile, outfile :: String }
-
-convertArgs :: [String] -> [String]
-convertArgs xs = f (ConvertArgs False True "-" "-") xs
-where
- flg = "DUI"
-
- f e (['-',r]:x:xs) | r `elem` flg = ('-':r:x) : f e xs
- f e (x@('-':r:_):xs) | r `elem` flg = x : f e xs
- f e ("-o":x:xs) = ('-':'O':x) : f e xs
- f e (('-':'o':x):xs) = ('-':'O':drop 2 x) : f e xs
- f e (('-':x):xs) | "ansi" `isPrefixOf` x = f e{traditional=False} xs
- | "traditional" `isPrefixOf` x = f e{traditional=True} xs
- | "std" `isPrefixOf` x = f e xs -- ignore language spec
- f e ("-x":x:xs) = f e xs -- ignore language spec
- f e ("-include":x:xs) = ("--include="++x) : f e xs
- f e ("-P":xs) = "--noline" : f e xs
- f e (x:xs) | x == "-C" || x == "-CC" = f e{strip=False} xs
- f e ("-A":x:xs) = f e xs -- strip assertions
- f e ("--help":xs) = "--help" : f e xs
- f e ("--version":xs) = "--version" : f e xs
- f e ("-version":xs) = "--version" : f e xs
- f e (('-':x):xs) = f e xs -- strip all other flags
- f e (x:xs) = f (if infile e == "-" then e{infile=x} else e{outfile=x}) xs
-
- f e [] = ["--hashes" | not (traditional e)] ++
- ["--strip" | traditional e && strip e] ++
- ["--strip-eol" | not (traditional e) && strip e] ++
- [infile e] ++
- ["-O" ++ outfile e | outfile e /= "-"]
-
-
-
diff --git a/docs/cpphs/minus.gif b/docs/cpphs/minus.gif
deleted file mode 100644
Binary files a/docs/cpphs/minus.gif and /dev/null differ
diff --git a/docs/cpphs/plus.gif b/docs/cpphs/plus.gif
deleted file mode 100644
Binary files a/docs/cpphs/plus.gif and /dev/null differ
diff --git a/docs/index.html b/docs/index.html
--- a/docs/index.html
+++ b/docs/index.html
@@ -101,7 +101,9 @@
#include'd, cpphs inserts #line directives for the
same reason. Numbering should be correct even in the presence of
line continuations. If you don't want #line directives in
-the final output, use the --noline option.
+the final output, use the --noline option, or if you would
+prefer them in {-# LINE #-} Haskell pragma format, use the
+--linepragma option.
Any syntax error in a cpp directive gives a warning message to stderr.
@@ -114,7 +116,7 @@
Instances