Add inlining directives for data types

backend-es/test/snapshots-out/Snapshot.KnownConstructors07.js

@@ -0,0 +1,5 @@
+const test = f => y => {
+  const z = f(y);
+  return {bar: z - 2 | 0, foo: z + 1 | 0};
+};
+export {test};

backend-es/test/snapshots/Snapshot.KnownConstructor07.purs → backend-es/test/snapshots/Snapshot.KnownConstructors07.purs

@@ -1,4 +1,4 @@
-module Snapshot.KnownConstructor07 where
+module Snapshot.KnownConstructors07 where
 
 import Prelude
 

backend-es/test/snapshots/Snapshot.KnownConstructors08.purs

@@ -0,0 +1,16 @@
+-- @inline Data.Generic.Rep.Sum always
+-- @inline Data.Show.Generic.genericShowConstructor arity=2
+-- @inline export genericTest.from arity=1
+module Snapshot.KnownConstructors08 where
+
+import Prelude
+
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+
+data Test = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
+
+derive instance genericTest :: Generic Test _
+
+instance Show Test where
+  show = genericShow

src/PureScript/Backend/Optimizer/Analysis.purs

@@ -13,7 +13,7 @@ import Data.Set as Set
 import Data.String.CodeUnits as SCU
 import Data.Traversable (foldMap, foldr)
 import Data.Tuple (Tuple(..), snd)
-import PureScript.Backend.Optimizer.CoreFn (Ident, Literal(..), Qualified)
+import PureScript.Backend.Optimizer.CoreFn (Ident(..), Literal(..), ProperName(..), Qualified)
 import PureScript.Backend.Optimizer.Syntax (class HasSyntax, BackendAccessor(..), BackendOperator(..), BackendOperator1(..), BackendSyntax(..), Level, Pair(..), sndPair, syntaxOf)
 
 data Capture = CaptureNone | CaptureBranch | CaptureClosure
@@ -72,18 +72,22 @@ instance Semigroup Complexity where
 instance Monoid Complexity where
   mempty = Trivial
 
-data ResultTerm = KnownNeutral | Unknown
+data ResultTerm = Known (Maybe (Qualified Ident)) | Unknown
 
 derive instance Eq ResultTerm
 
 instance Semigroup ResultTerm where
   append = case _, _ of
     Unknown, _ -> Unknown
     _, Unknown -> Unknown
-    _, _ -> KnownNeutral
+    a@(Known (Just x)), Known (Just y) | x == y -> a
+    a@(Known (Just _)), Known Nothing -> a
+    Known Nothing, b@(Known (Just _)) -> b
+    _, _ -> mempty
+
 
 instance Monoid ResultTerm where
-  mempty = KnownNeutral
+  mempty = Known Nothing
 
 newtype BackendAnalysis = BackendAnalysis
   { usages :: Map Level Usage
@@ -118,7 +122,7 @@ instance Monoid BackendAnalysis where
     , args: []
     , rewrite: false
     , deps: Set.empty
-    , result: KnownNeutral
+    , result: mempty
     , externs: false
     }
 
@@ -244,12 +248,12 @@ analyze externAnalysis expr = case expr of
       $ bump
       $ analysisOf a
   Abs args _ ->
-    withResult KnownNeutral
+    withResult mempty
       $ complex KnownSize
       $ capture CaptureClosure
       $ foldr (boundArg <<< snd) (analyzeDefault expr) args
   UncurriedAbs args _ ->
-    withResult KnownNeutral
+    withResult mempty
       $ complex KnownSize
       $ capture CaptureClosure
       $ foldr (boundArg <<< snd) (analyzeDefault expr) args
@@ -265,7 +269,7 @@ analyze externAnalysis expr = case expr of
         $ complex NonTrivial
         $ analyzeDefault expr
   UncurriedEffectAbs args _ ->
-    withResult KnownNeutral
+    withResult mempty
       $ complex KnownSize
       $ capture CaptureClosure
       $ foldr (boundArg <<< snd) (analyzeDefault expr) args
@@ -311,8 +315,8 @@ analyze externAnalysis expr = case expr of
       withResult Unknown
         $ complex NonTrivial
         $ analyzeDefault expr
-  CtorSaturated qi _ _ _ cs ->
-    withResult KnownNeutral
+  CtorSaturated qi _ (ProperName tyIdent) _ cs ->
+    withResult (Known (Just (qi $> Ident tyIdent)))
       $ bump
       $ usedDep qi
       $ foldMap (foldMap analysisOf) cs
@@ -387,7 +391,7 @@ analyze externAnalysis expr = case expr of
         analysis
     where
     analysis =
-      withResult KnownNeutral
+      withResult mempty
         $ analyzeDefault expr
 
 analyzeEffectBlock :: forall a. HasAnalysis a => HasSyntax a => (Qualified Ident -> Maybe String -> Maybe BackendAnalysis) -> BackendSyntax a -> BackendAnalysis

src/PureScript/Backend/Optimizer/Convert.purs

@@ -370,6 +370,7 @@ getCtx env = Ctx
           else
             analyze lookupExtern expr
   , effect: false
+  , directives: env.directives
   }
   where
   lookupExtern qual acc = do

src/PureScript/Backend/Optimizer/Directives.purs

@@ -111,6 +111,8 @@ qualified :: Parser (Qualified Ident)
 qualified = expectMap case _ of
   { value: CST.TokLowerName (Just (CST.ModuleName mod)) ident } ->
     Just $ Qualified (Just (ModuleName mod)) (Ident ident)
+  { value: CST.TokUpperName (Just (CST.ModuleName mod)) ident } ->
+    Just $ Qualified (Just (ModuleName mod)) (Ident ident)
   _ ->
     Nothing
 

src/PureScript/Backend/Optimizer/Semantics.purs

@@ -1155,6 +1155,7 @@ newtype Ctx = Ctx
   , lookupExtern :: Qualified Ident -> Maybe String -> Maybe BackendAnalysis
   , analyze :: Ctx -> BackendSyntax BackendExpr -> BackendAnalysis
   , effect :: Boolean
+  , directives :: InlineDirectiveMap
   }
 
 nextLevel :: Ctx -> Tuple Level Ctx
@@ -1300,7 +1301,7 @@ build ctx = case _ of
         expr
     | Just expr <- shouldUnpackArray ident level binding body ->
         expr
-    | Just expr <- shouldDistributeBranches ident level binding body ->
+    | Just expr <- shouldDistributeBranches ctx ident level binding body ->
         expr
     | Just expr <- shouldEtaReduce level binding body ->
         expr
@@ -1497,13 +1498,18 @@ shouldUnpackArray ident level binding body = do
     _ ->
       Nothing
 
-shouldDistributeBranches :: Maybe Ident -> Level -> BackendExpr -> BackendExpr -> Maybe BackendExpr
-shouldDistributeBranches ident level a body = do
+shouldDistributeBranches :: Ctx -> Maybe Ident -> Level -> BackendExpr -> BackendExpr -> Maybe BackendExpr
+shouldDistributeBranches (Ctx ctx) ident level a body = do
   let BackendAnalysis s2 = analysisOf body
   case a of
     ExprSyntax (BackendAnalysis s1) (Branch branches def)
+      | Known (Just qi) <- s1.result
+      , Just InlineAlways <- Map.lookup (EvalExtern qi) ctx.directives >>= Map.lookup InlineRef -> do
+          -- TODO: Not sure what to do about analysis, or if it matters.
+          let analysis = analysisOf a <> bound level (analysisOf body)
+          Just $ ExprRewrite (withRewrite analysis) $ RewriteDistBranchesLet ident level branches def body
       | s2.size <= 128
-      , s1.result == KnownNeutral
+      , s1.result == Known Nothing
       , Just (Usage us) <- Map.lookup level s2.usages
       , us.total == us.access + us.case -> do
           -- TODO: Not sure what to do about analysis, or if it matters.