summaryrefslogtreecommitdiff
path: root/monkeypatch.hs
diff options
context:
space:
mode:
Diffstat (limited to 'monkeypatch.hs')
-rw-r--r--monkeypatch.hs19
1 files changed, 19 insertions, 0 deletions
diff --git a/monkeypatch.hs b/monkeypatch.hs
index 8646b5b..5d9bd1b 100644
--- a/monkeypatch.hs
+++ b/monkeypatch.hs
@@ -210,6 +210,11 @@ grokExpression (CConst (CIntConst n _)) = Just $ (,) [] $ Computation
210 , compIntro = Map.empty 210 , compIntro = Map.empty
211 , comp = Lit () (Int () (getCInteger n) (show n)) 211 , comp = Lit () (Int () (getCInteger n) (show n))
212 } 212 }
213grokExpression (CConst (CStrConst s _)) = Just $ (,) [] $ Computation
214 { compFree = Map.empty
215 , compIntro = Map.empty
216 , comp = Lit () (HS.String () (getCString s) (getCString s))
217 }
213grokExpression (CBinary CNeqOp a b _) = do 218grokExpression (CBinary CNeqOp a b _) = do
214 (as,ca) <- grokExpression a 219 (as,ca) <- grokExpression a
215 (bs,cb) <- grokExpression b 220 (bs,cb) <- grokExpression b
@@ -401,6 +406,20 @@ grokStatement (CBlockStmt (CExpr (Just
401 } 406 }
402 return $ fmap (\y -> Lambda () [hspvar k1] y) $ foldr applyComputation x' xs 407 return $ fmap (\y -> Lambda () [hspvar k1] y) $ foldr applyComputation x' xs
403grokStatement (CBlockStmt (CExpr (Just 408grokStatement (CBlockStmt (CExpr (Just
409 (C.CCall cvarfun exps _)) _)) = do
410 fn <- cvarName cvarfun
411 gs <- mapM grokExpression exps
412 let k = uniqIdentifier "go" frees
413 cll = foldl (App ()) (hsvar fn) $ map (comp . snd) gs
414 frees = foldr Map.union (Map.singleton fn ()) (map (compFree . snd) gs)
415 x = foldr applyComputation s $ concatMap fst gs
416 s = Computation
417 { compFree = frees
418 , compIntro = Map.empty
419 , comp = infixOp cll ">>" (hsvar k)
420 }
421 return $ fmap (Lambda () [hspvar k]) x
422grokStatement (CBlockStmt (CExpr (Just
404 (CAssign CAssignOp cvarnew 423 (CAssign CAssignOp cvarnew
405 (C.CCall cvarfun [] _) _)) _)) = do 424 (C.CCall cvarfun [] _) _)) _)) = do
406 v <- cvarName cvarnew 425 v <- cvarName cvarnew