e01b631 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Fix --magic-do and inlined operators from the Prelude, fix breaking test

e01b631Phil Freeman13 years ago

prelude/tests/Eff.purs+2−2

compare with golang

unifiedsplit

@@ -27,9 +27,9 @@ test4 = do

27 trace "Hello World!"

28 return 0

30−test5 = do

30+test5 _ = do

31 trace "Hello World!"

32− test5

32+ test5 {}

34test6 s = do

35 trace s

src/Language/PureScript/CodeGen/Optimize.hs+22−12

@@ -261,6 +261,7 @@ magicDo' :: JS -> JS

261magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

262 where

263 fnName = "__do"

264+

264 convert :: JS -> JS

265 convert :: JS -> JS

265 convert (JSApp (JSApp ret [val]) []) | isReturn ret = val

266 convert (JSApp (JSApp ret [val]) []) | isReturn ret = val

266 convert (JSApp (JSApp bind [m]) [JSFunction Nothing ["_"] (JSBlock [JSReturn ret])]) | isBind bind =

267 convert (JSApp (JSApp bind [m]) [JSFunction Nothing ["_"] (JSBlock [JSReturn ret])]) | isBind bind =

@@ -268,24 +269,33 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

268 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =

269 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =

269 JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]

270 JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]

270 convert other = other

271 convert other = other

272+

271 isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict effDict = True

273 isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict effDict = True

272 isBind _ = False

274 isBind _ = False

275+

273 isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict effDict = True

276 isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict effDict = True

274 isReturn _ = False

277 isReturn _ = False

278+

275− isBindPoly (JSAccessor prop (JSVar "Prelude")) | prop == identToJs (Op ">>=") = True

279+ isBindPoly (JSAccessor prop (JSAccessor "Prelude" (JSVar "_ps"))) | prop == identToJs (Op ">>=") = True

276− isBindPoly (JSIndexer (JSStringLiteral ">>=") (JSVar "Prelude")) = True

280+ isBindPoly (JSIndexer (JSStringLiteral ">>=") (JSAccessor "Prelude" (JSVar "_ps"))) = True

277 isBindPoly _ = False

281 isBindPoly _ = False

282+

278− isRetPoly (JSAccessor "$return" (JSVar "Prelude")) = True

283+ isRetPoly (JSAccessor "$return" (JSAccessor "Prelude" (JSVar "_ps"))) = True

284+ isRetPoly (JSIndexer (JSStringLiteral "return") (JSAccessor "Prelude" (JSVar "_ps"))) = True

279 isRetPoly _ = False

285 isRetPoly _ = False

286+

280 prelude = ModuleName (ProperName "Prelude")

287 prelude = ModuleName (ProperName "Prelude")

281 effModule = ModuleName (ProperName "Eff")

288 effModule = ModuleName (ProperName "Eff")

289+

282 Right (Ident effDictName) = mkDictionaryValueName

290 Right (Ident effDictName) = mkDictionaryValueName

283 effModule

291 effModule

284 (Qualified (Just prelude) (ProperName "Monad"))

292 (Qualified (Just prelude) (ProperName "Monad"))

285 (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))

293 (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))

294+

286− isEffDict (JSVar ident) | ident == effDictName = True

295+ isEffDict (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == effDictName = True

287− isEffDict (JSAccessor prop (JSVar "Eff")) | prop == effDictName = True

296+ isEffDict (JSApp (JSAccessor prop (JSAccessor "Eff" (JSVar "_ps"))) [JSObjectLiteral []]) | prop == effDictName = True

288 isEffDict _ = False

297 isEffDict _ = False

298+

289 undo :: JS -> JS

299 undo :: JS -> JS

290 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body

300 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body

291 undo other = other

301 undo other = other

@@ -306,8 +316,8 @@ inlineOperator op f = everywhere (mkT convert)

306 convert :: JS -> JS

316 convert :: JS -> JS

307 convert (JSApp (JSApp op [x]) [y]) | isOp op = f x y

317 convert (JSApp (JSApp op [x]) [y]) | isOp op = f x y

308 convert other = other

318 convert other = other

309− isOp (JSAccessor longForm (JSVar "Prelude")) | longForm == identToJs (Op op) = True

319+ isOp (JSAccessor longForm (JSAccessor "Prelude" (JSVar "_ps"))) | longForm == identToJs (Op op) = True

310− isOp (JSIndexer (JSStringLiteral op') (JSVar "Prelude")) | op == op' = True

320+ isOp (JSIndexer (JSStringLiteral op') (JSAccessor "Prelude" (JSVar "_ps"))) | op == op' = True

311 isOp _ = False

321 isOp _ = False

312

322

313inlineCommonOperators :: JS -> JS

323inlineCommonOperators :: JS -> JS

@@ -350,8 +360,8 @@ inlineCommonOperators = applyAll

350 convert :: JS -> JS

360 convert :: JS -> JS

351 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict className classTy dict = JSBinary op x y

361 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict className classTy dict = JSBinary op x y

352 convert other = other

362 convert other = other

353− isOp (JSAccessor longForm (JSVar "Prelude")) | longForm == identToJs (Op opString) = True

363+ isOp (JSAccessor longForm (JSAccessor "Prelude" (JSVar ps))) | longForm == identToJs (Op opString) = True

354− isOp (JSIndexer (JSStringLiteral op') (JSVar "Prelude")) | opString == op' = True

364+ isOp (JSIndexer (JSStringLiteral op') (JSAccessor "Prelude" (JSVar "_ps"))) | opString == op' = True

355 isOp _ = False

365 isOp _ = False

356 binaryFunction :: String -> String -> Type -> BinaryOperator -> JS -> JS

366 binaryFunction :: String -> String -> Type -> BinaryOperator -> JS -> JS

357 binaryFunction fnName className classTy op = everywhere (mkT convert)

367 binaryFunction fnName className classTy op = everywhere (mkT convert)

@@ -359,7 +369,7 @@ inlineCommonOperators = applyAll

359 convert :: JS -> JS

369 convert :: JS -> JS

360 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict className classTy dict = JSBinary op x y

370 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict className classTy dict = JSBinary op x y

361 convert other = other

371 convert other = other

362− isOp (JSAccessor fnName' (JSVar "Prelude")) | fnName == fnName' = True

372+ isOp (JSAccessor fnName' (JSAccessor "Prelude" (JSVar "_ps"))) | fnName == fnName' = True

363 isOp _ = False

373 isOp _ = False

364 unary :: String -> String -> Type -> UnaryOperator -> JS -> JS

374 unary :: String -> String -> Type -> UnaryOperator -> JS -> JS

365 unary fnName className classTy op = everywhere (mkT convert)

375 unary fnName className classTy op = everywhere (mkT convert)

@@ -367,9 +377,9 @@ inlineCommonOperators = applyAll

367 convert :: JS -> JS

377 convert :: JS -> JS

368 convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict className classTy dict = JSUnary op x

378 convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict className classTy dict = JSUnary op x

369 convert other = other

379 convert other = other

370− isOp (JSAccessor fnName' (JSVar "Prelude")) | fnName' == fnName = True

380+ isOp (JSAccessor fnName' (JSAccessor "Prelude" (JSVar "_ps"))) | fnName' == fnName = True

371 isOp _ = False

381 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

373 where

383 where

374 Right (Ident dictName) = mkDictionaryValueName

384 Right (Ident dictName) = mkDictionaryValueName

375 (ModuleName (ProperName "Prelude"))

385 (ModuleName (ProperName "Prelude"))