git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix --magic-do and inlined operators from the Prelude, fix breaking test
commite01b631090e7ad42cb79f0d9763db3b02fcc57e7 authorPhil Freeman <paf31@cantab.net> dateTue 11 Feb 2014, 16:46 (13 years ago) parent3c22697
2 files changed+24−14
prelude/tests/Eff.purs+2−2 src/Language/PureScript/CodeGen/Optimize.hs+22−12
prelude/tests/Eff.purs+2−2
@@ -27,9 +27,9 @@ test4 = do
2727 trace "Hello World!"
2828 return 0
2929
30−test5 = do
30+test5 _ = do
3131 trace "Hello World!"
32− test5
32+ test5 {}
3333
3434test6 s = do
3535 trace s
src/Language/PureScript/CodeGen/Optimize.hs+22−12
@@ -261,6 +261,7 @@ magicDo' :: JS -> JS
261261magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)
262262 where
263263 fnName = "__do"
264+
264265 convert :: JS -> JS
265266 convert (JSApp (JSApp ret [val]) []) | isReturn ret = val
266267 convert (JSApp (JSApp bind [m]) [JSFunction Nothing ["_"] (JSBlock [JSReturn ret])]) | isBind bind =
@@ -268,24 +269,33 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)
268269 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =
269270 JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]
270271 convert other = other
272+
271273 isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict effDict = True
272274 isBind _ = False
275+
273276 isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict effDict = True
274277 isReturn _ = False
275− isBindPoly (JSAccessor prop (JSVar "Prelude")) | prop == identToJs (Op ">>=") = True
276− isBindPoly (JSIndexer (JSStringLiteral ">>=") (JSVar "Prelude")) = True
278+
279+ isBindPoly (JSAccessor prop (JSAccessor "Prelude" (JSVar "_ps"))) | prop == identToJs (Op ">>=") = True
280+ isBindPoly (JSIndexer (JSStringLiteral ">>=") (JSAccessor "Prelude" (JSVar "_ps"))) = True
277281 isBindPoly _ = False
278− isRetPoly (JSAccessor "$return" (JSVar "Prelude")) = True
282+
283+ isRetPoly (JSAccessor "$return" (JSAccessor "Prelude" (JSVar "_ps"))) = True
284+ isRetPoly (JSIndexer (JSStringLiteral "return") (JSAccessor "Prelude" (JSVar "_ps"))) = True
279285 isRetPoly _ = False
286+
280287 prelude = ModuleName (ProperName "Prelude")
281288 effModule = ModuleName (ProperName "Eff")
289+
282290 Right (Ident effDictName) = mkDictionaryValueName
283291 effModule
284292 (Qualified (Just prelude) (ProperName "Monad"))
285293 (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))
286− isEffDict (JSVar ident) | ident == effDictName = True
287− isEffDict (JSAccessor prop (JSVar "Eff")) | prop == effDictName = True
294+
295+ isEffDict (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == effDictName = True
296+ isEffDict (JSApp (JSAccessor prop (JSAccessor "Eff" (JSVar "_ps"))) [JSObjectLiteral []]) | prop == effDictName = True
288297 isEffDict _ = False
298+
289299 undo :: JS -> JS
290300 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
291301 undo other = other
@@ -306,8 +316,8 @@ inlineOperator op f = everywhere (mkT convert)
306316 convert :: JS -> JS
307317 convert (JSApp (JSApp op [x]) [y]) | isOp op = f x y
308318 convert other = other
309− isOp (JSAccessor longForm (JSVar "Prelude")) | longForm == identToJs (Op op) = True
310− isOp (JSIndexer (JSStringLiteral op') (JSVar "Prelude")) | op == op' = True
319+ isOp (JSAccessor longForm (JSAccessor "Prelude" (JSVar "_ps"))) | longForm == identToJs (Op op) = True
320+ isOp (JSIndexer (JSStringLiteral op') (JSAccessor "Prelude" (JSVar "_ps"))) | op == op' = True
311321 isOp _ = False
312322
313323inlineCommonOperators :: JS -> JS
@@ -350,8 +360,8 @@ inlineCommonOperators = applyAll
350360 convert :: JS -> JS
351361 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict className classTy dict = JSBinary op x y
352362 convert other = other
353− isOp (JSAccessor longForm (JSVar "Prelude")) | longForm == identToJs (Op opString) = True
354− isOp (JSIndexer (JSStringLiteral op') (JSVar "Prelude")) | opString == op' = True
363+ isOp (JSAccessor longForm (JSAccessor "Prelude" (JSVar ps))) | longForm == identToJs (Op opString) = True
364+ isOp (JSIndexer (JSStringLiteral op') (JSAccessor "Prelude" (JSVar "_ps"))) | opString == op' = True
355365 isOp _ = False
356366 binaryFunction :: String -> String -> Type -> BinaryOperator -> JS -> JS
357367 binaryFunction fnName className classTy op = everywhere (mkT convert)
@@ -359,7 +369,7 @@ inlineCommonOperators = applyAll
359369 convert :: JS -> JS
360370 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict className classTy dict = JSBinary op x y
361371 convert other = other
362− isOp (JSAccessor fnName' (JSVar "Prelude")) | fnName == fnName' = True
372+ isOp (JSAccessor fnName' (JSAccessor "Prelude" (JSVar "_ps"))) | fnName == fnName' = True
363373 isOp _ = False
364374 unary :: String -> String -> Type -> UnaryOperator -> JS -> JS
365375 unary fnName className classTy op = everywhere (mkT convert)
@@ -367,9 +377,9 @@ inlineCommonOperators = applyAll
367377 convert :: JS -> JS
368378 convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict className classTy dict = JSUnary op x
369379 convert other = other
370− isOp (JSAccessor fnName' (JSVar "Prelude")) | fnName' == fnName = True
380+ isOp (JSAccessor fnName' (JSAccessor "Prelude" (JSVar "_ps"))) | fnName' == fnName = True
371381 isOp _ = False
372− isOpDict className ty (JSAccessor prop (JSVar "Prelude")) | prop == dictName = True
382+ isOpDict className ty (JSApp (JSAccessor prop (JSAccessor "Prelude" (JSVar "_ps"))) [JSObjectLiteral []]) | prop == dictName = True
373383 where
374384 Right (Ident dictName) = mkDictionaryValueName
375385 (ModuleName (ProperName "Prelude"))