diff options
author | Joe Crayne <joe@jerkface.net> | 2018-11-21 14:32:02 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-11-21 14:32:02 -0500 |
commit | 4c37b2f61273995fe7126a57b8c47a6ebda0b6a2 (patch) | |
tree | 7080e83a7e36401edd9522c9f1d07aed9aa547d1 | |
parent | 708e7fe2ce4872fa381f54ddb03890306444ca7b (diff) |
wip: monkey-patch stub. support void functions.
-rw-r--r-- | c2haskell.hs | 57 |
1 files changed, 30 insertions, 27 deletions
diff --git a/c2haskell.hs b/c2haskell.hs index 1b3144f..c55458a 100644 --- a/c2haskell.hs +++ b/c2haskell.hs | |||
@@ -498,7 +498,7 @@ changeName f d = d | |||
498 | makeAcceptableDecl (HS.TypeDecl a (DHead b (HS.Ident c signame)) ftyp) | 498 | makeAcceptableDecl (HS.TypeDecl a (DHead b (HS.Ident c signame)) ftyp) |
499 | = (HS.TypeDecl a (DHead b (HS.Ident c signame)) (makeFunctionUseIO $ makeAcceptableImport ftyp)) | 499 | = (HS.TypeDecl a (DHead b (HS.Ident c signame)) (makeFunctionUseIO $ makeAcceptableImport ftyp)) |
500 | 500 | ||
501 | makeSetter d@(CDeclExt (CDecl xs ys pos)) = | 501 | makeSetter d = -- @(CDeclExt (CDecl xs ys pos)) = |
502 | let name = concatMap identToString $ take 1 $ catMaybes $ sym d | 502 | let name = concatMap identToString $ take 1 $ catMaybes $ sym d |
503 | in setBody (setterBody ("f_"++name)) $ changeReturnValue (const voidReturnType) $ changeArgList (const voidp) $ changeName ("setf_"++) d | 503 | in setBody (setterBody ("f_"++name)) $ changeReturnValue (const voidReturnType) $ changeArgList (const voidp) $ changeName ("setf_"++) d |
504 | 504 | ||
@@ -532,15 +532,14 @@ setBody bdy (CDeclExt (CDecl xs ys pos)) = (CFDefExt (CFunDef xs v [] bdy pos)) | |||
532 | (Just y,_,_):_ -> y | 532 | (Just y,_,_):_ -> y |
533 | _ -> CDeclr Nothing [] Nothing [] pos | 533 | _ -> CDeclr Nothing [] Nothing [] pos |
534 | 534 | ||
535 | makeStub d@(CDeclExt (CDecl xs ys pos)) = | 535 | makeStub d = -- @(CDeclExt (CDecl xs ys pos)) = |
536 | let oargs:xs = getArgList d | 536 | let oargs:xs = getArgList d |
537 | (args,vs) = makeParameterNames oargs | 537 | (args,vs) = makeParameterNames oargs |
538 | name = concatMap identToString $ take 1 $ catMaybes $ sym d | 538 | name = concatMap identToString $ take 1 $ catMaybes $ sym d |
539 | rval = () -- todo | 539 | rval = True -- todo: Set False for void function. |
540 | in setBody (stubBody ("f_"++name) vs rval) $ changeArgList (const $ args:xs) d | 540 | in setBody (stubBody ("f_"++name) vs rval) $ changeArgList (const $ args:xs) d |
541 | 541 | ||
542 | 542 | ||
543 | |||
544 | parameterIdent :: CDeclaration a -> Maybe Ident | 543 | parameterIdent :: CDeclaration a -> Maybe Ident |
545 | parameterIdent (CDecl _ xs n) = listToMaybe $ do | 544 | parameterIdent (CDecl _ xs n) = listToMaybe $ do |
546 | (Just (CDeclr (Just x) _ _ _ _),_,_) <- xs | 545 | (Just (CDeclr (Just x) _ _ _ _),_,_) <- xs |
@@ -591,33 +590,37 @@ stubBody name vs rval = | |||
591 | [ CBlockStmt | 590 | [ CBlockStmt |
592 | (CIf | 591 | (CIf |
593 | (CVar (C.Ident name 0 undefNode) undefNode) | 592 | (CVar (C.Ident name 0 undefNode) undefNode) |
594 | (CReturn | 593 | (if rval |
595 | (Just | 594 | then (CReturn |
596 | (C.CCall | 595 | (Just |
597 | (CVar (C.Ident name 0 undefNode) undefNode) | 596 | (C.CCall |
598 | vs | 597 | (CVar (C.Ident name 0 undefNode) undefNode) |
599 | undefNode)) | 598 | vs |
600 | undefNode) | 599 | undefNode)) |
601 | (Just | ||
602 | (CExpr | ||
603 | (Just | ||
604 | (C.CCall | ||
605 | (CVar | ||
606 | (C.Ident | ||
607 | "printf" | ||
608 | 0 | ||
609 | undefNode) | ||
610 | undefNode) | 600 | undefNode) |
611 | [ CConst | 601 | else (CExpr (Just (C.CCall (CVar (C.Ident name 0 undefNode) undefNode) |
612 | (CStrConst | 602 | vs |
613 | (cString $ "missing symbol: " ++ name ++ ".\n") | 603 | undefNode)) |
614 | undefNode) | 604 | undefNode)) |
615 | ] | 605 | (Just |
616 | undefNode)) | 606 | (if rval |
617 | undefNode)) | 607 | then CCompound [] |
608 | [ CBlockStmt printmsg | ||
609 | , CBlockStmt (CReturn (Just $ CConst (CIntConst (cInteger 0) undefNode)) undefNode)] | ||
610 | undefNode | ||
611 | else printmsg)) | ||
618 | undefNode) | 612 | undefNode) |
619 | ] | 613 | ] |
620 | undefNode | 614 | undefNode |
615 | where | ||
616 | printmsg = (CExpr (Just (C.CCall (CVar (C.Ident "fputs" 0 undefNode) undefNode) | ||
617 | [ CConst | ||
618 | (CStrConst | ||
619 | (cString $ "missing symbol: " ++ name ++ ".\n") | ||
620 | undefNode) | ||
621 | , CVar (C.Ident "stderr" 0 undefNode) undefNode | ||
622 | ] | ||
623 | undefNode)) undefNode) | ||
621 | 624 | ||
622 | setterBody :: String -> CStatement NodeInfo | 625 | setterBody :: String -> CStatement NodeInfo |
623 | setterBody name = | 626 | setterBody name = |