Add includes to stubs file.

1 files changed, 29 insertions, 6 deletions

diff --git a/c2haskell.hs b/c2haskell.hs
index 48b30e3..9c910ef 100644
--- a/c2haskell.hs
+++ b/c2haskell.hs
@@ -25,6 +25,7 @@ import qualified Data.Set           as Set
          ;import Data.Set           (Set)
 import Language.C.Data.Ident        as C
 import Language.C                   as C hiding (prettyUsingInclude)
+import qualified Language.C         as C
 import Language.C.System.GCC
 import Language.C.System.Preprocess
 import Language.C.Data.Position
@@ -66,10 +67,8 @@ prettyUsingInclude incs (CTranslUnit edecls _) =
     isHeaderFile = (".h" `isSuffixOf`)
 
     sysfst (Left ('"':a)) (Left ('<':b)) = Prelude.GT
-    sysfst (Left a) (Left b) = trace (show (a,b)) $ Prelude.GT
     sysfst _              _              = Prelude.LT
 
-
 includeTopLevel (IncludeStack incs) f = do
     stacks <- maybeToList $ Map.lookup f incs
     stack <- take 1 stacks
@@ -413,9 +412,8 @@ makeAcceptableImport (HS.TyFun a (TyCon c (UnQual d (HS.Ident e x))) xs)
 makeAcceptableImport t = t
 
 -- c2haskell :: Foldable t => C2HaskellOptions -> p -> t String -> CTranslationUnit NodeInfo -> IO ()
-c2haskell :: Foldable t =>
-                   C2HaskellOptions
-                   -> p1 -> t String -> IncludeStack -> CTranslationUnit NodeInfo -> IO ()
+c2haskell :: C2HaskellOptions
+                   -> p1 -> [String] -> IncludeStack -> CTranslationUnit NodeInfo -> IO ()
 c2haskell opts cs missings incs (CTranslUnit edecls _) = do
     let db = foldr update initTranspile edecls
         es = Map.filter (\d -> symbolLocal d && not (symbolStatic d)) (syms db)
@@ -491,12 +489,30 @@ c2haskell opts cs missings incs (CTranslUnit edecls _) = do
             -}
           putStrLn $ "writing " ++ stubsname
           withFile stubsname WriteMode $ \stubsfile -> do
+          {-
           forM_ missings $ \sym ->
               forM_ (Map.lookup sym$ syms db) $ \si -> do
                 forM_ (take 1 $ symbolSource si) $ \d -> do
                     hPutStrLn stubsfile $ show $ pretty $ makeFunctionPointer d
                     hPutStrLn stubsfile $ show $ pretty $ makeSetter d
                     hPutStrLn stubsfile $ show $ pretty $ makeStub d
+            -}
+          -- mkNodeInfo :: Position -> Name -> NodeInfo
+          let decls = map (setPos $ initPos stubsname) $ do
+                sym <- missings
+                si <- maybeToList $ Map.lookup sym (syms db)
+                d <- take 1 $ symbolSource si
+                [ makeFunctionPointer d, makeSetter d, makeStub d]
+              ns = listify (mkQ False (\ni -> let _ = ni :: C.NodeInfo in True)) decls :: [C.NodeInfo]
+              headerOfNode n = do
+                f <- fileOfNode n
+                case includeTopLevel incs f of
+                    "" -> Nothing
+                    h  -> Just h
+              is = uniq $ mapMaybe headerOfNode ns
+          hPutStrLn stubsfile "#include <stdio.h>"
+          hPutStrLn stubsfile $ concatMap (\i -> "#include " ++ i ++ "\n") is
+          hPutStrLn stubsfile $ show $ pretty $ CTranslUnit decls undefNode
 
         Just cfun -> do
           forM_ (Map.lookup cfun $ syms db) $ \si -> do
@@ -558,6 +574,13 @@ changeArgList3 f (Just (CDeclr a x b c d)) = Just (CDeclr a (f x) b c d)
 changeArgList f (CFDefExt (CFunDef xs ys zs c d)) = CFDefExt (CFunDef xs (changeArgList1 f ys) zs c d)
 changeArgList f (CDeclExt (CDecl xs ys pos)) = (CDeclExt (CDecl xs (changeArgList2 f ys) pos))
 
+{-
+setPosOfNode :: Position -> NodeInfo -> NodeInfo
+setPosOfNode pos n = maybe (mkNodeInfoOnlyPos pos) (mkNodeInfo pos) $ nameOfNode n
+
+setPos pos (CFDefExt (CFunDef xs ys zs c n)) = (CFDefExt (CFunDef xs ys zs c $ setPosOfNode pos n))
+setPos pos (CDeclExt (CDecl xs ys n))        = (CDeclExt (CDecl xs ys $ setPosOfNode pos n))
+-}
 
 getArgList1 (CDeclr a xs b c d) = xs
 
@@ -857,7 +880,7 @@ main = do
                     Right bs -> putStrLn $ ppShow $ includeStack $ bs
             _ | prettyC hopts -- -p
                  -> do
-                print (fmap (\(incs,decls) -> prettyUsingInclude incs decls) r)
+                either print (\(incs,decls) -> print $ prettyUsingInclude incs decls) r
             _ | prettyTree hopts -- -t
                  -> do
                 putStrLn $ ppShow $ everywhere (mkT eraseNodeInfo) . snd <$> r