diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,7 @@ +Version 1.14 +------------ + * New API to return symbol table after processing. + Version 1.13 ------------ * Accept -U cmdline option for compatibility with cpp. diff --git a/Language/Preprocessor/Cpphs.hs b/Language/Preprocessor/Cpphs.hs --- a/Language/Preprocessor/Cpphs.hs +++ b/Language/Preprocessor/Cpphs.hs @@ -12,14 +12,19 @@ ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs - ( runCpphs, cppIfdef, macroPass, CpphsOptions(..), BoolOptions(..) + ( runCpphs, runCpphsReturningSymTab + , cppIfdef + , macroPass, macroPassReturningSymTab + , CpphsOptions(..), BoolOptions(..) , parseOptions, defaultCpphsOptions, defaultBoolOptions , module Language.Preprocessor.Cpphs.Position ) where import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef) -import Language.Preprocessor.Cpphs.MacroPass(macroPass) -import Language.Preprocessor.Cpphs.RunCpphs(runCpphs) +import Language.Preprocessor.Cpphs.MacroPass(macroPass + ,macroPassReturningSymTab) +import Language.Preprocessor.Cpphs.RunCpphs(runCpphs + ,runCpphsReturningSymTab) import Language.Preprocessor.Cpphs.Options (CpphsOptions(..), BoolOptions(..), parseOptions ,defaultCpphsOptions,defaultBoolOptions) diff --git a/Language/Preprocessor/Cpphs/HashDefine.hs b/Language/Preprocessor/Cpphs/HashDefine.hs --- a/Language/Preprocessor/Cpphs/HashDefine.hs +++ b/Language/Preprocessor/Cpphs/HashDefine.hs @@ -16,10 +16,11 @@ , ArgOrText(..) , expandMacro , parseHashDefine + , simplifyHashDefines ) where import Data.Char (isSpace) -import Data.List (intersperse) +import Data.List (intercalate) data HashDefine = LineDrop @@ -93,7 +94,7 @@ macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs macroHead sym args [] = error ("incomplete macro definition:\n" ++" #define "++sym++"(" - ++concat (intersperse "," args)) + ++intercalate "," args) classifyRhs args ("#":x:xs) | ansi && x `elem` args = (Str,x): classifyRhs args xs @@ -109,3 +110,14 @@ count = length . filter (=='\n') . concat chop = reverse . dropWhile (all isSpace) . reverse +-- | Pretty-print hash defines to a simpler format, as key-value pairs. +simplifyHashDefines :: [HashDefine] -> [(String,String)] +simplifyHashDefines = concatMap simp + where + simp hd@LineDrop{} = [] + simp hd@Pragma{} = [] + simp hd@AntiDefined{} = [] + simp hd@SymbolReplacement{} = [(name hd, replacement hd)] + simp hd@MacroExpansion{} = [(name hd++"("++intercalate "," (arguments hd) + ++")" + ,concatMap snd (expansion hd))] diff --git a/Language/Preprocessor/Cpphs/MacroPass.hs b/Language/Preprocessor/Cpphs/MacroPass.hs --- a/Language/Preprocessor/Cpphs/MacroPass.hs +++ b/Language/Preprocessor/Cpphs/MacroPass.hs @@ -16,13 +16,15 @@ ( macroPass , preDefine , defineMacro + , macroPassReturningSymTab ) where -import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro) +import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro + , simplifyHashDefines) import Language.Preprocessor.Cpphs.Tokenise (tokenise, WordStyle(..) , parseMacroCall) import Language.Preprocessor.Cpphs.SymTab (SymTab, lookupST, insertST - , emptyST) + , emptyST, flattenST) import Language.Preprocessor.Cpphs.Position (Posn, newfile, filename, lineno) import Language.Preprocessor.Cpphs.Options (BoolOptions(..)) import System.IO.Unsafe (unsafeInterleaveIO) @@ -40,7 +42,8 @@ -> IO String -- ^ The file after processing macroPass syms options = fmap (safetail -- to remove extra "\n" inserted below - . concat) + . concat + . onlyRights) . macroProcess (pragma options) (layout options) (lang options) (preDefine options syms) . tokenise (stripEol options) (stripC89 options) @@ -50,7 +53,37 @@ safetail [] = [] safetail (_:xs) = xs +-- | auxiliary +onlyRights :: [Either a b] -> [b] +onlyRights = concatMap (\x->case x of Right t-> [t]; Left _-> [];) +-- | Walk through the document, replacing calls of macros with the expanded RHS. +-- Additionally returns the active symbol table after processing. +macroPassReturningSymTab + :: [(String,String)] -- ^ Pre-defined symbols and their values + -> BoolOptions -- ^ Options that alter processing style + -> [(Posn,String)] -- ^ The input file content + -> IO (String,[(String,String)]) + -- ^ The file and symbol table after processing +macroPassReturningSymTab syms options = + fmap (mapFst (safetail -- to remove extra "\n" inserted below + . concat) + . walk) + . 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 + walk (Right x: rest) = let (xs, foo) = walk rest + in (x:xs, foo) + walk (Left x: []) = ( [] , simplifyHashDefines (flattenST x) ) + walk (Left x: rest) = walk rest + mapFst f (a,b) = (f a, b) + + -- | Turn command-line definitions (from @-D@) into 'HashDefine's. preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine preDefine options defines = @@ -73,9 +106,12 @@ -- 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?) +-- The result lazily intersperses output text with symbol tables. Lines +-- are emitted as they are encountered. A symbol table is emitted after +-- each change to the defined symbols, and always at the end of processing. macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle] - -> IO [String] -macroProcess _ _ _ _ [] = return [] + -> IO [Either (SymTab HashDefine) String] +macroProcess _ _ _ st [] = return [Left st] macroProcess p y l st (Other x: ws) = emit x $ macroProcess p y l st ws macroProcess p y l st (Cmd Nothing: ws) = emit "\n" $ macroProcess p y l st ws macroProcess p y l st (Cmd (Just (LineDrop x)): ws) @@ -85,9 +121,12 @@ | pragma = emit "\n" $ emit x $ macroProcess pragma y l st ws | otherwise = emit "\n" $ macroProcess pragma y l st ws macroProcess p layout lang st (Cmd (Just hd): ws) = - let n = 1 + linebreaks hd in + let n = 1 + linebreaks hd + newST = insertST (name hd, hd) st + in emit (replicate n '\n') $ - macroProcess p layout lang (insertST (name hd, hd) st) ws + emitSymTab newST $ + macroProcess p layout lang newST ws macroProcess pr layout lang st (Ident p x: ws) = case x of "__FILE__" -> emit (show (filename p))$ macroProcess pr layout lang st ws @@ -122,9 +161,9 @@ Just (args,ws') -> if length args /= length (arguments hd) then emit x $ macroProcess pr layout lang st ws - else do args' <- mapM (fmap concat . - macroProcess pr layout - lang st) + else do args' <- mapM (fmap (concat.onlyRights) + . macroProcess pr layout + lang st) args -- one-level expansion only: -- emit (expandMacro hd args' layout) $ @@ -136,6 +175,10 @@ ++ ws') -- | Useful helper function. -emit :: a -> IO [a] -> IO [a] +emit :: a -> IO [Either b a] -> IO [Either b a] emit x io = do xs <- unsafeInterleaveIO io - return (x:xs) + return (Right x:xs) +-- | Useful helper function. +emitSymTab :: b -> IO [Either b a] -> IO [Either b a] +emitSymTab x io = do xs <- unsafeInterleaveIO io + return (Left x:xs) diff --git a/Language/Preprocessor/Cpphs/RunCpphs.hs b/Language/Preprocessor/Cpphs/RunCpphs.hs --- a/Language/Preprocessor/Cpphs/RunCpphs.hs +++ b/Language/Preprocessor/Cpphs/RunCpphs.hs @@ -4,10 +4,12 @@ -- Copyright (c) 2004 Malcolm Wallace -- This file is LGPL (relicensed from the GPL by Malcolm Wallace, October 2011). -} -module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs ) where +module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs + , runCpphsReturningSymTab + ) where import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef) -import Language.Preprocessor.Cpphs.MacroPass(macroPass) +import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab) import Language.Preprocessor.Cpphs.Options (CpphsOptions(..), BoolOptions(..)) import Language.Preprocessor.Unlit as Unlit (unlit) @@ -27,3 +29,21 @@ pass3 = if literate bools then Unlit.unlit filename else id return (pass3 result) + +runCpphsReturningSymTab :: CpphsOptions -> FilePath -> String + -> IO (String,[(String,String)]) +runCpphsReturningSymTab options filename input = do + let bools = boolopts options + preInc = case preInclude options of + [] -> "" + is -> concatMap (\f->"#include \""++f++"\"\n") is + ++ "#line 1 \""++filename++"\"\n" + + pass1 <- cppIfdef filename (defines options) (includes options) bools + (preInc++input) + (pass2,syms) <- macroPassReturningSymTab (defines options) bools pass1 + let result= if not (macros bools) then unlines (map snd pass1) else pass2 + pass3 = if literate bools then Unlit.unlit filename else id + + return (pass3 result, syms) + diff --git a/Language/Preprocessor/Cpphs/SymTab.hs b/Language/Preprocessor/Cpphs/SymTab.hs --- a/Language/Preprocessor/Cpphs/SymTab.hs +++ b/Language/Preprocessor/Cpphs/SymTab.hs @@ -19,6 +19,7 @@ , deleteST , lookupST , definedST + , flattenST , IndTree ) where @@ -31,6 +32,7 @@ deleteST :: String -> SymTab v -> SymTab v lookupST :: String -> SymTab v -> Maybe v definedST :: String -> SymTab v -> Bool +flattenST :: SymTab v -> [v] emptyST = itgen maxHash [] insertST (s,v) ss = itiap (hash s) ((s,v):) ss id @@ -40,6 +42,7 @@ else (Just . snd . head) vs definedST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss) in (not . null) vs +flattenST ss = itfold (map snd) (++) ss ---- @@ -62,10 +65,13 @@ 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 :: Int -> IndTree a -> a itind _ (Leaf x) = x itind i (Fork n lt rt) = if ib) -> (b->b->b) -> IndTree a -> b +itfold leaf _fork (Leaf x) = leaf x +itfold leaf fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r) ---- -- Hash values diff --git a/Language/Preprocessor/Cpphs/Tokenise.hs b/Language/Preprocessor/Cpphs/Tokenise.hs --- a/Language/Preprocessor/Cpphs/Tokenise.hs +++ b/Language/Preprocessor/Cpphs/Tokenise.hs @@ -146,7 +146,7 @@ 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 CComment acc p ls (x:xs) = haskell CComment (white x: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 @@ -197,7 +197,7 @@ 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 + lexcpp (NestComment n) w l ls (x:xs) = lexcpp (NestComment n) (white x:w) l ls xs lexcpp mode w l ((p,l'):ls) [] = cpp mode next w l p ls ('\n':l') lexcpp _ _ _ [] [] = [] @@ -228,7 +228,7 @@ 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 CComment acc p ls (x:xs) = plaintext CComment (white x: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) @@ -242,6 +242,10 @@ symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~" single x = x `elem` "(),[];{}" space x = x `elem` " \t" + -- conversion of comment text to whitespace + white '\n' = '\n' + white '\r' = '\r' + white _ = ' ' -- emit a token (if there is one) from the accumulator emit "" = id emit xs = (Other (reverse xs):) diff --git a/README b/README --- a/README +++ b/README @@ -30,7 +30,7 @@ COPYRIGHT --------- -Copyright (c) 2004-2011 Malcolm Wallace (Malcolm.Wallace@me.com) +Copyright (c) 2004-2012 Malcolm Wallace (Malcolm.Wallace@me.com) except for Text.ParserCombinators.HuttonMeijer (Copyright (c) 1995 Graham Hutton and Erik Meijer). diff --git a/cpphs.cabal b/cpphs.cabal --- a/cpphs.cabal +++ b/cpphs.cabal @@ -1,5 +1,5 @@ Name: cpphs -Version: 1.13.3 +Version: 1.14 Copyright: 2004-2012, Malcolm Wallace License: LGPL License-File: LICENCE-LGPL diff --git a/cpphs.hs b/cpphs.hs --- a/cpphs.hs +++ b/cpphs.hs @@ -20,7 +20,7 @@ import Data.List ( isPrefixOf ) version :: String -version = "1.12" +version = "1.14" main :: IO () main = do diff --git a/docs/index.html b/docs/index.html --- a/docs/index.html +++ b/docs/index.html @@ -198,12 +198,12 @@ Current stable version:

-cpphs-1.13, release date 2011.09.26
+cpphs-1.14, release date 2012.07.11
By HTTP: -.tar.gz, +.tar.gz, Hackage.

@@ -226,7 +226,17 @@

Older versions: +

+cpphs-1.13, release date 2011.09.26
+By HTTP: +.tar.gz, +Hackage. +

+ +

cpphs-1.12, release date 2011.06.26
By HTTP: .tar.gz, @@ -592,7 +602,7 @@ Malcolm.Wallace@me.com -

Copyright: © 2004-2011 Malcolm Wallace, +

Copyright: © 2004-2012 Malcolm Wallace, except for ParseLib (Copyright © 1995 Graham Hutton and Erik Meijer)

License: The library modules in cpphs are distributed under