8ecac1d · rowtype-yoga/purescript-backend-optimizer

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

Remove rewrite-based let floating (#85)

Moving completely to eval.

commit8ecac1d461441702e281de5adfe98ed324ae8e4f authorNathan Faubion <natefaubion@users.noreply.github.com> dateTue 8 Aug 2023, 09:25 (3 years ago) parent4f71267

5 files changed+76−143

compare with main

unifiedsplit

backend-es/src/PureScript/Backend/Optimizer/Codegen/EcmaScript/Foreign.purs+3−3 backend-es/test/snapshots-out/Snapshot.VanLaarhovenTraversals01.js+8−8 src/PureScript/Backend/Optimizer/Semantics.purs+60−123 src/PureScript/Backend/Optimizer/Semantics/Foreign.purs+5−5 src/PureScript/Backend/Optimizer/Tracer/Printer.purs−4

backend-es/src/PureScript/Backend/Optimizer/Codegen/EcmaScript/Foreign.purs+3−3

@@ -10,7 +10,7 @@ import Data.Map as Map

1010import Data.Maybe (Maybe(..))

1111import Data.Tuple (Tuple(..))

1212import PureScript.Backend.Optimizer.CoreFn (Ident, Literal(..), Qualified)

13−import PureScript.Backend.Optimizer.Semantics (BackendSemantics(..), ExternSpine(..), SemConditional(..), evalApp, evalPrimOp, liftInt, makeLet)

13+import PureScript.Backend.Optimizer.Semantics (BackendSemantics(..), ExternSpine(..), SemConditional(..), evalApp, evalPrimOp, liftInt, makeEffectBind, makeLet)

1414import PureScript.Backend.Optimizer.Semantics.Foreign (ForeignEval, ForeignSemantics, qualified)

1515import PureScript.Backend.Optimizer.Syntax (BackendOperator(..), BackendOperator1(..), BackendOperator2(..), BackendOperatorOrd(..))

1616import PureScript.Backend.Optimizer.Utils (foldr1Array)

@@ -239,7 +239,7 @@ foreign_object_st_delete = Tuple (qualified "Foreign.Object.ST" "delete") go

239239 Just $

240240 makeLet Nothing a \a' ->

241241 SemLam Nothing \b ->

242− SemEffectBind Nothing (evalApp env (NeutStop qual) [ a', b ]) \_ ->

242+ makeEffectBind Nothing (evalApp env (NeutStop qual) [ a', b ]) \_ ->

243243 SemEffectPure b

244244 _ ->

245245 Nothing

@@ -253,7 +253,7 @@ foreign_object_st_poke = Tuple (qualified "Foreign.Object.ST" "poke") go

253253 makeLet Nothing a \a' ->

254254 makeLet Nothing b \b' ->

255255 SemLam Nothing \c ->

256− SemEffectBind Nothing (evalApp env (NeutStop qual) [ a', b', c ]) \_ ->

256+ makeEffectBind Nothing (evalApp env (NeutStop qual) [ a', b', c ]) \_ ->

257257 SemEffectPure c

258258 _ ->

259259 Nothing

backend-es/test/snapshots-out/Snapshot.VanLaarhovenTraversals01.js+8−8

@@ -6,24 +6,24 @@ const Abs = value0 => value1 => $Fun("Abs", value0, value1);

66const App = value0 => value1 => $Fun("App", value0, value1);

77const traverseFun1 = dictApplicative => {

88 const Apply0 = dictApplicative.Apply0();

9− const map = Apply0.Functor0().map;

9+ const $0 = Apply0.Functor0();

1010 return k => v => {

11− if (v.tag === "Abs") { return map(Abs(v._1))(k(v._2)); }

12− if (v.tag === "App") { return Apply0.apply(map(App)(k(v._1)))(k(v._2)); }

11+ if (v.tag === "Abs") { return $0.map(Abs(v._1))(k(v._2)); }

12+ if (v.tag === "App") { return Apply0.apply($0.map(App)(k(v._1)))(k(v._2)); }

1313 $runtime.fail();

1414 };

1515};

1616const rewriteBottomUpM = dictMonad => {

1717 const Apply0 = dictMonad.Applicative0().Apply0();

18− const map = Apply0.Functor0().map;

19− const $0 = dictMonad.Bind1();

18+ const $0 = Apply0.Functor0();

19+ const $1 = dictMonad.Bind1();

2020 return k => {

2121 const go = a => {

22− if (a.tag === "Abs") { return map(Abs(a._1))($0.bind(go(a._2))(k)); }

23− if (a.tag === "App") { return Apply0.apply(map(App)($0.bind(go(a._1))(k)))($0.bind(go(a._2))(k)); }

22+ if (a.tag === "Abs") { return $0.map(Abs(a._1))($1.bind(go(a._2))(k)); }

23+ if (a.tag === "App") { return Apply0.apply($0.map(App)($1.bind(go(a._1))(k)))($1.bind(go(a._2))(k)); }

2424 $runtime.fail();

2525 };

26− return a => $0.bind(go(a))(k);

26+ return a => $1.bind(go(a))(k);

2727 };

2828};

2929const rewriteBottomUp = k => {

src/PureScript/Backend/Optimizer/Semantics.purs+60−123

@@ -85,8 +85,6 @@ type EffectBindingAssoc a =

8585data BackendRewrite

8686 = RewriteInline (Maybe Ident) Level BackendExpr BackendExpr

8787 | RewriteUncurry (Maybe Ident) Level (NonEmptyArray (Tuple (Maybe Ident) Level)) BackendExpr BackendExpr

88− | RewriteLetAssoc (Array (LetBindingAssoc BackendExpr)) BackendExpr

89− | RewriteEffectBindAssoc (Array (EffectBindingAssoc BackendExpr)) BackendExpr

9088 | RewriteStop (Qualified Ident)

9189 | RewriteUnpackOp (Maybe Ident) Level UnpackOp BackendExpr

9290 | RewriteDistBranchesLet (Maybe Ident) Level (NonEmptyArray (Pair BackendExpr)) BackendExpr BackendExpr

@@ -253,14 +251,12 @@ instance Eval f => Eval (BackendSyntax f) where

253251 idents

254252 env

255253 Let ident _ binding body ->

256− guardFail (eval env binding) \binding' ->

257− makeLet ident binding' (flip eval body <<< bindLocal env <<< One)

254+ makeLet ident (eval env binding) (flip eval body <<< bindLocal env <<< One)

258255 LetRec _ bindings body -> do

259256 let bindGroup sem = flip eval sem <<< bindLocal env <<< Group

260257 SemLetRec (map bindGroup <$> bindings) (bindGroup body)

261258 EffectBind ident _ binding body ->

262− guardFail (eval env binding) \binding' ->

263− SemEffectBind ident binding' (flip eval body <<< bindLocal env <<< One)

259+ makeEffectBind ident (eval env binding) (flip eval body <<< bindLocal env <<< One)

264260 EffectPure val ->

265261 guardFail (eval env val) SemEffectPure

266262 EffectDefer val ->

@@ -297,28 +293,6 @@ instance Eval BackendExpr where

297293 RewriteUncurry ident _ args binding body ->

298294 SemLet ident (mkFnFromArgs env (NonEmptyArray.toArray args) binding) \newFn -> do

299295 eval (bindLocal env (One (mkUncurriedAppRewrite env newFn (NonEmptyArray.length args)))) body

300− RewriteLetAssoc bindings body -> do

301− let

302− goBinding env' = case _ of

303− List.Nil ->

304− eval env' body

305− List.Cons b bs ->

306− makeLet b.ident (eval env' b.binding) \nextBinding ->

307− goBinding (bindLocal env (One nextBinding)) bs

308− goBinding env (List.fromFoldable bindings)

309− RewriteEffectBindAssoc bindings body -> do

310− let

311− goBinding env' = case _ of

312− List.Nil ->

313− eval env' body

314− List.Cons b bs

315− | b.pure ->

316− makeLet b.ident (eval env' b.binding) \nextBinding ->

317− goBinding (bindLocal env (One nextBinding)) bs

318− | otherwise ->

319− SemEffectBind b.ident (eval env' b.binding) \nextBinding ->

320− goBinding (bindLocal env (One nextBinding)) bs

321− goBinding env (List.fromFoldable bindings)

322296 RewriteStop qual ->

323297 NeutStop qual

324298 RewriteUnpackOp _ _ op body ->

@@ -500,7 +474,7 @@ neutralApp hd spine

500474 NeutApp hd spine

501475

502476evalAccessor :: Env -> BackendSemantics -> BackendAccessor -> BackendSemantics

503−evalAccessor env lhs accessor = evalAssocLet lhs case _ of

477+evalAccessor env lhs accessor = floatLet lhs case _ of

504478 SemRef ref spine sem ->

505479 evalRef env ref spine (ExternAccessor accessor) sem

506480 NeutLit (LitRecord props)

@@ -528,7 +502,7 @@ evalAccessor env lhs accessor = evalAssocLet lhs case _ of

528502 NeutAccessor lhs' accessor

529503

530504evalUpdate :: BackendSemantics -> Array (Prop BackendSemantics) -> BackendSemantics

531−evalUpdate lhs props = evalAssocLet lhs case _ of

505+evalUpdate lhs props = floatLet lhs case _ of

532506 NeutLit (LitRecord props') ->

533507 NeutLit (LitRecord (NonEmptyArray.head <$> Array.groupAllBy (comparing propKey) (props <> props')))

534508 NeutUpdate r props' ->

@@ -573,31 +547,60 @@ rewriteBranches k = go

573547evalPair :: forall f. Eval f => Env -> Pair f -> SemConditional BackendSemantics

574548evalPair env (Pair a b) = SemConditional (defer \_ -> eval env a) (defer \_ -> eval env b)

575549

576−evalAssocLet :: BackendSemantics -> (BackendSemantics -> BackendSemantics) -> BackendSemantics

577−evalAssocLet sem go = case sem of

578− SemLet ident val k ->

579− SemLet ident val \nextVal1 ->

580− makeLet Nothing (k nextVal1) go

581− SemLetRec vals k ->

582− SemLetRec vals \nextVals1 ->

583− makeLet Nothing (k nextVals1) go

584− NeutFail err ->

585− NeutFail err

586− _ ->

587− go sem

550+makeEffectBind :: Maybe Ident -> BackendSemantics -> (BackendSemantics -> BackendSemantics) -> BackendSemantics

551+makeEffectBind = go

552+ where

553+ go ident1 binding1 k1 = case binding1 of

554+ SemLet ident2 binding2 k2 ->

555+ makeLet ident2 binding2 \nextBinding2 ->

556+ makeEffectBind ident1 (k2 nextBinding2) k1

557+ SemEffectBind ident2 binding2 k2 ->

558+ go ident2 binding2 \nextBinding2 ->

559+ makeEffectBind ident1 (k2 nextBinding2) k1

560+ SemEffectDefer binding2 ->

561+ SemEffectDefer $ floatLet binding2 \nextBinding2 ->

562+ makeEffectBind ident1 nextBinding2 k1

563+ _ ->

564+ floatLet binding1 \nextBinding2 ->

565+ SemEffectBind ident1 nextBinding2 k1

588566

589567makeLet :: Maybe Ident -> BackendSemantics -> (BackendSemantics -> BackendSemantics) -> BackendSemantics

590−makeLet ident binding go = case binding of

591− SemRef _ [] _ ->

592− go binding

593− NeutLocal _ _ ->

594− go binding

595− NeutStop _ ->

596− go binding

597− NeutVar _ ->

598− go binding

599− _ ->

600− SemLet ident binding go

568+makeLet = floatLetWith go

569+ where

570+ go ident binding k = case binding of

571+ SemRef _ [] _ ->

572+ k binding

573+ NeutLocal _ _ ->

574+ k binding

575+ NeutStop _ ->

576+ k binding

577+ NeutVar _ ->

578+ k binding

579+ _ ->

580+ SemLet ident binding k

581+

582+floatLet :: BackendSemantics -> (BackendSemantics -> BackendSemantics) -> BackendSemantics

583+floatLet = floatLetWith (const (#)) Nothing

584+

585+floatLetWith

586+ :: (Maybe Ident -> BackendSemantics -> (BackendSemantics -> BackendSemantics) -> BackendSemantics)

587+ -> Maybe Ident

588+ -> BackendSemantics

589+ -> (BackendSemantics -> BackendSemantics)

590+ -> BackendSemantics

591+floatLetWith = go

592+ where

593+ go f ident1 binding1 k1 = case binding1 of

594+ SemLet ident2 binding2 k2 ->

595+ go f ident2 binding2 \nextBinding2 ->

596+ makeLet ident1 (k2 nextBinding2) k1

597+ SemLetRec bindings k2 ->

598+ SemLetRec bindings \nextBindings ->

599+ makeLet ident1 (k2 nextBindings) k1

600+ NeutFail _ ->

601+ binding1

602+ _ ->

603+ f ident1 binding1 k1

601604

602605deref :: BackendSemantics -> BackendSemantics

603606deref = case _ of

@@ -636,7 +639,7 @@ evalPrimOp env = case _ of

636639 _, NeutFail err ->

637640 NeutFail err

638641 _, _ ->

639− evalAssocLet x (NeutPrimOp <<< Op1 op1)

642+ floatLet x (NeutPrimOp <<< Op1 op1)

640643 Op2 op2 x y ->

641644 case op2 of

642645 OpBooleanAnd

@@ -742,8 +745,8 @@ evalPrimOp env = case _ of

742745 NeutFail err, _ -> NeutFail err

743746 _, NeutFail err -> NeutFail err

744747 _, _ ->

745− evalAssocLet x \x' ->

746− evalAssocLet y \y' ->

748+ floatLet x \x' ->

749+ floatLet y \y' ->

747750 if isAssocPrimOp op2 then

748751 evalAssocOp env (Right op2) x' y'

749752 else

@@ -1260,16 +1263,6 @@ build ctx = case _ of

12601263 build ctx $ App hd (tl1 <> tl2)

12611264 Abs ids1 (ExprSyntax _ (Abs ids2 body)) ->

12621265 build ctx $ Abs (ids1 <> ids2) body

1263− expr@(Let ident1 level1 (ExprSyntax _ (Let ident2 level2 binding2 body2)) body1) ->

1264− ExprRewrite (withRewrite (analyzeDefault ctx expr)) $ RewriteLetAssoc

1265− [ { ident: ident2, level: level2, binding: binding2 }

1266− , { ident: ident1, level: level1, binding: body2 }

1267− ]

1268− body1

1269− expr@(Let ident1 level1 (ExprRewrite _ (RewriteLetAssoc bindings body2)) body1) ->

1270− ExprRewrite (withRewrite (analyzeDefault ctx expr)) $ RewriteLetAssoc

1271− (Array.snoc bindings { ident: ident1, level: level1, binding: body2 })

1272− body1

12731266 Let ident level binding body

12741267 | shouldInlineLet level binding body ->

12751268 rewriteInline ident level binding body

@@ -1312,29 +1305,6 @@ build ctx = case _ of

13121305 PrimOp (Op2 op2 lhs (ExprSyntax analysis (Branch bs def)))

13131306 | Just expr' <- shouldDistributeBranchPrimOp2R analysis bs def lhs op2 ->

13141307 expr'

1315− expr@(EffectBind ident1 level1 (ExprSyntax _ (EffectBind ident2 level2 binding2 body2)) body1) ->

1316− ExprRewrite (withRewrite (analyzeDefault ctx expr)) $ RewriteEffectBindAssoc

1317− [ { ident: ident2, level: level2, binding: binding2, pure: false }

1318− , { ident: ident1, level: level1, binding: body2, pure: false }

1319− ]

1320− body1

1321− expr@(EffectBind ident1 level1 (ExprSyntax _ (Let ident2 level2 binding2 body2)) body1) ->

1322− ExprRewrite (withRewrite (analyzeDefault ctx expr)) $ RewriteEffectBindAssoc

1323− [ { ident: ident2, level: level2, binding: binding2, pure: true }

1324− , { ident: ident1, level: level1, binding: body2, pure: false }

1325− ]

1326− body1

1327− expr@(EffectBind ident1 level1 (ExprRewrite _ (RewriteEffectBindAssoc bindings body2)) body1) ->

1328− ExprRewrite (withRewrite (analyzeDefault ctx expr)) $ RewriteEffectBindAssoc

1329− (Array.snoc bindings { ident: ident1, level: level1, binding: body2, pure: false })

1330− body1

1331− expr@(EffectBind ident1 level1 (ExprRewrite _ (RewriteLetAssoc bindings body2)) body1) ->

1332− ExprRewrite (withRewrite (analyzeDefault ctx expr)) $ RewriteEffectBindAssoc

1333− (Array.snoc (withPure <$> bindings) { ident: ident1, level: level1, binding: body2, pure: false })

1334− body1

1335− where

1336− withPure { ident, level, binding } =

1337− { ident, level, binding, pure: true }

13381308 EffectBind ident level (ExprSyntax _ (EffectPure binding)) body ->

13391309 build ctx $ EffectDefer $ build ctx $ Let ident level binding body

13401310 EffectBind ident level (ExprSyntax _ (EffectDefer binding)) body ->

@@ -1657,7 +1627,7 @@ optimize traceSteps ctx env (Qualified mn (Ident id)) initN originalExpr =

16571627 if rewrite then

16581628 go newSteps (n - 1) expr2

16591629 else

1660− Tuple (Array.reverse (List.toUnfoldable steps)) expr2

1630+ Tuple (Array.reverse (List.toUnfoldable newSteps)) expr2

16611631

16621632 goStep :: Int -> BackendExpr -> Tuple Boolean BackendExpr

16631633 goStep n expr1

@@ -1686,39 +1656,6 @@ foldBackendExpr foldSyntax foldRewrite = go

16861656 foldSyntax $ Let ident level (foldSyntax (Abs args (go binding))) (go body)

16871657 RewriteStop qual ->

16881658 foldSyntax $ Var qual

1689− RewriteLetAssoc bindings body ->

1690− case NonEmptyArray.fromArray bindings of

1691− Just bindings' -> do

1692− let

1693− { ident, level, binding } = foldl1Array

1694− ( \inner outer -> outer

1695− { binding =

1696− foldSyntax $ Let inner.ident inner.level inner.binding (go outer.binding)

1697− }

1698− )

1699− (\outer -> outer { binding = go outer.binding })

1700− bindings'

1701− foldSyntax $ Let ident level binding (go body)

1702− Nothing ->

1703− go body

1704− RewriteEffectBindAssoc bindings body ->

1705− case NonEmptyArray.fromArray bindings of

1706− Just bindings' -> do

1707− let

1708− { ident, level, binding } = foldl1Array

1709− ( \inner outer -> outer

1710− { binding =

1711− if inner.pure then

1712− foldSyntax $ Let inner.ident inner.level inner.binding (go outer.binding)

1713− else

1714− foldSyntax $ EffectBind inner.ident inner.level inner.binding (go outer.binding)

1715− }

1716− )

1717− (\outer -> outer { binding = go outer.binding })

1718− bindings'

1719− foldSyntax $ Let ident level binding (go body)

1720− Nothing ->

1721− go body

17221659 RewriteUnpackOp ident level op body ->

17231660 case op of

17241661 UnpackRecord props ->

src/PureScript/Backend/Optimizer/Semantics/Foreign.purs+5−5

@@ -13,7 +13,7 @@ import Data.Maybe (Maybe(..))

1313import Data.String as String

1414import Data.Tuple (Tuple(..))

1515import PureScript.Backend.Optimizer.CoreFn (Ident(..), Literal(..), ModuleName(..), Prop(..), Qualified(..), propKey)

16−import PureScript.Backend.Optimizer.Semantics (BackendSemantics(..), Env, EvalRef(..), ExternSpine(..), evalAccessor, evalApp, evalAssocOp, evalMkFn, evalPrimOp, evalUncurriedApp, evalUncurriedEffectApp, evalUpdate, liftBoolean, makeLet)

16+import PureScript.Backend.Optimizer.Semantics (BackendSemantics(..), Env, EvalRef(..), ExternSpine(..), evalAccessor, evalApp, evalAssocOp, evalMkFn, evalPrimOp, evalUncurriedApp, evalUncurriedEffectApp, evalUpdate, liftBoolean, makeEffectBind, makeLet)

1717import PureScript.Backend.Optimizer.Syntax (BackendAccessor(..), BackendEffect(..), BackendOperator(..), BackendOperator1(..), BackendOperator2(..), BackendOperatorNum(..), BackendOperatorOrd(..))

1818

1919type ForeignEval =

@@ -362,11 +362,11 @@ effectBind :: ForeignEval

362362effectBind env _ = case _ of

363363 [ ExternApp [ eff, SemLam ident next ] ] ->

364364 Just $ makeLet Nothing eff \nextEff ->

365− SemEffectBind ident nextEff next

365+ makeEffectBind ident nextEff next

366366 [ ExternApp [ eff, k ] ] ->

367367 Just $ makeLet Nothing eff \nextEff ->

368368 makeLet Nothing k \nextK ->

369− SemEffectBind Nothing nextEff \a ->

369+ makeEffectBind Nothing nextEff \a ->

370370 evalApp env nextK [ a ]

371371 _ -> Nothing

372372

@@ -375,7 +375,7 @@ effectMap env _ = case _ of

375375 [ ExternApp [ fn ] ] ->

376376 Just $ makeLet Nothing fn \fn' ->

377377 SemLam Nothing \val ->

378− SemEffectBind Nothing val \nextVal ->

378+ makeEffectBind Nothing val \nextVal ->

379379 SemEffectPure (evalApp env fn' [ nextVal ])

380380 _ -> Nothing

381381

@@ -412,7 +412,7 @@ effectRefModify env _ = case _ of

412412 [ ExternApp [ fn, ref ] ] ->

413413 Just $ makeLet Nothing fn \fn' ->

414414 makeLet Nothing ref \ref' ->

415− SemEffectBind Nothing (NeutPrimEffect (EffectRefRead ref')) \val ->

415+ makeEffectBind Nothing (NeutPrimEffect (EffectRefRead ref')) \val ->

416416 NeutPrimEffect $ EffectRefWrite ref' (evalApp env fn' [ val ])

417417 _ ->

418418 Nothing

src/PureScript/Backend/Optimizer/Tracer/Printer.purs−4

@@ -292,10 +292,6 @@ printBackendRewriteCase = case _ of

292292 printRewrite "Inline"

293293 RewriteUncurry _ _ _ _ _ ->

294294 printRewrite "Uncurry"

295− RewriteLetAssoc _ _ ->

296− printRewrite "LetAssoc"

297− RewriteEffectBindAssoc _ _ ->

298− printRewrite "EffectBindAssoc"

299295 RewriteStop _ ->

300296 printRewrite "Stop"

301297 RewriteUnpackOp _ _ unpackOp _ ->