git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #762 from purescript/759

Fix #759

commitdddc19874a4d50910da4e7e8a379e270467f6cf2 authorPhil Freeman <paf31@cantab.net> dateThu 11 Dec 2014, 13:12 (12 years ago) parentfa76e82a9dc282
2 files changed+33−9
compare with golang
unifiedsplit
examples/passing/CaseInDo.purs+20 src/Language/PureScript/Optimizer/MagicDo.hs+13−9
examples/passing/CaseInDo.pursnew file+20
@@ -0,0 +1,20 @@
1+module Main where
2+
3+import Debug.Trace
4+import Control.Monad.Eff
5+
6+foreign import doIt "function doIt() { global.flag = true; }" :: forall eff. Eff eff Unit
7+
8+foreign import get "function get() { return global.flag; }" :: forall eff. Eff eff Boolean
9+
10+set = do
11+ trace "Testing..."
12+ case 0 of
13+ 0 -> doIt
14+ _ -> return unit
15+
16+main = do
17+ set
18+ b <- get
19+ case b of
20+ true -> trace "Done"
src/Language/PureScript/Optimizer/MagicDo.hs+13−9
@@ -60,13 +60,11 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
6060 -- Desugar pure
6161 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
6262 -- Desugar >>
63− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
64− let JSReturn ret = last js in
65− JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : init js ++ [JSReturn (JSApp ret [])] )
63+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind =
64+ JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : map applyReturns js )
6665 -- Desugar >>=
67− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
68− let JSReturn ret = last js in
69− JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : init js ++ [JSReturn (JSApp ret [])] )
66+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind =
67+ JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : map applyReturns js)
7068 -- Desugar untilE
7169 convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
7270 JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn $ JSObjectLiteral []])) []
@@ -106,9 +104,15 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
106104 undo :: JS -> JS
107105 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
108106 undo other = other
109−
110− isJSReturn (JSReturn _) = True
111− isJSReturn _ = False
107+
108+ applyReturns :: JS -> JS
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
112116
113117-- |
114118-- Inline functions in the ST module