Invoke linker to determine missing symbols.

1 files changed, 49 insertions, 4 deletions

diff --git a/c2haskell.hs b/c2haskell.hs
index 2fbbfc2..5602c10 100644
--- a/c2haskell.hs
+++ b/c2haskell.hs
@@ -28,6 +28,8 @@ import Language.Haskell.TH.Ppr
 import Language.Haskell.TH.Syntax   as TH
 import System.Environment
 import System.IO
+import System.Process
+import System.Exit
 import Text.PrettyPrint             (Doc, doubleQuotes, empty, text, vcat, ($$),
                                      (<+>))
 import Text.Show.Pretty
@@ -349,7 +351,7 @@ isAcceptableImport (TyCon _ _) = True
 isAcceptableImport (TyApp _ _ _) = True
 isAcceptableImport _ = False
 
-c2haskell opts cs (CTranslUnit edecls _) = do
+c2haskell opts cs missings (CTranslUnit edecls _) = do
     let db = foldr update initTranspile edecls
         es = Map.filter (\d -> symbolLocal d && not (symbolStatic d)) (syms db)
     case selectFunction opts of
@@ -380,6 +382,17 @@ c2haskell opts cs (CTranslUnit edecls _) = do
                          $ HS.prettyPrint $ (HS.ForImp () (HS.CCall ()) Nothing (Just k)
                                                      (HS.Ident () k)
                                                      htyp)
+          forM_ missings $ \sym -> goMissing db sym
+          {-
+          forM_ (Map.lookup sym $ syms db) $ \si -> do
+            forM_ (take 1 $ symbolSource si) $ \d -> do
+                let ts = filter notKnown $ map tname $ pointers $ concatMap types $ sigf hsTransSig d
+                -- putStr $ commented (ppShow (fmap (const ()) d))
+                -- putStr $ commented (show $ pretty d)
+                let typ = (TyCon () (Special () (UnitCon ())))
+                -- when (null $ sig d) $ putStr $ commented (ppShow (fmap (const ()) d))
+                forM_ (sig d) $ \htyp -> do
+                    putStrLn $ HS.prettyPrint htyp
 
                 -- mapM_ (putStrLn . HS.prettyPrint) (sig d)
                 {-
@@ -393,8 +406,12 @@ c2haskell opts cs (CTranslUnit edecls _) = do
                 putStr $ commented "mutations"
                 mapM_ (putStr . commented . show . pretty) (mutations (body d))
                 -}
-        Just cfun -> do
-            forM_ (symbolSource $ syms db Map.! cfun) $ \d -> do
+            -}
+        Just cfun -> goMissing db cfun
+
+goMissing db cfun = do
+      forM_ (Map.lookup cfun $ syms db) $ \si -> do
+        forM_ (take 1 $ symbolSource si) $ \d -> do
                 -- putStr $ commented (ppShow (fmap (const ()) d))
                 -- putStr $ commented (show $ pretty d)
                 -- when (verbose opts) $ print (sig d)
@@ -476,6 +493,33 @@ usage args = do
 (<&>) :: Functor f => f a -> (a -> b) -> f b
 m <&> f = fmap f m
 
+uniq xs = Map.keys $ foldr (\x m -> Map.insert x () m) Map.empty xs
+
+unquote :: String -> String
+unquote xs = zipWith const (drop 1 xs) (drop 2 xs)
+
+missingSymbols s = uniq $ do
+    e <- lines s
+    let (_,us) = break (=="undefined") $ words e
+    if null us then []
+    else do
+        let q = concat $ take 1 $ reverse us
+        c <- take 1 q
+        guard $ c=='`' || c=='\''
+        return $ unquote q
+
+
+linker cargs fname = do
+    (hin,hout,Just herr,hproc) <- createProcess (proc "gcc" $ cargs ++ [fname])
+        { std_err = CreatePipe }
+    linkerrs <- hGetContents herr
+    ecode <- waitForProcess hproc
+    case ecode of
+        ExitSuccess -> hPutStrLn stderr $ "Oops: "++fname++" has main() symbol."
+        _           -> return ()
+    return $ missingSymbols linkerrs
+
+
 main :: IO ()
 main = do
     self <- getProgName
@@ -490,4 +534,5 @@ main = do
             then do
                 print (fmap prettyUsingInclude r)
             else do
-                either print (c2haskell hopts cs) r
+                syms <- linker cargs fname
+                either print (c2haskell hopts cs syms) r