git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #759
18d0159Phil Freeman
examples/passing/CaseInDo.pursnew file+11
@@ -0,0 +1,11 @@
1+module Main where
2+
3+import Debug.Trace
4+import Control.Monad.Eff
5+
6+main = do
7+ trace "Testing..."
8+ case 0 of
9+ 0 -> trace "Done"
10+ _ -> return unit
11+
src/Language/PureScript/Optimizer/MagicDo.hs+13−9
@@ -60,13 +60,11 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
60 -- Desugar pure
60 -- Desugar pure
61 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
61 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
62 -- Desugar >>
62 -- Desugar >>
63− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
63+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind =
64− let JSReturn ret = last js in
65− JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : init js ++ [JSReturn (JSApp ret [])] )
64+ JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : map applyReturns js )
66 -- Desugar >>=
65 -- Desugar >>=
67− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
66+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind =
68− let JSReturn ret = last js in
69− JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : init js ++ [JSReturn (JSApp ret [])] )
67+ JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : map applyReturns js)
70 -- Desugar untilE
68 -- Desugar untilE
71 convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
69 convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
72 JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn $ JSObjectLiteral []])) []
70 JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn $ JSObjectLiteral []])) []
@@ -106,9 +104,15 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
106 undo :: JS -> JS
104 undo :: JS -> JS
107 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
105 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
108 undo other = other
106 undo other = other
109−
107+
110− isJSReturn (JSReturn _) = True
108+ applyReturns :: JS -> JS
111− isJSReturn _ = False
109+ applyReturns (JSReturn ret) = JSReturn (JSApp ret [])
110+ applyReturns (JSBlock jss) = JSBlock (map applyReturns jss)
111+ applyReturns (JSWhile cond js) = JSWhile cond (applyReturns js)
112+ applyReturns (JSFor v lo hi js) = JSFor v lo hi (applyReturns js)
113+ applyReturns (JSForIn v xs js) = JSForIn v xs (applyReturns js)
114+ applyReturns (JSIfElse cond t f) = JSIfElse cond (applyReturns t) (applyReturns `fmap` f)
115+ applyReturns other = other
112
116
113-- |
117-- |
114-- Inline functions in the ST module
118-- Inline functions in the ST module