grok assignment expression.

1 files changed, 50 insertions, 26 deletions

diff --git a/monkeypatch.hs b/monkeypatch.hs
index 352a0f5..e47cb37 100644
--- a/monkeypatch.hs
+++ b/monkeypatch.hs
@@ -252,8 +252,8 @@ transpileBinOp = \case
     CAndOp -> ".&."
     CXorOp -> "xor"
     COrOp  -> ".|."
-    CLndOp -> "and"
-    CLorOp -> "or"
+    CLndOp -> "&&"
+    CLorOp -> "||"
 
 -- This function decides whether to treat an identifier as a constant or as a
 -- pointer that must be peeked.
@@ -417,6 +417,21 @@ grokExpression fe (CStatExpr (CCompound idents xs _) _) = do
         , compIntro = Map.empty
         , comp      = hsvar hv
         }
+grokExpression fe (CAssign CAssignOp cvar expr _) = do
+    v <- cvarName cvar
+    (ss,x) <- grokExpression fe expr
+    let k = uniqIdentifier "go" (Map.insert v () $ foldr (\s m -> compFree s `Map.union` compIntro s `Map.union` m) Map.empty ss)
+        s = x
+            { compIntro = Map.singleton v ()
+            , comp = Lambda () [hspvar k]
+                $ infixOp (App () (hsvar "return") (comp x)) ">>="
+                    $ Lambda () [hspvar v] (hsvar k)
+            }
+    return $ (,) (ss ++ [s]) Computation
+        { compFree = Map.empty
+        , compIntro = Map.empty
+        , comp = hsvar v
+        }
 grokExpression fe _ = Nothing
 
 
@@ -493,6 +508,30 @@ grokStatement fe (CBlockStmt (CReturn (Just exp) _)) = do
     let k = uniqIdentifier "go" (compFree x `Map.union` compIntro x)
         x' = fmap (\y -> App () (hsvar "return") $ promote (fnArgs fe) y) x
     return $ fmap (\y -> Lambda () [hspvar k] y) $ foldr applyComputation x' xs
+grokStatement fe (CBlockStmt (CIf exp thn els _)) = do
+    (xs,x) <- grokExpression fe exp
+    let mkif0 = If () (comp x)
+    (mkif,stmts) <- case (thn,els) of
+
+        (CCompound [] stmts _, Nothing                                               ) -> Just (mkif0, stmts)
+        (CCompound [] stmts _, Just (CExpr Nothing _)                                ) -> Just (mkif0, stmts)
+        (CCompound [] stmts _, Just (CCompound [] [ CBlockStmt (CExpr Nothing _) ] _)) -> Just (mkif0, stmts)
+
+        (CExpr Nothing _                              ,Just (CCompound [] stmts _)) -> Just (flip mkif0, stmts)
+        (CCompound [] [CBlockStmt (CExpr Nothing _)] _,Just (CCompound [] stmts _)) -> Just (flip mkif0, stmts)
+        (CExpr Nothing _                              ,Just e@(CExpr (Just _) _))   -> Just (flip mkif0, [CBlockStmt e])
+        (CCompound [] [CBlockStmt (CExpr Nothing _)] _,Just e@(CExpr (Just _) _))   -> Just (flip mkif0, [CBlockStmt e])
+
+        _ -> Nothing -- TODO
+
+    ss <- sequence $ map (grokStatement fe) stmts
+    let s = foldr applyComputation (Computation Map.empty Map.empty (hsvar k)) ss
+        k = uniqIdentifier "go" (Map.union (compFree x) (compFree s))
+    return $ flip (foldr applyComputation) xs Computation
+        { compFree = compFree x `Map.union` compFree s
+        , compIntro = compIntro s
+        , comp = Lambda () [hspvar k] $ mkif (comp s) (hsvar k)
+        }
 grokStatement fe (CBlockStmt (CExpr (Just (C.CCall (CVar (C.Ident "__assert_fail" _ _) _) xs _)) _)) = do
     x <- case xs of
             (CConst (CStrConst msg _):_) -> let s = getCString msg
@@ -544,30 +583,6 @@ grokStatement fe (CBlockStmt (CExpr (Just
             $ infixOp (hsvar fn) ">>="
                 $ Lambda () [hspvar v] (hsvar k)
         }
-grokStatement fe (CBlockStmt (CIf exp thn els _)) = do
-    (xs,x) <- grokExpression fe exp
-    let mkif0 = If () (comp x)
-    (mkif,stmts) <- case (thn,els) of
-
-        (CCompound [] stmts _, Nothing                                               ) -> Just (mkif0, stmts)
-        (CCompound [] stmts _, Just (CExpr Nothing _)                                ) -> Just (mkif0, stmts)
-        (CCompound [] stmts _, Just (CCompound [] [ CBlockStmt (CExpr Nothing _) ] _)) -> Just (mkif0, stmts)
-
-        (CExpr Nothing _                              ,Just (CCompound [] stmts _)) -> Just (flip mkif0, stmts)
-        (CCompound [] [CBlockStmt (CExpr Nothing _)] _,Just (CCompound [] stmts _)) -> Just (flip mkif0, stmts)
-        (CExpr Nothing _                              ,Just e@(CExpr (Just _) _))   -> Just (flip mkif0, [CBlockStmt e])
-        (CCompound [] [CBlockStmt (CExpr Nothing _)] _,Just e@(CExpr (Just _) _))   -> Just (flip mkif0, [CBlockStmt e])
-
-        _ -> Nothing -- TODO
-
-    ss <- sequence $ map (grokStatement fe) stmts
-    let s = foldr applyComputation (Computation Map.empty Map.empty (hsvar k)) ss
-        k = uniqIdentifier "go" (Map.union (compFree x) (compFree s))
-    return $ flip (foldr applyComputation) xs Computation
-        { compFree = compFree x `Map.union` compFree s
-        , compIntro = compIntro s
-        , comp = Lambda () [hspvar k] $ mkif (comp s) (hsvar k)
-        }
 grokStatement fe (CBlockStmt (CExpr (Just (CUnary CPostIncOp (CMember (CVar cv0 _) fld True _) _)) _)) = do
     let k1 = uniqIdentifier "go" (varmap [fieldlbl,v])
         fieldlbl = identToString fld
@@ -582,6 +597,15 @@ grokStatement fe (CBlockStmt (CExpr (Just (CUnary CPostIncOp (CMember (CVar cv0
                                             (hsvar v))
                                     (hsvar "succ")) ">>" (hsvar k1)
             }
+{-
+-- TODO: Are any above cases CBlockStmt (CExpr ...) neccessary?
+-- XXX In next case after this, mexpr is always Nothing
+grokStatement fe (CBlockStmt (CExpr (Just expr) _)) = do
+    (ss,x) <- grokExpression fe expr
+    let k = uniqIdentifier "go" $ foldr Map.union Map.empty $ map compFree ss ++ map compIntro ss
+        g = Computation Map.empty Map.empty (hsvar k)
+    return $ fmap (Lambda () [hspvar k]) $ foldr applyComputation g ss
+-}
 grokStatement fe (CBlockStmt (CExpr mexpr _)) = do
     (ss,pre) <- maybe (Just $ (,) [] $ Computation Map.empty Map.empty id)
                       (fmap (second (fmap (\e -> infixFn e "seq"))) . grokExpression fe) mexpr