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

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

Improve associative operator handling (#77)

Improve associative operator handling Previously, there were a couple of baroque routines for reassociating operators during eval advantageously. It only did this to a fixed depth because this can become quadratic. I've replaced this with a single baroque routine that solves it completely, const evaling anything it can, and reassociating everything to the left. To do this, I've added a new SemAssocOp node that's similar to SemRef, which buffers the operator spine. Then during quote we actually reassociate it. I've also added special support for compiling concatArray calls to array spreads, which both looks nicer and is likely faster at runtime.

commit8c7777a8aa68264e9ab24675e3fc3446004cce3d authorNathan Faubion <natefaubion@users.noreply.github.com> dateWed 2 Aug 2023, 07:11 (3 years ago) parent21b0f9f

16 files changed+217−180

compare with main

unifiedsplit

backend-es/src/PureScript/Backend/Optimizer/Codegen/EcmaScript/Inline.purs+10

@@ -28,6 +28,7 @@ esInlineMap = Map.fromFoldable

2828 , data_array_st_new

2929 , data_array_st_pushAll

3030 , data_array_st_unshiftAll

31+ , data_semigroup_concatArray

3132 , effect_forE

3233 , effect_foreachE

3334 , effect_whileE

@@ -85,6 +86,15 @@ arraySTAll method env _ = case _ of

8586 _ ->

8687 Nothing

8788

89+data_semigroup_concatArray :: EsInline

90+data_semigroup_concatArray = Tuple (qualified "Data.Semigroup" "concatArray") go

91+ where

92+ go env _ = case _ of

93+ InlineApp [ a, b ] ->

94+ Just $ build $ EsArray $ spreadConcatArray (codegenExpr env a) <> spreadConcatArray (codegenExpr env b)

95+ _ ->

96+ Nothing

97+

8898effect_forE :: EsInline

8999effect_forE = Tuple (qualified "Effect" "forE") forRangeLoop

90100

backend-es/test/snapshots-out/Snapshot.AssocArrayAppend.jsnew file+4

@@ -0,0 +1,4 @@

1+const test3 = x => ["a", "b", ...x, ...x, ...x, ...x, "c", "d", "e", ...x, ...x, ...x, ...x, "f", "g"];

2+const test2 = x => ["a", "b", ...x, ...x, ...x, ...x, "c", "d"];

3+const test1 = x => ["a", "b", ...x, ...x, ...x, ...x, "c", "d"];

4+export {test1, test2, test3};

backend-es/test/snapshots-out/Snapshot.AssocIntOps.jsnew file+7

@@ -0,0 +1,7 @@

1+const test6 = x => (((((((((2 * x | 0) * x | 0) * x | 0) * x | 0) * 60 | 0) * x | 0) * x | 0) * x | 0) * x | 0) * 42 | 0;

2+const test5 = x => ((((2 * x | 0) * x | 0) * x | 0) * x | 0) * 12 | 0;

3+const test4 = x => ((((2 * x | 0) * x | 0) * x | 0) * x | 0) * 12 | 0;

4+const test3 = x => (((((((((3 + x | 0) + x | 0) + x | 0) + x | 0) + 12 | 0) + x | 0) + x | 0) + x | 0) + x | 0) + 13 | 0;

5+const test2 = x => ((((3 + x | 0) + x | 0) + x | 0) + x | 0) + 7 | 0;

6+const test1 = x => ((((3 + x | 0) + x | 0) + x | 0) + x | 0) + 7 | 0;

7+export {test1, test2, test3, test4, test5, test6};

backend-es/test/snapshots-out/Snapshot.AssocNumberOps.jsnew file+7

@@ -0,0 +1,7 @@

1+const test6 = x => 2.0 * x * x * x * x * 60.0 * x * x * x * x * 42.0;

2+const test5 = x => 2.0 * x * x * x * x * 12.0;

3+const test4 = x => 2.0 * x * x * x * x * 12.0;

4+const test3 = x => 3.0 + x + x + x + x + 12.0 + x + x + x + x + 13.0;

5+const test2 = x => 3.0 + x + x + x + x + 7.0;

6+const test1 = x => 3.0 + x + x + x + x + 7.0;

7+export {test1, test2, test3, test4, test5, test6};

backend-es/test/snapshots-out/Snapshot.AssocStringAppend.jsnew file+4

@@ -0,0 +1,4 @@

1+const test3 = x => "ab" + x + x + x + x + "cde" + x + x + x + x + "fg";

2+const test2 = x => "ab" + x + x + x + x + "cd";

3+const test1 = x => "ab" + x + x + x + x + "cd";

4+export {test1, test2, test3};

backend-es/test/snapshots-out/Snapshot.CaseLeafTco.js+4−5

@@ -1,6 +1,5 @@

11import * as $runtime from "../runtime.js";

22import * as Data$dArray from "../Data.Array/index.js";

3−import * as Data$dSemigroup from "../Data.Semigroup/index.js";

43const test1 = test1$a0$copy => test1$a1$copy => {

54 let test1$a0 = test1$a0$copy, test1$a1 = test1$a1$copy, test1$c = true, test1$r;

65 while (test1$c) {

@@ -14,7 +13,7 @@ const test1 = test1$a0$copy => test1$a1$copy => {

1413 return;

1514 }

1615 test1$a0 = b;

17− test1$a1 = Data$dSemigroup.concatArray([y, x, 3, y, 5, 6, 7, 8, 9, 10, x, 12, 13, 14, 15, 16, 17])(arr);

16+ test1$a1 = [y, x, 3, y, 5, 6, 7, 8, 9, 10, x, 12, 13, 14, 15, 16, 17, ...arr];

1817 };

1918 if (v.tag === "Just") {

2019 if (v._1 === 2) {

@@ -31,7 +30,7 @@ const test1 = test1$a0$copy => test1$a1$copy => {

3130 }

3231 if (v.tag === "Nothing") {

3332 test1$c = false;

34− test1$r = Data$dSemigroup.concatArray(arr)([arr[0]]);

33+ test1$r = [...arr, arr[0]];

3534 continue;

3635 }

3736 $runtime.fail();

@@ -39,11 +38,11 @@ const test1 = test1$a0$copy => test1$a1$copy => {

3938 if (v.tag === "Just") {

4039 if (v._1 === 2) {

4140 test1$c = false;

42− test1$r = Data$dSemigroup.concatArray(arr)([v._1]);

41+ test1$r = [...arr, v._1];

4342 continue;

4443 }

4544 test1$c = false;

46− test1$r = Data$dSemigroup.concatArray(arr)([v._1]);

45+ test1$r = [...arr, v._1];

4746 continue;

4847 }

4948 if (v.tag === "Nothing") {

backend-es/test/snapshots-out/Snapshot.DefaultRulesSemigroup02.js+2−3

@@ -1,7 +1,6 @@

1−import * as Data$dSemigroup from "../Data.Semigroup/index.js";

2−const append = ra => rb => ({bar: Data$dSemigroup.concatArray(ra.bar)(rb.bar), foo: ra.foo + rb.foo});

1+const append = ra => rb => ({bar: [...ra.bar, ...rb.bar], foo: ra.foo + rb.foo});

32const test4 = {bar: ["hello", "World!"], foo: "hello, World!"};

43const test3 = /* #__PURE__ */ append({foo: "hello", bar: ["hello"]});

5−const test2 = a => b => ({bar: Data$dSemigroup.concatArray(a.bar)(b.bar), foo: a.foo + b.foo});

4+const test2 = a => b => ({bar: [...a.bar, ...b.bar], foo: a.foo + b.foo});

65const test1 = append;

76export {append, test1, test2, test3, test4};

backend-es/test/snapshots-out/Snapshot.EffectBind06.js+1−1

@@ -3,6 +3,6 @@ const test = random => () => {

33 const x1 = random();

44 const y = random();

55 const m = random();

6− return (x + (x1 + y | 0) | 0) - m | 0;

6+ return ((x + x1 | 0) + y | 0) - m | 0;

77};

88export {test};

backend-es/test/snapshots-out/Snapshot.EffectBind07.js+1−1

@@ -6,6 +6,6 @@ const test = random => value => () => {

66 const x1 = random();

77 const y = random();

88 const m = random();

9− return (x + (((x1 + y | 0) + a | 0) + a | 0) | 0) - m | 0;

9+ return ((((x + x1 | 0) + y | 0) + a | 0) + a | 0) - m | 0;

1010};

1111export {test};

backend-es/test/snapshots-out/Snapshot.HalogenVDomST02.js+2−2

@@ -4,10 +4,10 @@ import * as Data$dEq from "../Data.Eq/index.js";

44import * as Data$dShow from "../Data.Show/index.js";

55import * as Snapshot$dHalogenVDomST01 from "../Snapshot.HalogenVDomST01/index.js";

66const assertEqual = /* #__PURE__ */ Assert.assertEqual({eq: /* #__PURE__ */ Data$dEq.eqArrayImpl(ra => rb => ra.a === rb.a && ra.b === rb.b)})({

7− show: /* #__PURE__ */ Data$dShow.showArrayImpl(record => "{ a: " + Data$dShow.showStringImpl(record.a) + ", b: " + Data$dShow.showIntImpl(record.b) + " " + "}")

7+ show: /* #__PURE__ */ Data$dShow.showArrayImpl(record => "{ a: " + Data$dShow.showStringImpl(record.a) + ", b: " + Data$dShow.showIntImpl(record.b) + " }")

88});

99const assertEqual3 = /* #__PURE__ */ Assert.assertEqual({eq: /* #__PURE__ */ Data$dEq.eqArrayImpl(ra => rb => ra.a === rb.a && ra.b === rb.b && ra.ix === rb.ix)})({

10− show: /* #__PURE__ */ Data$dShow.showArrayImpl(record => "{ a: " + Data$dShow.showStringImpl(record.a) + ", b: " + Data$dShow.showIntImpl(record.b) + ", ix: " + Data$dShow.showIntImpl(record.ix) + " " + "}")

10+ show: /* #__PURE__ */ Data$dShow.showArrayImpl(record => "{ a: " + Data$dShow.showStringImpl(record.a) + ", b: " + Data$dShow.showIntImpl(record.b) + ", ix: " + Data$dShow.showIntImpl(record.ix) + " }")

1111});

1212const main = () => {

1313 const merged1 = [];

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

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

1+module Snapshot.AssocArrayAppend where

3+import Prelude

5+test1 :: Array String -> Array String

6+test1 x = [ "a" ] <> ((((([ "b" ] <> x) <> x) <> x) <> x) <> [ "c" ]) <> [ "d" ]

8+test2 :: Array String -> Array String

9+test2 x = [ "a" ] <> ([ "b" ] <> (x <> (x <> (x <> (x <> [ "c" ]))))) <> [ "d" ]

10+

11+test3 :: Array String -> Array String

12+test3 x = [ "a" ] <> ([ "b" ] <> (x <> (x <> (x <> (x <> [ "c" ]))))) <> [ "d" ] <> ((((([ "e" ] <> x) <> x) <> x) <> x) <> [ "f" ]) <> [ "g" ]

backend-es/test/snapshots/Snapshot.AssocIntOps.pursnew file+21

@@ -0,0 +1,21 @@

1+module Snapshot.AssocIntOps where

3+import Prelude

5+test1 :: Int -> Int

6+test1 x = 1 + (((((2 + x) + x) + x) + x) + 3) + 4

8+test2 :: Int -> Int

9+test2 x = 1 + (2 + (x + (x + (x + (x + 3))))) + 4

10+

11+test3 :: Int -> Int

12+test3 x = 1 + (2 + (x + (x + (x + (x + 3))))) + 4 + (((((5 + x) + x) + x) + x) + 6) + 7

13+

14+test4 :: Int -> Int

15+test4 x = 1 * (((((2 * x) * x) * x) * x) * 3) * 4

16+

17+test5 :: Int -> Int

18+test5 x = 1 * (2 * (x * (x * (x * (x * 3))))) * 4

19+

20+test6 :: Int -> Int

21+test6 x = 1 * (2 * (x * (x * (x * (x * 3))))) * 4 * (((((5 * x) * x) * x) * x) * 6) * 7

backend-es/test/snapshots/Snapshot.AssocNumberOps.pursnew file+21

@@ -0,0 +1,21 @@

1+module Snapshot.AssocNumberOps where

3+import Prelude

5+test1 :: Number -> Number

6+test1 x = 1.0 + (((((2.0 + x) + x) + x) + x) + 3.0) + 4.0

8+test2 :: Number -> Number

9+test2 x = 1.0 + (2.0 + (x + (x + (x + (x + 3.0))))) + 4.0

10+

11+test3 :: Number -> Number

12+test3 x = 1.0 + (2.0 + (x + (x + (x + (x + 3.0))))) + 4.0 + (((((5.0 + x) + x) + x) + x) + 6.0) + 7.0

13+

14+test4 :: Number -> Number

15+test4 x = 1.0 * (((((2.0 * x) * x) * x) * x) * 3.0) * 4.0

16+

17+test5 :: Number -> Number

18+test5 x = 1.0 * (2.0 * (x * (x * (x * (x * 3.0))))) * 4.0

19+

20+test6 :: Number -> Number

21+test6 x = 1.0 * (2.0 * (x * (x * (x * (x * 3.0))))) * 4.0 * (((((5.0 * x) * x) * x) * x) * 6.0) * 7.0

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

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

1+module Snapshot.AssocStringAppend where

3+import Prelude

5+test1 :: String -> String

6+test1 x = "a" <> ((((("b" <> x) <> x) <> x) <> x) <> "c") <> "d"

8+test2 :: String -> String

9+test2 x = "a" <> ("b" <> (x <> (x <> (x <> (x <> "c"))))) <> "d"

10+

11+test3 :: String -> String

12+test3 x = "a" <> ("b" <> (x <> (x <> (x <> (x <> "c"))))) <> "d" <> ((((("e" <> x) <> x) <> x) <> x) <> "f") <> "g"

src/PureScript/Backend/Optimizer/Semantics.purs+99−87

@@ -6,6 +6,7 @@ import Control.Alternative (guard)

66import Data.Array as Array

77import Data.Array.NonEmpty (NonEmptyArray)

88import Data.Array.NonEmpty as NonEmptyArray

9+import Data.Either (Either(..))

910import Data.Foldable (class Foldable, and, foldMap, foldl, foldr, or)

1011import Data.Foldable as Foldable

1112import Data.Foldable as Tuple

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

4546 | SemEffectPure BackendSemantics

4647 | SemEffectDefer BackendSemantics

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

49+ | SemAssocOp (Either (Qualified Ident) BackendOperator2) (NonEmptyArray BackendSemantics)

4850 | NeutLocal (Maybe Ident) Level

4951 | NeutVar (Qualified Ident)

5052 | NeutStop (Qualified Ident)

@@ -733,8 +735,9 @@ evalPrimOp env = case _ of

733735 , NeutLit (LitString b) <- deref y ->

734736 liftBoolean (evalPrimOpOrd op a b)

735737 OpStringAppend

736− | Just result <- evalPrimOpAssocL OpStringAppend caseString (\a b -> Just $ liftString (a <> b)) x y ->

737− result

738+ | NeutLit (LitString a) <- x

739+ , NeutLit (LitString b) <- y ->

740+ liftString (a <> b)

738741 OpArrayIndex

739742 | NeutLit (LitInt n) <- y ->

740743 evalAccessor env x (GetIndex n)

@@ -756,43 +759,10 @@ evalPrimOp env = case _ of

756759 _, NeutFail err -> NeutFail err

757760 _, _ ->

758761 evalAssocLet2 env x y \_ x' y' ->

759− NeutPrimOp (Op2 op2 x' y')

760−

761−evalPrimOpAssocL :: forall a. BackendOperator2 -> (BackendSemantics -> Maybe a) -> (a -> a -> Maybe BackendSemantics) -> BackendSemantics -> BackendSemantics -> Maybe BackendSemantics

762−evalPrimOpAssocL op match combine a b = case match a of

763− Just lhs

764− | Just rhs <- match b ->

765− combine lhs rhs

766− | Just (Tuple x y) <- decompose b ->

767− case match x of

768− Just rhs ->

769− (\x' -> liftOp2 op x' y) <$> combine lhs rhs

770− Nothing

771− | Just (Tuple v w) <- decompose x

772− , Just rhs <- match v ->

773− (\v' -> liftOp2 op (liftOp2 op v' w) y) <$> combine lhs rhs

774− _ ->

775− Nothing

776− Nothing

777− | Just rhs <- match b

778− , Just (Tuple v w) <- decompose a ->

779− case match w of

780− Just lhs ->

781− liftOp2 op v <$> combine lhs rhs

782− Nothing

783− | Just (Tuple x y) <- decompose w

784− , Just lhs <- match y ->

785− liftOp2 op (liftOp2 op v x) <$> combine lhs rhs

786− _ ->

787− Nothing

788− _ ->

789− Nothing

790− where

791− decompose = case _ of

792− NeutPrimOp (Op2 op' x y) | op == op' ->

793− Just (Tuple x y)

794− _ ->

795− Nothing

762+ if isAssocPrimOp op2 then

763+ evalAssocOp env (Right op2) x' y'

764+ else

765+ NeutPrimOp (Op2 op2 x' y')

796766

797767evalPrimOpOrd :: forall a. Ord a => BackendOperatorOrd -> a -> a -> Boolean

798768evalPrimOpOrd op x y = case op of

@@ -815,56 +785,38 @@ evalPrimOpOrdNumber op x y = case op of

815785 OpLte -> x <= y

816786

817787evalPrimOpNumNumber :: BackendOperatorNum -> BackendSemantics -> BackendSemantics -> Maybe BackendSemantics

818−evalPrimOpNumNumber op x y = case op of

819− OpAdd ->

820− evalPrimOpAssocL (OpNumberNum OpAdd) (caseNumber <<< deref) (\a b -> Just $ liftNumber (a + b)) x y

821− OpMultiply ->

822− evalPrimOpAssocL (OpNumberNum OpMultiply) (caseNumber <<< deref) (\a b -> Just $ liftNumber (a * b)) x y

823− OpSubtract

824− | NeutLit (LitNumber a) <- deref x

825− , NeutLit (LitNumber b) <- deref y ->

826− Just $ liftNumber (a - b)

827− OpDivide

828− | NeutLit (LitNumber a) <- deref x

829− , NeutLit (LitNumber b) <- deref y ->

830− Just $ liftNumber (a / b)

831− _ ->

832− Nothing

788+evalPrimOpNumNumber op x y

789+ | NeutLit (LitNumber a) <- deref x

790+ , NeutLit (LitNumber b) <- deref y =

791+ Just $ liftNumber case op of

792+ OpAdd -> a + b

793+ OpMultiply -> a * b

794+ OpSubtract -> a - b

795+ OpDivide -> a / b

796+ | otherwise =

797+ Nothing

833798

834799evalPrimOpNumInt :: BackendOperatorNum -> BackendSemantics -> BackendSemantics -> Maybe BackendSemantics

835−evalPrimOpNumInt op x y = case op of

836− OpAdd ->

837− evalPrimOpAssocL (OpIntNum OpAdd) (caseInt <<< deref) addOverflow x y

838− where

839− addOverflow a b = do

840− let res = a + b

841− if b > 0 && res < a || b < 0 && res > a then

842− Nothing

843− else

844− Just $ liftInt res

845− OpMultiply ->

846− evalPrimOpAssocL (OpIntNum OpMultiply) (caseInt <<< deref) mulOverflow x y

847− where

848− mulOverflow a b = do

849− let res = a * b

850− if a /= (res / b) then

851− Nothing

852− else

853− Just $ liftInt res

854− OpSubtract

855− | NeutLit (LitInt a) <- deref x

856− , NeutLit (LitInt b) <- deref y -> do

857− let res = a - b

858− if b > 0 && res > a || b < 0 && res < a then

859− Nothing

860− else

861− Just $ liftInt res

862− OpDivide

863− | NeutLit (LitInt a) <- deref x

864− , NeutLit (LitInt b) <- deref y ->

865− Just $ liftInt (a / b)

866− _ ->

867− Nothing

800+evalPrimOpNumInt op x y

801+ | NeutLit (LitInt a) <- deref x

802+ , NeutLit (LitInt b) <- deref y =

803+ case op of

804+ OpAdd -> do

805+ let res = a + b

806+ if b > 0 && res < a || b < 0 && res > a then Nothing

807+ else Just $ liftInt res

808+ OpMultiply -> do

809+ let res = a * b

810+ if a /= (res / b) then Nothing

811+ else Just $ liftInt res

812+ OpSubtract -> do

813+ let res = a - b

814+ if b > 0 && res > a || b < 0 && res < a then Nothing

815+ else Just $ liftInt res

816+ OpDivide ->

817+ Just $ liftInt (a / b)

818+ | otherwise =

819+ Nothing

868820

869821evalPrimOpNot :: BackendOperator BackendSemantics -> BackendSemantics

870822evalPrimOpNot = case _ of

@@ -898,6 +850,56 @@ primOpOrdNot = case _ of

898850 OpGt -> OpLte

899851 OpGte -> OpLt

900852

853+isAssocPrimOp :: BackendOperator2 -> Boolean

854+isAssocPrimOp = case _ of

855+ OpIntNum OpAdd -> true

856+ OpIntNum OpMultiply -> true

857+ OpNumberNum OpAdd -> true

858+ OpNumberNum OpMultiply -> true

859+ OpStringAppend -> true

860+ _ -> false

861+

862+evalAssocOp :: Env -> Either (Qualified Ident) BackendOperator2 -> BackendSemantics -> BackendSemantics -> BackendSemantics

863+evalAssocOp env op1 = case _, _ of

864+ SemAssocOp op2 as, SemAssocOp op3 bs

865+ | op1 == op2

866+ , op2 == op3 ->

867+ case evalAssocOp' env op1 (NonEmptyArray.last as) (NonEmptyArray.head bs) of

868+ SemAssocOp op4 cs

869+ | op3 == op4 ->

870+ SemAssocOp op1 $ NonEmptyArray.prependArray (NonEmptyArray.init as) (NonEmptyArray.appendArray cs (NonEmptyArray.tail bs))

871+ c ->

872+ SemAssocOp op1 $ NonEmptyArray.prependArray (NonEmptyArray.init as) (NonEmptyArray.cons' c (NonEmptyArray.tail bs))

873+ a, SemAssocOp op2 bs

874+ | op1 == op2 ->

875+ case evalAssocOp' env op1 a (NonEmptyArray.head bs) of

876+ SemAssocOp op3 cs

877+ | op2 == op3 ->

878+ SemAssocOp op1 $ NonEmptyArray.appendArray cs (NonEmptyArray.tail bs)

879+ a' ->

880+ SemAssocOp op1 $ NonEmptyArray.cons' a' (NonEmptyArray.tail bs)

881+ SemAssocOp op2 as, b

882+ | op1 == op2 ->

883+ case evalAssocOp' env op1 (NonEmptyArray.last as) b of

884+ SemAssocOp op3 cs

885+ | op2 == op3 ->

886+ SemAssocOp op1 $ NonEmptyArray.prependArray (NonEmptyArray.init as) cs

887+ b' ->

888+ SemAssocOp op1 $ NonEmptyArray.snoc' (NonEmptyArray.init as) b'

889+ a, b ->

890+ SemAssocOp op1 $ NonEmptyArray.cons' a [ b ]

891+

892+evalAssocOp' :: Env -> Either (Qualified Ident) BackendOperator2 -> BackendSemantics -> BackendSemantics -> BackendSemantics

893+evalAssocOp' env@(Env e) op a b = case op of

894+ Left qual ->

895+ case e.evalExternSpine env qual [ ExternApp [ a, b ] ] of

896+ Just res ->

897+ res

898+ Nothing ->

899+ SemAssocOp op $ NonEmptyArray.cons' a [ b ]

900+ Right primOp ->

901+ evalPrimOp env (Op2 primOp a b)

902+

901903evalRef :: Env -> EvalRef -> Array ExternSpine -> ExternSpine -> Lazy BackendSemantics -> BackendSemantics

902904evalRef env@(Env e) ref spine last sem = case ref of

903905 EvalExtern qual

@@ -1214,6 +1216,16 @@ quote = go

12141216 MkFnApplied body ->

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

12161218 loop ctx [] pro

1219+ SemAssocOp op spine ->

1220+ foldl1Array

1221+ ( \a b -> case op of

1222+ Left qual ->

1223+ build ctx $ App (build ctx (Var qual)) $ NonEmptyArray.cons' a [ quote ctx b ]

1224+ Right primOp ->

1225+ build ctx $ PrimOp (Op2 primOp a (quote ctx b))

1226+ )

1227+ (quote ctx)

1228+ spine

12171229 NeutLocal ident level ->

12181230 build ctx $ Local ident level

12191231 NeutVar qual ->

src/PureScript/Backend/Optimizer/Semantics/Foreign.purs+10−81

@@ -4,8 +4,8 @@ import Prelude

55import Data.Array as Array

66import Data.Array.NonEmpty as NonEmptyArray

7+import Data.Either (Either(..))

78import Data.Enum (fromEnum)

8−import Data.Lazy (defer)

99import Data.List as List

1010import Data.Map (Map)

1111import Data.Map as Map

@@ -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, 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, makeLet)

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

1818

1919type ForeignEval =

@@ -431,91 +431,20 @@ isQualified mod tag = case _ of

431431 _ ->

432432 false

433433

434−assocBinaryOperatorL

435− :: forall a

436− . (BackendSemantics -> Maybe a)

437− -> (Env -> a -> a -> BackendSemantics)

438− -> (Env -> BackendSemantics -> BackendSemantics -> Maybe BackendSemantics)

439− -> ForeignEval

440−assocBinaryOperatorL match op def env ident = case _ of

441− [ ExternApp [ a, b ] ] ->

442− case rewrite of

443− Just _ ->

444− rewrite

445− Nothing ->

446− def env a b

447− where

448− rewrite = case match a of

449− Just lhs ->

450− case match b of

451− Just rhs ->

452− Just $ op env lhs rhs

453− Nothing ->

454− case b of

455− SemRef (EvalExtern ident') [ ExternApp [ x, y ] ] _ | ident == ident' ->

456− case match x of

457− Just rhs -> do

458− let result = op env lhs rhs

459− Just $ externApp env ident [ result, y ]

460− Nothing ->

461− case x of

462− SemRef (EvalExtern ident'') [ ExternApp [ v, w ] ] _ | ident == ident'' ->

463− case match v of

464− Just rhs -> do

465− let result = op env lhs rhs

466− Just $ externApp env ident [ externApp env ident [ result, w ], y ]

467− Nothing ->

468− Nothing

469− _ ->

470− Nothing

471− _ ->

472− Nothing

473− Nothing ->

474− case match b of

475− Just rhs ->

476− case a of

477− SemRef (EvalExtern ident') [ ExternApp [ v, w ] ] _ | ident == ident' ->

478− case match w of

479− Just lhs -> do

480− let result = op env lhs rhs

481− Just $ externApp env ident [ v, result ]

482− Nothing ->

483− case w of

484− SemRef (EvalExtern ident'') [ ExternApp [ x, y ] ] _ | ident == ident'' ->

485− case match y of

486− Just lhs -> do

487− let result = op env lhs rhs

488− Just $ externApp env ident [ externApp env ident [ v, x ], result ]

489− Nothing ->

490− Nothing

491− _ ->

492− Nothing

493− _ ->

494− Nothing

495− Nothing ->

496− Nothing

497− _ ->

498− Nothing

499−

500434data_semigroup_concatArray :: ForeignSemantics

501−data_semigroup_concatArray = Tuple (qualified "Data.Semigroup" "concatArray") $ assocBinaryOperatorL match op default

435+data_semigroup_concatArray = Tuple (qualified "Data.Semigroup" "concatArray") go

502436 where

503− match = case _ of

504− NeutLit (LitArray a) -> Just a

505− _ -> Nothing

506−

507− op _ a b =

508− NeutLit (LitArray (a <> b))

509−

510− default _ _ _ =

511− Nothing

437+ go env qual = case _ of

438+ [ ExternApp [ NeutLit (LitArray as), NeutLit (LitArray bs) ] ] ->

439+ Just $ NeutLit (LitArray (as <> bs))

440+ [ ExternApp [ a, b ] ] ->

441+ Just $ evalAssocOp env (Left qual) a b

442+ _ ->

443+ Nothing

512444

513445data_semigroup_concatString :: ForeignSemantics

514446data_semigroup_concatString = Tuple (qualified "Data.Semigroup" "concatString") $ primBinaryOperator OpStringAppend

515447

516−externApp :: Env -> Qualified Ident -> Array BackendSemantics -> BackendSemantics

517−externApp env qual = evalApp env (SemRef (EvalExtern qual) [] (defer \_ -> NeutVar qual))

518−

519448partial_unsafe_unsafePartial :: ForeignSemantics

520449partial_unsafe_unsafePartial = Tuple (qualified "Partial.Unsafe" "_unsafePartial") go

521450 where