diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-22 02:51:06 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-22 02:51:06 -0400 |
commit | 7ddd2d513c5ebf0ab3e015d42870fcc666be7dc4 (patch) | |
tree | d56793042ee162b866478514fb18e12e3d109800 /monkeypatch.hs | |
parent | 819bc6302329b6fbaac38c8bb67dd5c8a96498c4 (diff) |
FunctionEnvironment type.
Diffstat (limited to 'monkeypatch.hs')
-rw-r--r-- | monkeypatch.hs | 35 |
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 | |||
198 | 198 | ||
199 | -- Returns a list of statements bringing variables into scope and an | 199 | -- Returns a list of statements bringing variables into scope and an |
200 | -- expression. | 200 | -- expression. |
201 | -- | ||
202 | -- TODO: FunctionEnvironment argument. | ||
201 | grokExpression :: CExpression a | 203 | grokExpression :: CExpression a |
202 | -> Maybe ([Computation (HS.Exp ())], Computation (HS.Exp ())) | 204 | -> Maybe ([Computation (HS.Exp ())], Computation (HS.Exp ())) |
203 | grokExpression (CVar cv _) = Just $ (,) [] $ Computation | 205 | grokExpression (CVar cv _) = Just $ (,) [] $ Computation |
@@ -375,6 +377,7 @@ grokInitialization ts (Just (CDeclr (Just cv0) _ _ _ _),CInitList exps _) = do | |||
375 | grokInitialization _ _ = Nothing | 377 | grokInitialization _ _ = Nothing |
376 | 378 | ||
377 | 379 | ||
380 | -- TODO: FunctionEnvironment argument. | ||
378 | grokStatement :: CCompoundBlockItem a -> Maybe (Computation (HS.Exp ())) | 381 | grokStatement :: CCompoundBlockItem a -> Maybe (Computation (HS.Exp ())) |
379 | grokStatement (CBlockStmt (CReturn (Just exp) _)) = do | 382 | grokStatement (CBlockStmt (CReturn (Just exp) _)) = do |
380 | (xs,x) <- grokExpression exp | 383 | (xs,x) <- grokExpression exp |
@@ -575,15 +578,30 @@ transpile o fname incs (CTranslUnit edecls _) = do | |||
575 | i <- m | 578 | i <- m |
576 | maybe [] (return . identToString) i | 579 | maybe [] (return . identToString) i |
577 | -- mapM_ (putStrLn . show . pretty) (symbolSource sym) | 580 | -- mapM_ (putStrLn . show . pretty) (symbolSource sym) |
578 | let mprintHeader = do | 581 | let mgroked_sig = do |
579 | hh <- listToMaybe h | 582 | hh <- changeType makeFunctionUseIO <$> listToMaybe h |
580 | guard (isJust (oSelectFunction o) || isFunctionDecl c) | 583 | guard (isJust (oSelectFunction o) || isFunctionDecl c) |
581 | Just $ do | 584 | Just hh |
585 | |||
586 | -- TypeSig () [Ident () "fetch_about_maps_handler"] | ||
587 | -- (TyFun () (TyApp () (TyCon () (UnQual () (Ident () "Ptr"))) (TyCon () (UnQual () (Ident () "FetchAboutContext")))) | ||
588 | -- (TyApp () (TyCon () (UnQual () (Ident () "IO"))) (TyCon () (UnQual () (Ident () "Bool"))))) | ||
589 | -- fetch_about_maps_handler :: Ptr FetchAboutContext -> IO Bool | ||
590 | |||
591 | |||
592 | forM_ mgroked_sig $ \hh -> do | ||
593 | let printHeader = do | ||
582 | -- putStrLn $ show (fmap (const LT) c) | 594 | -- putStrLn $ show (fmap (const LT) c) |
583 | putStrLn . HS.prettyPrint $ changeType makeFunctionUseIO hh | 595 | -- putStrLn . show $ fnArgs fe |
596 | putStrLn . HS.prettyPrint $ hh | ||
584 | putStrLn $ unwords (hname:as) ++ " =" | 597 | putStrLn $ unwords (hname:as) ++ " =" |
585 | forM_ mprintHeader $ \printHeader -> do | 598 | |
586 | let bdy0 = concat $ take 1 $ dropWhile null $ map body $ symbolSource sym | 599 | bdy0 = concat $ take 1 $ dropWhile null $ map body $ symbolSource sym |
600 | |||
601 | ts = case hh of | ||
602 | TypeSig _ _ t -> unfoldr (\case { TyFun _ a b -> Just (a,b) ; b -> Just (b,b) }) t -- careful: infinite list | ||
603 | _ -> [] | ||
604 | fe = FunctionEnvironment (syms db) $ Map.fromList $ zip (as ++ [""]) ts | ||
587 | 605 | ||
588 | let extent = getSymbolExtent sym bdy0 | 606 | let extent = getSymbolExtent sym bdy0 |
589 | cs0 <- readComments (posFile $ startExtent extent) -- TODO: Avoid parsing the same file multiple times. | 607 | cs0 <- readComments (posFile $ startExtent extent) -- TODO: Avoid parsing the same file multiple times. |
@@ -649,6 +667,11 @@ symbolInformation = SymbolInformation | |||
649 | , symbolSource = mempty | 667 | , symbolSource = mempty |
650 | } | 668 | } |
651 | 669 | ||
670 | data FunctionEnvironment = FunctionEnvironment | ||
671 | { fnExternals :: Map String (SymbolInformation [CExternalDeclaration NodeInfo]) | ||
672 | , fnArgs :: Map String (HS.Type ()) | ||
673 | } | ||
674 | |||
652 | data Transpile c = Transpile | 675 | data Transpile c = Transpile |
653 | { syms :: Map String (SymbolInformation c) | 676 | { syms :: Map String (SymbolInformation c) |
654 | } | 677 | } |