FunctionEnvironment type.

1 files changed, 29 insertions, 6 deletions

diff --git a/monkeypatch.hs b/monkeypatch.hs
index 5d9bd1b..8ed6ada 100644
--- a/monkeypatch.hs
+++ b/monkeypatch.hs
@@ -198,6 +198,8 @@ varmap vs = Map.fromList $ map (,()) vs
 
 -- Returns a list of statements bringing variables into scope and an
 -- expression.
+--
+-- TODO: FunctionEnvironment argument.
 grokExpression :: CExpression a
                   -> Maybe ([Computation (HS.Exp ())], Computation (HS.Exp ()))
 grokExpression (CVar cv _) = Just $ (,) [] $ Computation
@@ -375,6 +377,7 @@ grokInitialization ts (Just (CDeclr (Just cv0) _ _ _ _),CInitList exps _) = do
 grokInitialization _ _ = Nothing
 
 
+-- TODO: FunctionEnvironment argument.
 grokStatement :: CCompoundBlockItem a -> Maybe (Computation (HS.Exp ()))
 grokStatement (CBlockStmt (CReturn (Just exp) _)) = do
     (xs,x) <- grokExpression exp
@@ -575,15 +578,30 @@ transpile o fname incs (CTranslUnit edecls _) = do
                         i <- m
                         maybe [] (return . identToString) i
             -- mapM_ (putStrLn . show . pretty) (symbolSource sym)
-            let mprintHeader = do
-                    hh <- listToMaybe h
+            let mgroked_sig = do
+                    hh <- changeType makeFunctionUseIO <$> listToMaybe h
                     guard (isJust (oSelectFunction o) || isFunctionDecl c)
-                    Just $ do
+                    Just hh
+
+            -- TypeSig () [Ident () "fetch_about_maps_handler"]
+            --            (TyFun () (TyApp () (TyCon () (UnQual () (Ident () "Ptr"))) (TyCon () (UnQual () (Ident () "FetchAboutContext"))))
+            --                      (TyApp () (TyCon () (UnQual () (Ident () "IO"))) (TyCon () (UnQual () (Ident () "Bool")))))
+            -- fetch_about_maps_handler :: Ptr FetchAboutContext -> IO Bool
+
+
+            forM_ mgroked_sig $ \hh -> do
+                let printHeader = do
                         -- putStrLn $ show (fmap (const LT) c)
-                        putStrLn . HS.prettyPrint $ changeType makeFunctionUseIO hh
+                        -- putStrLn . show $ fnArgs fe
+                        putStrLn . HS.prettyPrint $ hh
                         putStrLn $ unwords (hname:as) ++ " ="
-            forM_ mprintHeader $ \printHeader -> do
-                let bdy0 = concat $ take 1 $ dropWhile null $ map body $ symbolSource sym
+
+                    bdy0 = concat $ take 1 $ dropWhile null $ map body $ symbolSource sym
+
+                    ts = case hh of
+                            TypeSig _ _ t -> unfoldr (\case { TyFun _ a b -> Just (a,b) ; b -> Just (b,b) }) t -- careful: infinite list
+                            _             -> []
+                    fe = FunctionEnvironment (syms db) $ Map.fromList $ zip (as ++ [""]) ts
 
                 let extent = getSymbolExtent sym bdy0
                 cs0 <- readComments (posFile $ startExtent extent) -- TODO: Avoid parsing the same file multiple times.
@@ -649,6 +667,11 @@ symbolInformation = SymbolInformation
     , symbolSource = mempty
     }
 
+data FunctionEnvironment = FunctionEnvironment
+    { fnExternals :: Map String (SymbolInformation [CExternalDeclaration NodeInfo])
+    , fnArgs      :: Map String (HS.Type ())
+    }
+
 data Transpile c = Transpile
     { syms :: Map String (SymbolInformation c)
     }