38aa921 · rowtype-yoga/purescript-backend-optimizer

git.iko.soy/rowtype-yoga/purescript-backend-optimizer

Fix effect loop codegen in branches (#97)

* Fix effect loop codegen in branches. Fixes #96. * Fix issue with dropped statements. * Commit snapshot

commit38aa921107186efef58fb5e74bb3b5cff96f86bb authorNathan Faubion <natefaubion@users.noreply.github.com> dateMon 11 Sep 2023, 14:35 (3 years ago) parent9de6bd8

4 files changed+83−41

compare with main

unifiedsplit

backend-es/src/PureScript/Backend/Optimizer/Codegen/EcmaScript/Syntax.purs+49−36 backend-es/test/snapshots-out/Snapshot.EffectLoopCaseRegression.js+14 backend-es/test/snapshots-out/Snapshot.STArray05.js+3−5 backend-es/test/snapshots/Snapshot.EffectLoopCaseRegression.purs+17

backend-es/src/PureScript/Backend/Optimizer/Codegen/EcmaScript/Syntax.purs+49−36

@@ -44,7 +44,6 @@ import Data.Newtype (class Newtype)

4444import Data.Set (Set)

4545import Data.Set as Set

4646import Data.String as String

47−import Data.Traversable (traverse)

4847import Data.Tuple (Tuple(..), fst, snd)

4948import Dodo as Dodo

5049import Dodo.Common as Dodo.Common

@@ -277,42 +276,39 @@ build syn = case syn of

277276 EsCall (EsExpr _ (EsArrowFunction [] bs)) []

278277 | Just expr <- inlineCallBlock bs ->

279278 expr

280− EsReturn (Just b)

281− | Just expr' <- inlineLoopBlockStatement b ->

282− expr'

283279 EsReturn (Just (EsExpr _ EsUndefined)) ->

284280 build $ EsReturn Nothing

285− EsArrowFunction as bs

286− | Just (EsExpr _ (EsReturn Nothing)) <- Array.last bs ->

287− esArrowFunction as $ Array.dropEnd 1 bs

288281 EsArrowFunction as [ block ]

289282 | Just bs <- inlineReturnBlock block ->

290283 esArrowFunction as bs

291284 EsArrowFunction as bs -> do

292− let Tuple s bs' = buildStatements bs

293− EsExpr (alwaysPure (bumpSize s)) $ EsArrowFunction as bs'

294− EsIfElse a [ block ] cs

295− | Just bs <- inlineReturnBlock block ->

296− build $ EsIfElse a bs cs

285+ let bs' = buildStatements bs

286+ case removeTrailingReturn bs' of

287+ Just bs'' ->

288+ build $ EsArrowFunction as bs''

289+ Nothing ->

290+ EsExpr (alwaysPure (bumpSize (foldMap esAnalysisOf bs'))) $ EsArrowFunction as bs'

297291 EsIfElse a bs [ block ]

298292 | Just cs <- inlineReturnBlock block ->

299293 build $ EsIfElse a bs cs

300294 EsIfElse a bs cs -> do

301− let Tuple s1 bs' = buildStatements bs

302− let Tuple s2 cs' = buildStatements cs

303− EsExpr (bumpSize (esAnalysisOf a <> s1 <> s2)) $ EsIfElse a bs' cs'

304− EsWhile a bs

305− | Just bs' <- removeTrailingContinue bs ->

306− build $ EsWhile a bs'

307− | otherwise -> do

308− let Tuple s bs' = buildStatements bs

309− EsExpr (bumpSize (esAnalysisOf a <> s)) $ EsWhile a bs'

310− EsForOf a b cs

311− | Just cs' <- removeTrailingContinue cs ->

312− build $ EsForOf a b cs'

313− | otherwise -> do

314− let Tuple s cs' = buildStatements cs

315− EsExpr (bumpSize (esAnalysisOf b <> s)) $ EsForOf a b cs'

295+ let bs' = buildStatements bs

296+ let cs' = buildStatements cs

297+ EsExpr (bumpSize (esAnalysisOf a <> foldMap esAnalysisOf bs' <> foldMap esAnalysisOf cs')) $ EsIfElse a bs' cs'

298+ EsWhile a bs -> do

299+ let bs' = buildStatements bs

300+ case removeTrailingContinue bs' of

301+ Just bs'' ->

302+ build $ EsWhile a bs''

303+ Nothing ->

304+ EsExpr (bumpSize (esAnalysisOf a <> foldMap esAnalysisOf bs')) $ EsWhile a bs'

305+ EsForOf a b cs -> do

306+ let cs' = buildStatements cs

307+ case removeTrailingContinue cs' of

308+ Just cs'' ->

309+ build $ EsForOf a b cs''

310+ Nothing ->

311+ EsExpr (bumpSize (esAnalysisOf b <> foldMap esAnalysisOf cs')) $ EsForOf a b cs'

316312 EsUnary EsNot (EsExpr _ (EsBinary EsEquals a b)) ->

317313 build $ EsBinary EsNotEquals a b

318314 _ ->

@@ -327,14 +323,18 @@ build syn = case syn of

327323 EsArrowFunction _ _ -> alwaysPure

328324 _ -> identity

329325

330−buildStatements :: Array EsExpr -> Tuple EsAnalysis (Array EsExpr)

331−buildStatements = traverse go <<< mergeBranchTails

326+buildStatements :: Array EsExpr -> Array EsExpr

327+buildStatements = (go =<< _) <<< mergeBranchTails

332328 where

333− go expr = case expr of

334− _ | Just expr' <- inlineLoopBlockStatement expr ->

335− go expr'

336− _ ->

337− Tuple (esAnalysisOf expr) expr

329+ go = case _ of

330+ EsExpr _ (EsReturn (Just expr'))

331+ | Just expr'' <- inlineLoopBlockStatement expr' ->

332+ Array.snoc (go expr'') $ build $ EsReturn Nothing

333+ expr

334+ | Just expr' <- inlineLoopBlockStatement expr ->

335+ go expr'

336+ expr ->

337+ [ expr ]

338338

339339 -- For nested if/else blocks, merges a duplicate tail of alternatives

340340 -- via fallthrough. If an inner branch has a tail that matches the

@@ -391,11 +391,24 @@ inlineLoopBlockStatement (EsExpr _ expr) = case expr of

391391 _ ->

392392 Nothing

393393

394+removeTrailingReturn :: Array EsExpr -> Maybe (Array EsExpr)

395+removeTrailingReturn stmts = case Array.last stmts of

396+ Just (EsExpr _ (EsIfElse a bs []))

397+ | Just cs <- removeTrailingReturn bs ->

398+ Just $ Array.snoc (Array.dropEnd 1 stmts) $ build $ EsIfElse a cs []

399+ Just (EsExpr _ (EsReturn Nothing)) ->

400+ Just (Array.dropEnd 1 stmts)

401+ Just expr

402+ | Just stmts' <- inlineReturnBlock expr ->

403+ Just (Array.dropEnd 1 stmts <> stmts')

404+ _ ->

405+ Nothing

406+

394407removeTrailingContinue :: Array EsExpr -> Maybe (Array EsExpr)

395408removeTrailingContinue stmts = case Array.last stmts of

396− Just (EsExpr s (EsIfElse a bs []))

409+ Just (EsExpr _ (EsIfElse a bs []))

397410 | Just cs <- removeTrailingContinue bs ->

398− Just $ Array.snoc (Array.dropEnd 1 stmts) $ EsExpr s $ EsIfElse a cs []

411+ Just $ Array.snoc (Array.dropEnd 1 stmts) $ build $ EsIfElse a cs []

399412 Just (EsExpr _ EsContinue) ->

400413 Just (Array.dropEnd 1 stmts)

401414 _ ->

backend-es/test/snapshots-out/Snapshot.EffectLoopCaseRegression.jsnew file+14

@@ -0,0 +1,14 @@

1+import * as $runtime from "../runtime.js";

2+import * as Effect$dConsole from "../Effect.Console/index.js";

3+const test = eff => () => {

4+ const res = eff();

5+ if (res.tag === "Nothing") { return; }

6+ if (res.tag === "Just") {

7+ for (const a of res._1) {

8+ Effect$dConsole.log(a)();

9+ }

10+ return;

11+ }

12+ $runtime.fail();

13+};

14+export {test};

backend-es/test/snapshots-out/Snapshot.STArray05.js+3−5

@@ -1,9 +1,7 @@

11const test = x => {

22 const $0 = x ? (a => () => a.push(1)) : a => () => a.unshift(2);

3− return (() => {

4− const arr = [];

5− $0(arr)();

6− return arr;

7− })();

3+ const arr = [];

4+ $0(arr)();

5+ return arr;

86};

97export {test};

backend-es/test/snapshots/Snapshot.EffectLoopCaseRegression.pursnew file+17

@@ -0,0 +1,17 @@

1+module Snapshot.EffectLoopCaseRegression where

3+import Prelude

5+import Data.Maybe (Maybe(..))

6+import Effect (Effect, foreachE)

7+import Effect.Console as Console

9+test :: Effect (Maybe (Array String)) -> Effect Unit

10+test eff = do

11+ res <- eff

12+ case res of

13+ Nothing ->

14+ pure unit

15+ Just as ->

16+ foreachE as \a ->

17+ Console.log a