diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-19 22:54:05 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-19 22:54:05 -0400 |
commit | dd3cdaec612dd8cf598ffd73d2c437d4f2f58744 (patch) | |
tree | 588e7ec9c3e4b1ea648f0f5ecb71c77c3d0e24f6 /monkeypatch.hs | |
parent | d8e76e9e84c64cb67d8b01a8d52242333a70a693 (diff) |
Fix statement-expression handling.
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 897323d..d5889f9 100644 --- a/monkeypatch.hs +++ b/monkeypatch.hs | |||
@@ -291,8 +291,22 @@ grokExpression (CStatExpr (CCompound idents xs _) _) = do | |||
291 | [CBlockStmt (CExpr mexp ni)] -> Just $ CBlockStmt (CReturn mexp ni) | 291 | [CBlockStmt (CExpr mexp ni)] -> Just $ CBlockStmt (CReturn mexp ni) |
292 | _ -> Just (head y) -- Nothing FIXME | 292 | _ -> Just (head y) -- Nothing FIXME |
293 | gs <- mapM grokStatement (reverse $ y' : ys) | 293 | gs <- mapM grokStatement (reverse $ y' : ys) |
294 | let s = foldr applyComputation (Computation Map.empty Map.empty hsopUnit) gs | 294 | let s0 = foldr applyComputation (Computation Map.empty Map.empty (App () (hsvar "return") hsopUnit)) gs |
295 | return $ (,) [] $ fmap (\xp -> Paren () xp) s | 295 | s1 = fmap (\xp -> Paren () xp) s0 |
296 | hv = uniqIdentifier "ret" (compFree s1) | ||
297 | k = uniqIdentifier "go" (compFree s1) | ||
298 | s = Computation | ||
299 | { compFree = compFree s1 | ||
300 | , compIntro = Map.singleton hv () | ||
301 | , comp = Lambda () [hspvar k] | ||
302 | $ infixOp (comp s1) ">>=" | ||
303 | $ Lambda () [hspvar hv] (hsvar k) | ||
304 | } | ||
305 | return $ (,) [s] Computation | ||
306 | { compFree = Map.singleton hv () | ||
307 | , compIntro = Map.empty | ||
308 | , comp = hsvar hv | ||
309 | } | ||
296 | grokExpression _ = Nothing | 310 | grokExpression _ = Nothing |
297 | 311 | ||
298 | 312 | ||