cpphs 1.10 → 1.11

raw patch · 8 files changed

+118/−86 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• Language/Preprocessor/Cpphs/CppIfdef.hs +40/−33
• Language/Preprocessor/Cpphs/MacroPass.hs +48/−37
• Language/Preprocessor/Cpphs/RunCpphs.hs +8/−8
• Makefile +1/−1
• cpphs.cabal +1/−1
• cpphs.hs +3/−2
• docs/index.html +13/−4

@@ -1,3 +1,7 @@+Version 1.11+------------+  * API change: runCpphs, cppIfdef, and macroPass are now in the IO monad.+ Version 1.10 -----------   * New command-line option: "--linepragma"

@@ -14,7 +14,7 @@  module Language.Preprocessor.Cpphs.CppIfdef   ( cppIfdef	-- :: FilePath -> [(String,String)] -> [String] -> Options-		--      -> String -> [(Posn,String)]+		--      -> String -> IO [(Posn,String)]   ) where  @@ -30,7 +30,7 @@ import Language.Preprocessor.Cpphs.MacroPass (preDefine,defineMacro) import Char      (isDigit) import Numeric   (readHex,readOct,readDec)-import System.IO.Unsafe (unsafePerformIO)+import System.IO.Unsafe (unsafeInterleaveIO) import IO        (hPutStrLn,stderr)  @@ -41,7 +41,7 @@ 	-> [String]		-- ^ Search path for \#includes 	-> BoolOptions		-- ^ Options controlling output style 	-> String		-- ^ The input file content-	-> [(Posn,String)]	-- ^ The file after processing (in lines)+	-> IO [(Posn,String)]	-- ^ The file after processing (in lines) cppIfdef fp syms search options =     cpp posn defs search options Keep . (cppline posn:) . linesCpp   where@@ -60,8 +60,8 @@  -- | Return just the list of lines that the real cpp would decide to keep. cpp :: Posn -> SymTab HashDefine -> [String] -> BoolOptions -> KeepState-       -> [String] -> [(Posn,String)]-cpp _ _ _ _ _ [] = []+       -> [String] -> IO [(Posn,String)]+cpp _ _ _ _ _ [] = return []  cpp p syms path options Keep (l@('#':x):xs) =     let ws = words x@@ -74,8 +74,8 @@         keepIf p = if p then Keep else (Drop 1 False)         skipn syms' retain ud xs' =             let n = 1 + length (filter (=='\n') l) in-            (if macros options && retain then ((p,reslash l):)-                                         else (replicate n (p,"") ++)) $+            (if macros options && retain then emitOne  (p,reslash l)+                                         else emitMany (replicate n (p,""))) $             cpp (newlines n p) syms' path options ud xs'     in case cmd of 	"define" -> skipn (insertST def syms) True Keep xs@@ -89,39 +89,37 @@ 	"endif"  -> skipn syms False  Keep xs 	"pragma" -> skipn syms True   Keep xs         ('!':_)  -> skipn syms False  Keep xs	-- \#!runhs scripts-	"include"-> let (inc,content) =-	                  unsafePerformIO (readFirst (file syms (unwords line))-                                                     p path-                                                     (warnings options))-	            in-		    cpp p syms path options Keep (("#line 1 "++show inc)-                                                  : linesCpp content-                                                  ++ cppline (newline p): xs)-	"warning"-> if warnings options then unsafePerformIO $ do-                       hPutStrLn stderr (l++"\nin "++show p)-                       return $ skipn syms False Keep xs+	"include"-> do (inc,content) <- readFirst (file syms (unwords line))+                                                  p path+                                                  (warnings options)+                       cpp p syms path options Keep (("#line 1 "++show inc)+                                                    : linesCpp content+                                                    ++ cppline (newline p): xs)+	"warning"-> if warnings options then+                      do hPutStrLn stderr (l++"\nin "++show p)+                         skipn syms False Keep xs                     else skipn syms False Keep xs 	"error"  -> error (l++"\nin "++show p) 	"line"   | all isDigit sym-	         -> (if locations options && hashline options then ((p,l):)-                     else if locations options then ((p,cpp2hask l):)+	         -> (if locations options && hashline options then emitOne (p,l)+                     else if locations options then emitOne (p,cpp2hask l)                      else id) $                     cpp (newpos (read sym) (un rest) p)                         syms path options Keep xs 	n | all isDigit n-	         -> (if locations options && hashline options then ((p,l):)-                     else if locations options then ((p,cpp2hask l):)+	         -> (if locations options && hashline options then emitOne (p,l)+                     else if locations options then emitOne (p,cpp2hask l)                      else id) $ 	            cpp (newpos (read n) (un (tail ws)) p)                         syms path options Keep xs           | otherwise-	         -> if warnings options then unsafePerformIO $ do-                       hPutStrLn stderr ("Warning: unknown directive #"++n-                                        ++"\nin "++show p)-                       return $-                         ((p,l): cpp (newline p) syms path options Keep xs)-                    else-                         ((p,l): cpp (newline p) syms path options Keep xs)+	         -> if warnings options then+                      do hPutStrLn stderr ("Warning: unknown directive #"++n+                                           ++"\nin "++show p)+                         emitOne (p,l) $+                                 cpp (newline p) syms path options Keep xs+                    else emitOne (p,l) $+                                 cpp (newline p) syms path options Keep xs  cpp p syms path options (Drop n b) (('#':x):xs) =     let ws = words x@@ -136,8 +134,8 @@                  | otherwise = Drop n b         skipn ud xs' =                  let n' = 1 + length (filter (=='\n') x) in-                 replicate n' (p,"")-                 ++ cpp (newlines n' p) syms path options ud xs'+                 emitMany (replicate n' (p,"")) $+                    cpp (newlines n' p) syms path options ud xs'     in     if      cmd == "ifndef" ||             cmd == "if"     ||@@ -150,10 +148,19 @@  cpp p syms path options Keep (x:xs) =     let p' = newline p in seq p' $-    (p,x):  cpp p' syms path options Keep xs+    emitOne (p,x)  $  cpp p' syms path options Keep xs cpp p syms path options d@(Drop _ _) (_:xs) =     let p' = newline p in seq p' $-    (p,""): cpp p' syms path options d xs+    emitOne (p,"") $  cpp p' syms path options d xs+++-- | Auxiliary IO functions+emitOne  ::  a  -> IO [a] -> IO [a]+emitMany :: [a] -> IO [a] -> IO [a]+emitOne  x  io = do ys <- unsafeInterleaveIO io+                    return (x:ys)+emitMany xs io = do ys <- unsafeInterleaveIO io+                    return (xs++ys)   ----

@@ -25,7 +25,8 @@                                               , emptyST) import Language.Preprocessor.Cpphs.Position   (Posn, newfile, filename, lineno) import Language.Preprocessor.Cpphs.Options    (BoolOptions(..))-import System.IO.Unsafe (unsafePerformIO)+import System.IO.Unsafe (unsafeInterleaveIO)+import Control.Monad    ((=<<)) import Time       (getClockTime, toCalendarTime, formatCalendarTime) import Locale     (defaultTimeLocale) @@ -36,10 +37,10 @@ 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+          -> IO String		-- ^ The file after processing macroPass syms options =-    safetail		-- to remove extra "\n" inserted below-    . concat+    fmap (safetail		-- to remove extra "\n" inserted below+         . concat)     . macroProcess (pragma options) (layout options) (lang options)                    (preDefine options syms)     . tokenise (stripEol options) (stripC89 options)@@ -73,58 +74,68 @@ --   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+             -> IO [String]+macroProcess _ _ _ _         []          = return []+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)-                                              = "\n":x:macroProcess p y l st ws+                                         = emit "\n" $+                                           emit 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+               | 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-    replicate n "\n" ++macroProcess p layout lang (insertST (name hd, hd) st) ws+    emit (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+      "__FILE__" -> emit (show (filename p))$ macroProcess pr layout lang st ws+      "__LINE__" -> emit (show (lineno p))  $ macroProcess pr layout lang st ws+      "__DATE__" -> do w <- return .+                            formatCalendarTime defaultTimeLocale "\"%d %b %Y\""+                            =<< toCalendarTime =<< getClockTime+                       emit w $ macroProcess pr layout lang st ws+      "__TIME__" -> do w <- return .+                            formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""+                            =<< toCalendarTime =<< getClockTime+                       emit w $ macroProcess pr layout lang st ws       _ ->         case lookupST x st of-            Nothing -> x: macroProcess pr layout lang st ws+            Nothing -> emit x $ macroProcess pr layout lang st ws             Just hd ->                 case hd of-                    AntiDefined {name=n} -> n: macroProcess pr layout lang st ws+                    AntiDefined {name=n} -> emit n $+                                            macroProcess pr layout lang st ws                     SymbolReplacement {replacement=r} ->                         let r' = if layout then r else filter (/='\n') r in                         -- one-level expansion only:-                        -- r' : macroProcess layout st ws+                        -- emit 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+                            Nothing -> emit x $+                                       macroProcess pr layout lang st ws                             Just (args,ws') ->                                 if length args /= length (arguments hd) then-                                     x: macroProcess pr layout lang st ws-                                else let 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')+                                     emit x $ macroProcess pr layout lang st ws+                                else do args' <- mapM (fmap concat .+                                                       macroProcess pr layout+                                                                       lang st)+                                                      args+                                        -- one-level expansion only:+                                        -- emit (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') +-- | Useful helper function.+emit :: a -> IO [a] -> IO [a]+emit x io = do xs <- unsafeInterleaveIO io+               return (x:xs)

@@ -13,18 +13,18 @@ import Language.Preprocessor.Unlit as Unlit (unlit)  -runCpphs :: CpphsOptions -> FilePath -> String -> String-runCpphs options filename input =-  let bools = boolopts options+runCpphs :: CpphsOptions -> FilePath -> String -> IO String+runCpphs 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 = macroPass (defines options) bools pass1-      result= if not (macros bools) then unlines (map snd pass1) else pass2+  pass1 <- cppIfdef filename (defines options) (includes options) bools+                    (preInc++input)+  pass2 <- macroPass (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 -  in pass3 result+  return (pass3 result)

@@ -1,5 +1,5 @@ LIBRARY = cpphs-VERSION = 1.10+VERSION = 1.11  DIRS	= Language/Preprocessor/Cpphs \ 	  Text/ParserCombinators

@@ -1,5 +1,5 @@ Name: cpphs-Version: 1.10+Version: 1.11 Copyright: 2004-2010, Malcolm Wallace Build-Depends: base < 6, haskell98 License: LGPL

@@ -19,7 +19,7 @@ import List   ( isPrefixOf )  version :: String-version = "1.10"+version = "1.11"  main :: IO () main = do@@ -64,7 +64,8 @@       output Nothing x  = do putStr x; hFlush stdout       output (Just f) x = writeFile f x   in do contents <- readIt-        output ofile (runCpphs opts filename contents)+        transformed <- runCpphs opts filename contents+        output ofile transformed  isLeft (Left _) = True isLeft _ = False

@@ -198,13 +198,13 @@ <b>Current stable version:</b>  <p>-cpphs-1.10, release date 2010.01.30<br>+cpphs-1.11, release date 2010.01.31<br> By HTTP:-<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.10.tar.gz">.tar.gz</a>,-<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.10.zip">.zip</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.11.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.11.zip">.zip</a>, <a href="http://hackage.haskell.org/package/cpphs">Hackage</a>. <ul>-<li> New command-line flag: --linepragma+<li> Major API change: runCpphs, cppIfdef and macroPass are now in the IO monad. </ul>  <p>@@ -226,6 +226,15 @@  <p> <b>Older versions:</b>++<p>+cpphs-1.10, release date 2010.01.30<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.10.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.10.zip">.zip</a>,+<ul>+<li> New command-line flag: --linepragma+</ul>  <p> cpphs-1.9, release date 2009.09.07<br>