@@ -54,17 +54,30 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
54 -- Desugar monomorphic calls to >>= and return for the Eff monad
54 -- Desugar monomorphic calls to >>= and return for the Eff monad
55 convert :: Cpp -> Cpp
55 convert :: Cpp -> Cpp
56 -- Desugar pure & return
56 -- Desugar pure & return
57+ convert (CppApp (CppApp pure' [dict, val]) []) | isPure (CppApp pure' [dict]) = val
57 convert (CppApp (CppApp pure' [val]) []) | isPure pure' = val
58 convert (CppApp (CppApp pure' [val]) []) | isPure pure' = val
58 -- Desugar >>
59 -- 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 )
59 convert (CppApp (CppApp bind [m]) [CppLambda _ [] rty (CppBlock cpp)]) | isBind bind =
62 convert (CppApp (CppApp bind [m]) [CppLambda _ [] rty (CppBlock cpp)]) | isBind bind =
60 CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )
63 CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )
61 -- Desugar >>=
64 -- 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)
68+ app' | fst arg == C.__unused = CppApp m []
69+ | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
62 convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =
70 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)
73+ app' | fst arg == C.__unused = CppApp m []
74+ | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
64 -- Desugar untilE
75 -- Desugar untilE
65 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
76 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
66 CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppObjectLiteral []])) []
77 CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppObjectLiteral []])) []
67 -- Desugar whileE
78 -- 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 []])) []
68 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
81 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
69 CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral []])) []
82 CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral []])) []
70 convert other = other
83 convert other = other
@@ -85,6 +98,7 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
85 -- Remove __do function applications which remain after desugaring
98 -- Remove __do function applications which remain after desugaring
86 undo :: Cpp -> Cpp
99 undo :: Cpp -> Cpp
87 undo (CppReturn (CppApp (CppFunction ident [] _ _ body) [])) | ident == fnName = body
100 undo (CppReturn (CppApp (CppFunction ident [] _ _ body) [])) | ident == fnName = body
101+ undo (CppFunction ident [] rty _ body) | ident == fnName = CppLambda [CppCaptureAll] [] rty body
88 undo other = other
102 undo other = other
90 applyReturns :: Cpp -> Cpp
104 applyReturns :: Cpp -> Cpp