monkey-patch setter finished.

1 files changed, 30 insertions, 1 deletions

diff --git a/c2haskell.hs b/c2haskell.hs
index dbdde9c..d692558 100644
--- a/c2haskell.hs
+++ b/c2haskell.hs
@@ -497,7 +497,9 @@ 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)) = changeReturnValue (const voidReturnType) $ changeArgList (const voidp) $ changeName ("setf_"++) d
+makeSetter d@(CDeclExt (CDecl xs ys pos)) =
+    let name = concatMap identToString $ take 1 $ catMaybes $ sym d
+    in setSetterBody ("f_"++name) $ changeReturnValue (const voidReturnType) $ changeArgList (const voidp) $ changeName ("setf_"++) d
 
 changeArgList1 f (CDeclr a xs b c d) = CDeclr a (f xs) b c d
 
@@ -514,6 +516,11 @@ changeReturnValue f (CDeclExt (CDecl xs ys pos)) = (CDeclExt (CDecl (f xs) ys po
 
 voidReturnType = [ CTypeSpec (CVoidType undefNode) ]
 
+setSetterBody name (CFDefExt (CFunDef xs ys zs c d)) = (CFDefExt (CFunDef xs ys zs (setterBody name) d))
+setSetterBody name (CDeclExt (CDecl xs ys pos)) = (CFDefExt (CFunDef xs v [] (setterBody name) pos))
+    where v = case ys of
+                (Just y,_,_):_ -> y
+                _              -> CDeclr Nothing [] Nothing [] pos
 
 voidp :: [CDerivedDeclarator NodeInfo]
 voidp = [ CFunDeclr
@@ -538,6 +545,22 @@ voidp = [ CFunDeclr
      where n = undefNode
 
 
+setterBody :: String -> CStatement NodeInfo
+setterBody name =
+    CCompound []
+              [ CBlockStmt
+                  (CExpr
+                     (Just
+                        (CAssign
+                           CAssignOp
+                           (CVar (C.Ident name 0 undefNode) undefNode)
+                           (CVar (C.Ident "p" 0 undefNode) undefNode)
+                           undefNode))
+                     undefNode)
+              ]
+              undefNode
+
+
 goMissing db cfun = do
       forM_ (Map.lookup cfun $ syms db) $ \si -> do
         forM_ (take 1 $ symbolSource si) $ \d -> do
@@ -579,6 +602,8 @@ goMissing db cfun = do
 
 readComments fname = parseComments 1 1 <$> readFile fname
 
+findCloser :: (Num a4, Num a3, Num a2, Num a1, Eq a1) =>
+                    a1 -> (a4, a2, a3) -> [Char] -> (a4, a2, a3)
 findCloser !1 (l,c,b) ('*':'/':_)  = (l,c+2,b+2)
 findCloser !d (l,c,b) ('*':'/':xs) = findCloser (d - 1) (l,c+2,b+2) xs
 findCloser !d (l,c,b) ('/':'*':xs) = findCloser (d + 1) (l,c+2,b+2) xs
@@ -586,6 +611,7 @@ findCloser !d (l,c,b) ('\n':xs)    = findCloser d (l+1,1,b+1) xs
 findCloser !d (l,c,b) (_:xs)       = findCloser d (l,c+1,b+1) xs
 findCloser !d (l,c,b) []           = (l,c,b)
 
+mkComment :: a -> b -> c -> (a, b, c)
 mkComment lin no str = (lin,no,str)
 
 parseComments :: (Num col, Num lin) => lin -> col -> [Char] -> [(lin, col, [Char])]
@@ -621,11 +647,13 @@ usage args = do
 (<&>) :: Functor f => f a -> (a -> b) -> f b
 m <&> f = fmap f m
 
+uniq :: (Ord k, Foldable t) => t k -> [k]
 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 :: String -> [String]
 missingSymbols s = uniq $ do
     e <- lines s
     let (_,us) = break (=="undefined") $ words e
@@ -637,6 +665,7 @@ missingSymbols s = uniq $ do
         return $ unquote q
 
 
+linker :: [String] -> String -> IO [String]
 linker cargs fname = do
     (hin,hout,Just herr,hproc) <- createProcess (proc "gcc" $ cargs ++ [fname])
         { std_err = CreatePipe }