parse include stack from preprocessed c output.

1 files changed, 44 insertions, 0 deletions

diff --git a/c2haskell.hs b/c2haskell.hs
index 0c31c93..cc590c3 100644
--- a/c2haskell.hs
+++ b/c2haskell.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BangPatterns             #-}
 {-# LANGUAGE DeriveFunctor            #-}
 {-# LANGUAGE FlexibleContexts         #-}
@@ -10,9 +11,12 @@ import Data.Generics.Aliases
 import Data.Generics.Schemes
 -- import Debug.Trace
 import Control.Monad
+import qualified Data.ByteString.Char8 as B
 import Data.Char
 import Data.Data
 import Data.List
+import qualified Data.IntMap           as IntMap
+         ;import Data.IntMap           (IntMap)
 import qualified Data.Map           as Map
          ;import Data.Map           (Map)
 import Data.Maybe
@@ -21,6 +25,7 @@ import qualified Data.Set           as Set
 import Language.C.Data.Ident        as C
 import Language.C                   as C hiding (prettyUsingInclude)
 import Language.C.System.GCC
+import Language.C.System.Preprocess
 import Language.C.Data.Position
 import Language.Haskell.Exts.Parser as HS
 import Language.Haskell.Exts.Pretty as HS
@@ -336,6 +341,7 @@ data C2HaskellOptions = C2HaskellOptions
     , prettyC        :: Bool
     , prettyTree     :: Bool
     , verbose        :: Bool
+    , preprocess    :: Bool
     }
 
 defopts = C2HaskellOptions
@@ -343,6 +349,7 @@ defopts = C2HaskellOptions
     , prettyC        = False
     , prettyTree     = False
     , verbose        = False
+    , preprocess     = False
     }
 
 parseOptions []            opts = opts
@@ -355,9 +362,13 @@ parseOptions ("-t":args) opts = parseOptions args opts
 parseOptions ("-p":args) opts = parseOptions args opts
     { prettyC = True
     }
+parseOptions ("--cpp":args) opts = parseOptions args opts
+    { preprocess = True
+    }
 parseOptions ("-v":args) opts = parseOptions args opts
     { verbose = True
     }
+parseOptions as x = error (show as)
 
 getsig (k,si) = do
     d <- take 1 $ symbolSource si
@@ -779,6 +790,33 @@ eraseNodeInfo _ = OnlyPos p (p,0) -- undefNode value doesn't ppShow well.
  where
     p = position 0 "" 0 0 Nothing
 
+
+newtype IncludeStack = IncludeStack
+    { includes :: Map FilePath [[FilePath]]
+    }
+ deriving Show
+
+emptyIncludes = IncludeStack Map.empty
+
+openInclude fname stack (IncludeStack m) = IncludeStack $ Map.alter go fname m
+ where
+    go Nothing  = Just [stack]
+    go (Just s) = Just $ stack : s
+
+findQuoted xs = takeWhile (/='"') $ drop 1 $ dropWhile (/='"') xs
+
+includeStack bs = foldr go (const emptyIncludes) incs []
+ where
+    incs = filter (\b -> fmap fst (B.uncons b) == Just '#') $ B.lines bs
+
+    fp inc = findQuoted $ B.unpack inc
+    -- fno inc = read $ concat $ take 1 $ words $ drop 2 $ B.unpack inc
+
+    go inc xs stack
+        | "1" `elem` B.words inc = let f = fp inc in openInclude f stack (xs (f : stack))
+        | "2" `elem` B.words inc = xs (drop 1 stack)
+        | otherwise              = xs stack
+
 main :: IO ()
 main = do
     self <- getProgName
@@ -789,6 +827,12 @@ main = do
         r <- parseCFile (newGCC "gcc") Nothing cargs fname
         cs <- readComments fname
         case () of
+            _ | preprocess hopts -- --cpp
+                -> do
+                r2 <- runPreprocessor (newGCC "gcc") (rawCppArgs cargs fname)
+                case r2 of
+                    Left e -> print e
+                    Right bs -> putStrLn $ ppShow $ includeStack $ bs
             _ | prettyC hopts -- -p
                  -> do
                 print (fmap prettyUsingInclude r)