diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-19 22:05:53 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-19 22:05:53 -0400 |
commit | d8e76e9e84c64cb67d8b01a8d52242333a70a693 (patch) | |
tree | b248808a73b21c6f12d5165424296b1a209de20b /monkeypatch.hs | |
parent | ebd5bc1d3b27331e55282e76a187f59caa6b232f (diff) |
Grok more if-then cases.
Diffstat (limited to 'monkeypatch.hs')
-rw-r--r-- | monkeypatch.hs | 18 |
1 files changed, 16 insertions, 2 deletions
diff --git a/monkeypatch.hs b/monkeypatch.hs index 98ebe38..897323d 100644 --- a/monkeypatch.hs +++ b/monkeypatch.hs | |||
@@ -380,15 +380,29 @@ grokStatement (CBlockStmt (CExpr (Just | |||
380 | $ infixOp (hsvar fn) ">>=" | 380 | $ infixOp (hsvar fn) ">>=" |
381 | $ Lambda () [hspvar v] (hsvar k) | 381 | $ Lambda () [hspvar v] (hsvar k) |
382 | } | 382 | } |
383 | grokStatement (CBlockStmt (CIf exp (CCompound [] stmts _) Nothing _)) = do | 383 | grokStatement (CBlockStmt (CIf exp thn els _)) = do |
384 | (xs,x) <- grokExpression exp | 384 | (xs,x) <- grokExpression exp |
385 | let mkif0 = If () (comp x) | ||
386 | (mkif,stmts) <- case (thn,els) of | ||
387 | |||
388 | (CCompound [] stmts _, Nothing ) -> Just (mkif0, stmts) | ||
389 | (CCompound [] stmts _, Just (CExpr Nothing _) ) -> Just (mkif0, stmts) | ||
390 | (CCompound [] stmts _, Just (CCompound [] [ CBlockStmt (CExpr Nothing _) ] _)) -> Just (mkif0, stmts) | ||
391 | |||
392 | (CExpr Nothing _ ,Just (CCompound [] stmts _)) -> Just (flip mkif0, stmts) | ||
393 | (CCompound [] [CBlockStmt (CExpr Nothing _)] _,Just (CCompound [] stmts _)) -> Just (flip mkif0, stmts) | ||
394 | (CExpr Nothing _ ,Just e@(CExpr (Just _) _)) -> Just (flip mkif0, [CBlockStmt e]) | ||
395 | (CCompound [] [CBlockStmt (CExpr Nothing _)] _,Just e@(CExpr (Just _) _)) -> Just (flip mkif0, [CBlockStmt e]) | ||
396 | |||
397 | _ -> Nothing -- TODO | ||
398 | |||
385 | ss <- sequence $ map grokStatement stmts | 399 | ss <- sequence $ map grokStatement stmts |
386 | let s = foldr applyComputation (Computation Map.empty Map.empty (hsvar k)) ss | 400 | let s = foldr applyComputation (Computation Map.empty Map.empty (hsvar k)) ss |
387 | k = uniqIdentifier "go" (Map.union (compFree x) (compFree s)) | 401 | k = uniqIdentifier "go" (Map.union (compFree x) (compFree s)) |
388 | return $ flip (foldr applyComputation) xs Computation | 402 | return $ flip (foldr applyComputation) xs Computation |
389 | { compFree = compFree x `Map.union` compFree s | 403 | { compFree = compFree x `Map.union` compFree s |
390 | , compIntro = compIntro s | 404 | , compIntro = compIntro s |
391 | , comp = Lambda () [hspvar k] $ If () (comp x) (comp s) (hsvar k) | 405 | , comp = Lambda () [hspvar k] $ mkif (comp s) (hsvar k) |
392 | } | 406 | } |
393 | grokStatement (CBlockStmt (CExpr (Just (CUnary CPostIncOp (CMember (CVar cv0 _) fld True _) _)) _)) = do | 407 | grokStatement (CBlockStmt (CExpr (Just (CUnary CPostIncOp (CMember (CVar cv0 _) fld True _) _)) _)) = do |
394 | let k1 = uniqIdentifier "go" (varmap [fieldlbl,v]) | 408 | let k1 = uniqIdentifier "go" (varmap [fieldlbl,v]) |