49003bd · rowtype-yoga/purescript-backend-optimizer

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

Add show semantics, tweak transitive arity annotations of dict applications (#21)

* Add show semantics, tweak transitive arity annotations of dict applications * Format * Move show to ES foreign semantics

commit49003bdd7ce86dc83fcc263a2d5b63b7ee7d43ae authorNathan Faubion <natefaubion@users.noreply.github.com> dateWed 17 Aug 2022, 09:11 (4 years ago) parentc8753a6

9 files changed+65−20

compare with main

unifiedsplit

backend-es/src/PureScript/Backend/Optimizer/Codegen/EcmaScript/Foreign.purs+31 backend-es/test/snapshots-out/Snapshot.ConvertableOptions01.js+1−5 backend-es/test/snapshots-out/Snapshot.DefaultRulesEq02.js+2−3 backend-es/test/snapshots-out/Snapshot.ShowLiterals.js+7 backend-es/test/snapshots-out/Snapshot.UncurriedEffectFns02.js+1−1 backend-es/test/snapshots-out/Snapshot.VanLaarhovenTraversals01.js+2−6 backend-es/test/snapshots/Snapshot.ShowLiterals.purs+9 backend-es/test/snapshots/Snapshot.VanLaarhovenTraversals01.purs+1−2 src/PureScript/Backend/Optimizer/Convert.purs+11−3

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

@@ -20,6 +20,10 @@ esForeignSemantics = Map.fromFoldable semantics

2020 , data_bounded_topChar

2121 , data_bounded_bottomChar

2222 , data_enum_toCharCode

23+ , data_show_showCharImpl

24+ , data_show_showIntImpl

25+ , data_show_showNumberImpl

26+ , data_show_showStringImpl

2327 ]

2428

2529data_bounded_topInt :: ForeignSemantics

@@ -51,6 +55,33 @@ data_enum_toCharCode = Tuple (qualified "Data.Enum" "toCharCode") go

5155 _ ->

5256 Nothing

5357

58+data_show_showStringImpl :: ForeignSemantics

59+data_show_showStringImpl = Tuple (qualified "Data.Show" "showStringImpl") $ showLit case _ of

60+ NeutLit (LitString n) -> Just n

61+ _ -> Nothing

62+

63+data_show_showIntImpl :: ForeignSemantics

64+data_show_showIntImpl = Tuple (qualified "Data.Show" "showIntImpl") $ showLit case _ of

65+ NeutLit (LitInt n) -> Just n

66+ _ -> Nothing

67+

68+data_show_showNumberImpl :: ForeignSemantics

69+data_show_showNumberImpl = Tuple (qualified "Data.Show" "showNumberImpl") $ showLit case _ of

70+ NeutLit (LitNumber n) -> Just n

71+ _ -> Nothing

72+

73+data_show_showCharImpl :: ForeignSemantics

74+data_show_showCharImpl = Tuple (qualified "Data.Show" "showCharImpl") $ showLit case _ of

75+ NeutLit (LitChar n) -> Just n

76+ _ -> Nothing

77+

78+showLit :: forall a. Show a => (BackendSemantics -> Maybe a) -> ForeignEval

79+showLit match _ _ = case _ of

80+ [ ExternApp [ sem ] ] | Just val <- match sem ->

81+ Just $ NeutLit $ LitString (show val)

82+ _ ->

83+ Nothing

84+

5485litInt :: Int -> BackendSemantics

5586litInt = NeutLit <<< LitInt

5687

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

@@ -3,7 +3,6 @@

33// @inline export flub always

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

55import * as Data$dMaybe from "../Data.Maybe/index.js";

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

76import * as Record$dUnsafe$dUnion from "../Record.Unsafe.Union/index.js";

87import {flubImpl} from "./foreign.js";

98const defaultOptions = {foo: 42, baz: Data$dMaybe.Nothing};

@@ -13,9 +12,6 @@ const test3 = /* #__PURE__ */ flubImpl(/* #__PURE__ */ $runtime.recordUnionMutat

1312 {foo: 99, baz: /* #__PURE__ */ Data$dMaybe.$Maybe("Just", true), bar: "Hello"},

1413 defaultOptions

1514));

16−const test4 = /* #__PURE__ */ flubImpl(/* #__PURE__ */ $runtime.recordUnionMutateLeft(

17− {foo: 99, baz: /* #__PURE__ */ Data$dMaybe.$Maybe("Just", true), bar: /* #__PURE__ */ Data$dShow.showIntImpl(42)},

18− defaultOptions

19−));

15+const test4 = /* #__PURE__ */ flubImpl(/* #__PURE__ */ $runtime.recordUnionMutateLeft({foo: 99, baz: /* #__PURE__ */ Data$dMaybe.$Maybe("Just", true), bar: "42"}, defaultOptions));

2016export {defaultOptions, test1, test2, test3, test4};

2117export * from "./foreign.js";

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

@@ -1,9 +1,8 @@

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

2−const notEq = x => y => x !== y;

32const test6 = y => !("hello" === y.bar && (!y.baz && 42 === y.foo));

43const test5 = y => 12 !== y;

54const test4 = a => a !== 12;

65const test3 = a => 12 !== a;

76const test2 = a => b => a !== b;

8−const test1 = notEq;

9−export {notEq, test1, test2, test3, test4, test5, test6};

7+const test1 = x => y => x !== y;

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

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

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

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

2+const test5 = "'w'";

3+const test4 = "\"wat\"";

4+const test3 = "true";

5+const test2 = "42.0";

6+const test1 = "42";

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

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

@@ -6,6 +6,6 @@ const test2 = () => {

66 const n = random();

77 return Effect$dConsole.log(Data$dShow.showIntImpl(n))();

88};

9−const test1 = /* #__PURE__ */ Effect$dConsole.log(/* #__PURE__ */ Data$dShow.showIntImpl(12));

9+const test1 = /* #__PURE__ */ Effect$dConsole.log("12");

1010export {test1, test2};

1111export * from "./foreign.js";

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

@@ -26,7 +26,7 @@ const rewriteBottomUpM = dictMonad => {

2626 return a => _3.bind(go(a))(k);

2727 };

2828};

29−const rewriteBottomUpM1 = k => {

29+const rewriteBottomUp = k => {

3030 const go = a => {

3131 if (a.tag === "Abs") { return $Fun("Abs", a._1, k(go(a._2))); }

3232 if (a.tag === "App") { return $Fun("App", k(go(a._1)), k(go(a._2))); }

@@ -34,8 +34,4 @@ const rewriteBottomUpM1 = k => {

3434 };

3535 return a => k(go(a));

3636};

37−const rewriteBottomUp = k => {

38− const _1 = rewriteBottomUpM1(k);

39− return x => _1(x);

40−};

41−export {$Fun, Abs, App, rewriteBottomUp, rewriteBottomUpM, rewriteBottomUpM1, traverseFun1};

37+export {$Fun, Abs, App, rewriteBottomUp, rewriteBottomUpM, traverseFun1};

backend-es/test/snapshots/Snapshot.ShowLiterals.pursnew file+9

@@ -0,0 +1,9 @@

1+module Snapshot.ShowLiterals where

3+import Prelude

5+test1 = show 42 :: String

6+test2 = show 42.0 :: String

7+test3 = show true :: String

8+test4 = show "wat" :: String

9+test5 = show 'w' :: String

backend-es/test/snapshots/Snapshot.VanLaarhovenTraversals01.purs+1−2

@@ -5,7 +5,6 @@ module Snapshot.VanLaarhovenTraversals01 where

55import Prelude

77import Data.Identity (Identity(..))

8−import Data.Newtype (un)

98import Safe.Coerce (coerce)

109

1110data Fun

@@ -25,4 +24,4 @@ rewriteBottomUpM k = k <=< go

2524 go a = traverseFun1 (k <=< go) a

2625

2726rewriteBottomUp :: (Fun -> Fun) -> Fun -> Fun

28−rewriteBottomUp k = un Identity <<< rewriteBottomUpM (coerce k)

27+rewriteBottomUp = coerce (rewriteBottomUpM :: _ -> _ -> Identity _)

src/PureScript/Backend/Optimizer/Convert.purs+11−3

@@ -239,13 +239,21 @@ toTopLevelBackendBinding group env (Binding _ ident cfn) = do

239239 { accum: env

240240 { implementations = Map.insert (Qualified (Just env.currentModule) ident) impl env.implementations

241241 , moduleImplementations = Map.insert (Qualified (Just env.currentModule) ident) impl env.moduleImplementations

242− , directives = case impl of

243− Tuple _ (ExternExpr _ (NeutralExpr (App (NeutralExpr (Var qual)) args)))

242+ , directives = case impl, backendExpr of

243+ Tuple _ (ExternExpr _ (NeutralExpr (App (NeutralExpr (Var qual)) args))), _

244244 | Just (InlineArity n) <- Map.lookup (EvalExtern qual Nothing) env.directives

245245 , arity <- NonEmptyArray.length args

246246 , arity < n ->

247247 Map.insert (EvalExtern (Qualified (Just env.currentModule) ident) Nothing) (InlineArity (n - arity)) env.directives

248− _ ->

248+ -- TODO: Ideally, we would track arity annotations as part of

249+ -- inlining to make it more reliably transitive.

250+ _, ExprSyntax _ (App (ExprSyntax _ (Var qual)) args)

251+ | Just (InlineArity n) <- Map.lookup (EvalExtern qual Nothing) env.directives

252+ , ExprApp (Ann { meta: Just IsSyntheticApp }) _ _ <- cfn

253+ , arity <- NonEmptyArray.length args

254+ , arity >= n ->

255+ Map.insert (EvalExtern (Qualified (Just env.currentModule) ident) Nothing) InlineAlways env.directives

256+ _, _ ->

249257 env.directives

250258 }

251259 , value: Tuple ident (Tuple (unwrap (fst impl)).deps expr')