Transpile code to create structs.

1 files changed, 34 insertions, 3 deletions

diff --git a/monkeypatch.hs b/monkeypatch.hs
index beaa58f..d39ec98 100644
--- a/monkeypatch.hs
+++ b/monkeypatch.hs
@@ -10,6 +10,7 @@
 module Main where
 
 import Control.Arrow (left,first,second)
+import Data.Either
 import Data.Generics.Aliases
 import Data.Generics.Schemes
 import Debug.Trace
@@ -251,6 +252,33 @@ grokExpression (C.CCall (CVar fn _) exps _) = do
 grokExpression _ = Nothing
 
 
+grokInitialization _ (Just (CDeclr (Just cv0) _ _ _ _),CInitExpr exp _) = do
+    let v = identToString cv0
+    (xs,x) <- grokExpression exp
+    let hsexp = fmap (App () (hsvar "return")) x -- Paren () (
+        ret = flip (foldr applyComputation) xs $
+                fmap (\exp -> InfixApp () exp hsopBind
+                                $ Lambda () [hspvar v] (hsvar k)) hsexp
+        k = uniqIdentifier "go" (compFree ret)
+    return $ fmap (\exp -> Lambda () [hspvar k] exp) ret
+grokInitialization ts (Just (CDeclr (Just cv0) _ _ _ _),CInitList exps _) = do
+    let v = identToString cv0
+    let k = uniqIdentifier "go" (varmap [v])
+    case lefts $ concatMap hsTypeSpec ts of
+        (ident:_) ->
+            -- TODO: intialize fields.
+            let hident = HS.Ident () $ capitalize $ identToString ident
+            in return Computation
+                        { compFree = Map.empty -- todo
+                        , compIntro = Map.singleton v ()
+                        , comp = Lambda () [hspvar k]
+                            $ InfixApp () (App () (hsvar "newStruct") (TypeApp () (TyCon () (UnQual () hident)))) hsopBind
+                            $ Lambda () [hspvar v] (hsvar k)
+                        }
+        _ -> Nothing
+grokInitialization _ _ = Nothing
+
+
 grokStatement :: CCompoundBlockItem a -> Maybe (Computation (HS.Exp ()))
 grokStatement (CBlockStmt (CReturn (Just exp) _)) = do
     (xs,x) <- grokExpression exp
@@ -280,17 +308,20 @@ grokStatement (CBlockStmt (CIf exp (CCompound [] stmts _) Nothing _)) = do
         , compIntro = compIntro s
         , comp = Lambda () [hspvar k] $ If () (comp x) (comp s) (hsvar k)
         }
-grokStatement (CBlockDecl (CDecl (t:_) (v:vs) _)) = do
+grokStatement (CBlockDecl (CDecl (t:ts) (v:vs) _)) = do
     -- case mapMaybe (\(cdeclr,_,_) -> cdeclr >>= \(CDeclr i _ initial _ _) -> initial) (v:vs) of
     -- case mapMaybe (\(cdeclr,_,_) -> cdeclr >>= \(CInitList xs _) -> Just xs) (v:vs) of
-    case mapMaybe (\(_,inits,_) -> inits) (v:vs) of
+    case mapMaybe (\(i,inits,_) -> fmap ((,) i) inits) (v:vs) of
         [] ->
             return Computation
                 { compFree  = Map.empty
                 , compIntro = Map.empty
                 , comp      = Lambda () [hspvar "go"] $ hsvar "go"
                 }
-        initials -> Nothing -- TODO
+        initials -> do
+            gs <- mapM (grokInitialization $ t:ts) initials
+            return $ fmap (\exp -> Lambda () [hspvar "go"] exp)
+                        $ foldr applyComputation (Computation Map.empty Map.empty (hsvar "go")) gs
 grokStatement _ = Nothing
 
 isFunctionDecl (CDeclExt (CDecl _ [(Just (CDeclr _ [CFunDeclr _ _ _] _ _ _),_,_)] _)) = True