From 4c37b2f61273995fe7126a57b8c47a6ebda0b6a2 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Wed, 21 Nov 2018 14:32:02 -0500
Subject: wip: monkey-patch stub. support void functions.

---
 c2haskell.hs | 57 ++++++++++++++++++++++++++++++---------------------------
 1 file 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
 makeAcceptableDecl (HS.TypeDecl a (DHead b (HS.Ident c signame)) ftyp)
                 =  (HS.TypeDecl a (DHead b (HS.Ident c signame)) (makeFunctionUseIO $ makeAcceptableImport ftyp))
 
-makeSetter d@(CDeclExt (CDecl xs ys pos)) =
+makeSetter d = -- @(CDeclExt (CDecl xs ys pos)) =
     let name = concatMap identToString $ take 1 $ catMaybes $ sym d
     in setBody (setterBody ("f_"++name)) $ changeReturnValue (const voidReturnType) $ changeArgList (const voidp) $ changeName ("setf_"++) d
 
@@ -532,15 +532,14 @@ setBody bdy (CDeclExt (CDecl xs ys pos)) = (CFDefExt (CFunDef xs v [] bdy pos))
                 (Just y,_,_):_ -> y
                 _              -> CDeclr Nothing [] Nothing [] pos
 
-makeStub d@(CDeclExt (CDecl xs ys pos)) =
+makeStub d = -- @(CDeclExt (CDecl xs ys pos)) =
     let oargs:xs = getArgList d
         (args,vs) = makeParameterNames oargs
         name = concatMap identToString $ take 1 $ catMaybes $ sym d
-        rval = () -- todo
+        rval = True -- todo: Set False for void function.
     in setBody (stubBody ("f_"++name) vs rval) $ changeArgList (const $ args:xs) d
 
 
-
 parameterIdent :: CDeclaration a -> Maybe Ident
 parameterIdent (CDecl _ xs n) = listToMaybe $ do
     (Just (CDeclr (Just x) _ _ _ _),_,_) <- xs
@@ -591,33 +590,37 @@ stubBody name vs rval =
               [ CBlockStmt
                    (CIf
                       (CVar (C.Ident name 0 undefNode) undefNode)
-                      (CReturn
-                         (Just
-                            (C.CCall
-                               (CVar (C.Ident name 0 undefNode) undefNode)
-                               vs
-                               undefNode))
-                         undefNode)
-                      (Just
-                         (CExpr
-                            (Just
-                               (C.CCall
-                                  (CVar
-                                     (C.Ident
-                                        "printf"
-                                        0
-                                        undefNode)
+                      (if rval
+                          then (CReturn
+                                     (Just
+                                        (C.CCall
+                                           (CVar (C.Ident name 0 undefNode) undefNode)
+                                           vs
+                                           undefNode))
                                      undefNode)
-                                  [ CConst
-                                      (CStrConst
-                                         (cString $ "missing symbol: " ++ name ++ ".\n")
-                                         undefNode)
-                                  ]
-                                  undefNode))
-                            undefNode))
+                          else (CExpr (Just (C.CCall (CVar (C.Ident name 0 undefNode) undefNode)
+                                                     vs
+                                                     undefNode))
+                                     undefNode))
+                      (Just
+                         (if rval
+                            then CCompound []
+                                [ CBlockStmt printmsg
+                                , CBlockStmt (CReturn (Just $ CConst (CIntConst (cInteger 0) undefNode)) undefNode)]
+                                undefNode
+                            else printmsg))
                       undefNode)
                ]
                undefNode
+    where
+        printmsg = (CExpr (Just (C.CCall (CVar (C.Ident "fputs" 0 undefNode) undefNode)
+                                         [ CConst
+                                              (CStrConst
+                                                 (cString $ "missing symbol: " ++ name ++ ".\n")
+                                                 undefNode)
+                                         , CVar (C.Ident "stderr" 0 undefNode) undefNode
+                                         ]
+                                         undefNode)) undefNode)
 
 setterBody :: String -> CStatement NodeInfo
 setterBody name =
-- 
cgit v1.2.3