@@ -54,17 +54,30 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
5454 -- Desugar monomorphic calls to >>= and return for the Eff monad
5555 convert :: Cpp -> Cpp
5656 -- Desugar pure & return
57+ convert (CppApp (CppApp pure' [dict, val]) []) | isPure (CppApp pure' [dict]) = val
5758 convert (CppApp (CppApp pure' [val]) []) | isPure pure' = val
5859 -- Desugar >>
60+ convert (CppApp bind [dict, m, CppLambda _ [] rty (CppBlock cpp)]) | isBind (CppApp bind [dict]) =
61+ CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )
5962 convert (CppApp (CppApp bind [m]) [CppLambda _ [] rty (CppBlock cpp)]) | isBind bind =
6063 CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )
6164 -- Desugar >>=
65+ convert (CppApp bind [dict, m, CppLambda _ [arg] rty (CppBlock cpp)]) | isBind (CppApp bind [dict]) =
66+ CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)
67+ where
68+ app' | fst arg == C.__unused = CppApp m []
69+ | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
6270 convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =
63− CppFunction fnName [] rty [] $ CppBlock (CppVariableIntroduction arg [] (Just (CppApp m [])) : map applyReturns cpp)
71+ CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)
72+ where
73+ app' | fst arg == C.__unused = CppApp m []
74+ | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
6475 -- Desugar untilE
6576 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
6677 CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppObjectLiteral []])) []
6778 -- Desugar whileE
79+ convert (CppApp (CppApp f [arg1, arg2]) []) | isEffFunc C.whileE f =
80+ CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral []])) []
6881 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
6982 CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral []])) []
7083 convert other = other
@@ -85,6 +98,7 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
8598 -- Remove __do function applications which remain after desugaring
8699 undo :: Cpp -> Cpp
87100 undo (CppReturn (CppApp (CppFunction ident [] _ _ body) [])) | ident == fnName = body
101+ undo (CppFunction ident [] rty _ body) | ident == fnName = CppLambda [CppCaptureAll] [] rty body
88102 undo other = other
89103
90104 applyReturns :: Cpp -> Cpp