16aaca6 · rowtype-yoga/purescript-backend-optimizer

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

Adds deref operation for NeutLocals in the Array.length PrimOp (#64)

* Adds deref operation for NeutLocals in the Array.length PrimOp * Uses case for pattern match Co-authored-by: Nathan Faubion <natefaubion@users.noreply.github.com> * Adds newline to guard Co-authored-by: Nathan Faubion <natefaubion@users.noreply.github.com> * Follow up from Nate's comments * Update backend-es/test/snapshots/Snapshot.PrimOnLocals.purs Newline * Update src/PureScript/Backend/Optimizer/Semantics.purs Edit comment. * Updates test * Inlines array index lookups when appropriate * Adds new test * Revert "Adds new test" This reverts commit b10fe3058ff34469222c2680eefc9d44273e7d95. * Revert "Inlines array index lookups when appropriate" This reverts commit a0f74f84e68e05cf97afddbdd1441ca12701533f. * Removes spurious directive * Adds new semantics for `isTag` that inline the local when possible * More precise IsTag test * More precise ArrayLength test * Commit snapshot result --------- Co-authored-by: Nathan Faubion <natefaubion@users.noreply.github.com> Co-authored-by: Nathan Faubion <nathan@n-son.com>

commit16aaca6e0e84cda5bfc1879ad4a736a589445c4b authorMike Solomon <mike@meeshkan.com> dateSun 2 Jul 2023, 21:19 (3 years ago) parentc11f1e9

6 files changed+63−14

compare with main

unifiedsplit

backend-es/test/snapshots-out/Snapshot.InlineLocalReferenceOpArrayLength.js+2 backend-es/test/snapshots-out/Snapshot.InlineLocalReferenceOpIsTag.js+5 backend-es/test/snapshots/Snapshot.InlineLocalReferenceOpArrayLength.purs+19 backend-es/test/snapshots/Snapshot.InlineLocalReferenceOpIsTag.purs+12 src/PureScript/Backend/Optimizer/Semantics.purs+24−13 src/PureScript/Backend/Optimizer/Semantics/Foreign.purs+1−1

backend-es/test/snapshots-out/Snapshot.InlineLocalReferenceOpArrayLength.jsnew file+2

@@ -0,0 +1,2 @@

1+const test = fn => [];

2+export {test};

backend-es/test/snapshots-out/Snapshot.InlineLocalReferenceOpIsTag.jsnew file+5

@@ -0,0 +1,5 @@

1+const $List = (tag, _1, _2) => ({tag, _1, _2});

2+const Cons = value0 => value1 => $List("Cons", value0, value1);

3+const Nil = /* #__PURE__ */ $List("Nil");

4+const test = fn => $List("Cons", 0, $List("Cons", 1, fn({})));

5+export {$List, Cons, Nil, test};

backend-es/test/snapshots/Snapshot.InlineLocalReferenceOpArrayLength.pursnew file+19

@@ -0,0 +1,19 @@

1+module Snapshot.InlineLocalReferenceOpArrayLength where

3+import Prelude

5+import Data.Array as Array

7+test :: ({} -> Int) -> Array Int

8+test fn = do

9+ let

10+ array =

11+ [ 1

12+ , 2

13+ , fn {}

14+ ]

15+ if Array.length array > 3 then

16+ array

17+ else

18+ []

19+

backend-es/test/snapshots/Snapshot.InlineLocalReferenceOpIsTag.pursnew file+12

@@ -0,0 +1,12 @@

1+module Snapshot.InlineLocalReferenceOpIsTag where

3+data List a = Cons a (List a) | Nil

5+test :: ({} -> List Int) -> List Int

6+test fn = do

7+ let list = Cons 1 (fn {})

8+ case list of

9+ Cons _ _ ->

10+ Cons 0 list

11+ _ ->

12+ Nil

src/PureScript/Backend/Optimizer/Semantics.purs+24−13

@@ -45,7 +45,7 @@ data BackendSemantics

4545 | SemEffectPure BackendSemantics

4646 | SemEffectDefer BackendSemantics

4747 | SemBranch (NonEmptyArray (SemConditional BackendSemantics)) (Lazy BackendSemantics)

48− | NeutLocal (Maybe Ident) Level

48+ | NeutLocal (Maybe Ident) Level (Maybe BackendSemantics)

4949 | NeutVar (Qualified Ident)

5050 | NeutStop (Qualified Ident)

5151 | NeutData (Qualified Ident) ConstructorType ProperName Ident (Array (Tuple String BackendSemantics))

@@ -583,7 +583,7 @@ makeLet :: Maybe Ident -> BackendSemantics -> (BackendSemantics -> BackendSemant

583583makeLet ident binding go = case binding of

584584 SemExtern _ [] _ ->

585585 go binding

586− NeutLocal _ _ ->

586+ NeutLocal _ _ _ ->

587587 go binding

588588 NeutStop _ ->

589589 go binding

@@ -592,6 +592,11 @@ makeLet ident binding go = case binding of

592592 _ ->

593593 SemLet ident binding go

594594

595+deref :: BackendSemantics -> BackendSemantics

596+deref = case _ of

597+ NeutLocal _ _ (Just expr) -> expr

598+ expr -> expr

599+

595600-- TODO: Check for overflow in Int ops since backends may not handle it the

596601-- same was as the JS backend.

597602evalPrimOp :: Env -> BackendOperator BackendSemantics -> BackendSemantics

@@ -604,10 +609,12 @@ evalPrimOp env = case _ of

604609 evalPrimOpNot op

605610 OpIntBitNot, NeutLit (LitInt a) ->

606611 liftInt (complement a)

607− OpIsTag a, NeutData b _ _ _ _ ->

608− liftBoolean (a == b)

609− OpArrayLength, NeutLit (LitArray arr) ->

610− liftInt (Array.length arr)

612+ OpIsTag a, _

613+ | NeutData b _ _ _ _ <- deref x ->

614+ liftBoolean (a == b)

615+ OpArrayLength, _

616+ | NeutLit (LitArray arr) <- deref x ->

617+ liftInt (Array.length arr)

611618 OpIntNegate, NeutLit (LitInt a) ->

612619 liftInt (negate a)

613620 OpNumberNegate, NeutLit (LitNumber a) ->

@@ -1034,17 +1041,21 @@ quote = go

10341041 -- Block constructors

10351042 SemLet ident binding k -> do

10361043 let Tuple level ctx' = nextLevel ctx

1037− build ctx $ Let ident level (quote (ctx { effect = false }) binding) $ quote ctx' $ k $ NeutLocal ident level

1044+ build ctx $ Let ident level (quote (ctx { effect = false }) binding) $ quote ctx' $ k $ NeutLocal ident level (Just binding)

10381045 SemLetRec bindings k -> do

10391046 let Tuple level ctx' = nextLevel ctx

1040− let neutBindings = (\(Tuple ident _) -> Tuple ident $ defer \_ -> NeutLocal (Just ident) level) <$> bindings

1047+ -- We are not currently propagating references

1048+ -- to recursive bindings. The language requires

1049+ -- a runtime check for strictly recursive bindings

1050+ -- which we don't currently implement.

1051+ let neutBindings = (\(Tuple ident _) -> Tuple ident $ defer \_ -> NeutLocal (Just ident) level Nothing) <$> bindings

10411052 build ctx $ LetRec level

10421053 (map (\b -> quote (ctx' { effect = false }) $ b neutBindings) <$> bindings)

10431054 (quote ctx' $ k neutBindings)

10441055 SemEffectBind ident binding k -> do

10451056 let ctx' = ctx { effect = true }

10461057 let Tuple level ctx'' = nextLevel ctx'

1047− build ctx $ EffectBind ident level (quote ctx' binding) $ quote ctx'' $ k $ NeutLocal ident level

1058+ build ctx $ EffectBind ident level (quote ctx' binding) $ quote ctx'' $ k $ NeutLocal ident level (Just binding)

10481059 SemEffectPure sem ->

10491060 build ctx $ EffectPure (quote (ctx { effect = false }) sem)

10501061 SemEffectDefer sem ->

@@ -1060,13 +1071,13 @@ quote = go

10601071 go ctx (force sem)

10611072 SemLam ident k -> do

10621073 let Tuple level ctx' = nextLevel ctx

1063− build ctx $ Abs (NonEmptyArray.singleton (Tuple ident level)) $ quote (ctx' { effect = false }) $ k $ NeutLocal ident level

1074+ build ctx $ Abs (NonEmptyArray.singleton (Tuple ident level)) $ quote (ctx' { effect = false }) $ k $ NeutLocal ident level Nothing

10641075 SemMkFn pro -> do

10651076 let

10661077 loop ctx' idents = case _ of

10671078 MkFnNext ident k -> do

10681079 let Tuple lvl ctx'' = nextLevel ctx'

1069− loop ctx'' (Array.snoc idents (Tuple ident lvl)) (k (NeutLocal ident lvl))

1080+ loop ctx'' (Array.snoc idents (Tuple ident lvl)) (k (NeutLocal ident lvl Nothing))

10701081 MkFnApplied body ->

10711082 build ctx' $ UncurriedAbs idents $ quote (ctx' { effect = false }) body

10721083 loop ctx [] pro

@@ -1075,11 +1086,11 @@ quote = go

10751086 loop ctx' idents = case _ of

10761087 MkFnNext ident k -> do

10771088 let Tuple lvl ctx'' = nextLevel ctx'

1078− loop ctx'' (Array.snoc idents (Tuple ident lvl)) (k (NeutLocal ident lvl))

1089+ loop ctx'' (Array.snoc idents (Tuple ident lvl)) (k (NeutLocal ident lvl Nothing))

10791090 MkFnApplied body ->

10801091 build ctx' $ UncurriedEffectAbs idents $ quote (ctx' { effect = false }) body

10811092 loop ctx [] pro

1082− NeutLocal ident level ->

1093+ NeutLocal ident level _ ->

10831094 build ctx $ Local ident level

10841095 NeutVar qual ->

10851096 build ctx $ Var qual

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

@@ -573,7 +573,7 @@ record_builder_unsafeModify = Tuple (qualified "Record.Builder" "unsafeModify")

573573 )

574574 props

575575 Just $ NeutLit (LitRecord props')

576− [ ExternApp [ NeutLit (LitString prop), fn, r@(NeutUpdate r'@(NeutLocal _ _) _) ] ] -> do

576+ [ ExternApp [ NeutLit (LitString prop), fn, r@(NeutUpdate r'@(NeutLocal _ _ _) _) ] ] -> do

577577 let update = Prop prop (evalApp env fn [ (evalAccessor env r' (GetProp prop)) ])

578578 Just $ evalUpdate env r [ update ]

579579 [ ExternApp [ NeutLit (LitString prop), fn, other ] ] | Just r <- viewCopyRecord other ->