From 86d43ec094cec3a88491258d17434b7e9ee7c1c9 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 23 Mar 2019 18:17:22 -0400 Subject: grok assignment expression. --- monkeypatch.hs | 76 ++++++++++++++++++++++++++++++++++++++-------------------- 1 file 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 -- cgit v1.2.3