purescript-lua · Unisay · Mar 29, 2023 · Mar 28, 2023 · Mar 29, 2023
diff --git a/lib/Language/PureScript/Backend.hs b/lib/Language/PureScript/Backend.hs
@@ -82,10 +82,10 @@ compileModules outputDir foreignDir appOrModule = do
   dceStrategy =
     case appOrModule of
       AsApplication (AppEntryPoint modul entryIdent) ->
-        DCE.PreserveSpecified $
+        DCE.EntryPoints $
           NE.singleton
             ( IR.mkModuleName modul
             , NE.singleton (IR.identToName entryIdent)
             )
       AsModule (ModuleEntryPoint modul) ->
-        DCE.PreserveModuleTopLevel (NE.singleton (IR.mkModuleName modul))
+        DCE.EntryPointsSomeModules (NE.singleton (IR.mkModuleName modul))
diff --git a/lib/Language/PureScript/Backend/IR/DCE.hs b/lib/Language/PureScript/Backend/IR/DCE.hs
@@ -35,9 +35,9 @@ import Language.PureScript.Backend.IR.Types
 import Relude.Unsafe qualified as Unsafe
 
 data Strategy
-  = PreserveSpecified (NonEmpty (ModuleName, NonEmpty Name))
-  | PreserveModuleTopLevel (NonEmpty ModuleName)
-  | PreserveAllTopLevel
+  = EntryPoints (NonEmpty (ModuleName, NonEmpty Name))
+  | EntryPointsSomeModules (NonEmpty ModuleName)
+  | EntryPointsAllModules
   deriving stock (Show)
 
 eliminateDeadCode :: Strategy -> [Module] -> [Module]
@@ -62,11 +62,15 @@ eliminateDeadCode strategy modules = uncurry dceModule <$> reachableByModule
    where
     entryPoints :: [(ModuleName, [Name])]
     entryPoints = case strategy of
-      PreserveSpecified points -> toList (toList <<$>> points)
-      PreserveAllTopLevel -> (moduleName &&& topLevelNames) <$> modules
-      PreserveModuleTopLevel moduleNames ->
-        modules >>= \m@Module {moduleName = name} ->
-          guard (name `elem` moduleNames) $> (name, topLevelNames m)
+      EntryPoints points -> toList (toList <<$>> points)
+      EntryPointsAllModules -> moduleEntryPoints <$> modules
+      EntryPointsSomeModules modulesNames ->
+        moduleEntryPoints
+          <$> filter (moduleName >>> (`elem` modulesNames)) modules
+
+    moduleEntryPoints :: Module -> (ModuleName, [Name])
+    moduleEntryPoints Module {..} =
+      (moduleName, moduleForeigns <> (moduleBindings >>= bindingNames))
 
   (graph, vertexToV, keyToVertex) = buildGraph modules
 
@@ -118,15 +122,6 @@ eliminateDeadCode strategy modules = uncurry dceModule <$> reachableByModule
       reachableQNames :: [QName] =
         [n | (_, qname, deps) <- adjacencies, n <- qname : deps]
 
-topLevelNames :: Module -> [Name]
-topLevelNames Module {moduleBindings, moduleForeigns} =
-  moduleForeigns <> namesFroBindings
- where
-  namesFroBindings =
-    moduleBindings >>= \case
-      Standalone (name, _) -> [name]
-      RecursiveGroup bindings -> fst <$> toList bindings
-
 type QName = (ModuleName, Name)
 
 data Node

diff --git a/test/Language/PureScript/Backend/IR/DCESpec.hs b/test/Language/PureScript/Backend/IR/DCESpec.hs
@@ -18,7 +18,7 @@ import Test.Hspec.Hedgehog.Extended (test)
 spec :: Spec
 spec = describe "IR Dead Code Elimination" do
   test "test not eliminate a module with an exported entry point" do
-    let strategy = PreserveSpecified $ NE.singleton mainEntryPoint
+    let strategy = EntryPoints $ NE.singleton mainEntryPoint
     [entryPointModule] === eliminateDeadCode strategy [entryPointModule]
 
   test "eliminates unused non-exported binding" do
@@ -27,7 +27,7 @@ spec = describe "IR Dead Code Elimination" do
             { moduleBindings =
                 binding_ "unused" : moduleBindings entryPointModule
             }
-        strategy = PreserveSpecified $ NE.singleton mainEntryPoint
+        strategy = EntryPoints $ NE.singleton mainEntryPoint
     [entryModule {moduleBindings = [binding_ "main"]}]
       === eliminateDeadCode strategy [entryModule]
 
@@ -47,7 +47,7 @@ spec = describe "IR Dead Code Elimination" do
           , moduleBindings = [b]
           , moduleExports = [name]
           }
-      strategy = PreserveSpecified $ NE.singleton mainEntryPoint
+      strategy = EntryPoints $ NE.singleton mainEntryPoint
 
     [entryModule, otherModule]
       === eliminateDeadCode strategy [entryModule, otherModule]
@@ -66,7 +66,7 @@ spec = describe "IR Dead Code Elimination" do
             , moduleBindings = [binding_ "foo"]
             , moduleExports = [Name "foo"]
             }
-        strategy = PreserveSpecified $ NE.singleton mainEntryPoint
+        strategy = EntryPoints $ NE.singleton mainEntryPoint
     [entryModule]
       === eliminateDeadCode strategy [entryModule, otherModule]
 

diff --git a/test/Language/PureScript/Backend/Lua/GoldenSpec.hs b/test/Language/PureScript/Backend/Lua/GoldenSpec.hs
@@ -5,6 +5,7 @@ module Language.PureScript.Backend.Lua.GoldenSpec where
 
 import Control.Monad.Oops qualified as Oops
 import Data.List qualified as List
+import Data.List.NonEmpty qualified as NE
 import Data.String qualified as String
 import Data.Tagged (Tagged (..))
 import Data.Text qualified as Text
@@ -73,7 +74,7 @@ spec = do
                 [ "purs"
                 , "compile"
                 , "-v"
-                , "'golden/Golden/*.purs'"
+                , "'golden/Golden/**/*.purs'"
                 , "'src/**/*.purs'"
                 , -- , "'.spago/prelude/v6.0.0/src/**/*.purs'"
                   "-g"
@@ -169,7 +170,8 @@ compileCorefn outputDir moduleName = do
       & Oops.runOops
       & liftIO
 
-  optimizeAll DCE.PreserveAllTopLevel
+  let irModuleName = IR.mkModuleName moduleName
+  optimizeAll (DCE.EntryPointsSomeModules (NE.singleton irModuleName))
     <$> traverse
       (either (fail . show) (pure . snd) . IR.mkModule)
       (toList cfnModules)

diff --git a/test/ps/golden/Golden/Reexport/Exports.purs b/test/ps/golden/Golden/Reexport/Exports.purs
@@ -0,0 +1,4 @@
+module Golden.Reexport.Exports (binding1) where
+
+binding1 :: Int
+binding1 = 1
diff --git a/test/ps/golden/Golden/Reexport/ReExports.purs b/test/ps/golden/Golden/Reexport/ReExports.purs
@@ -0,0 +1,9 @@
+module Golden.Reexport.ReExports
+  ( module Reexported
+  , binding2
+  ) where
+
+import Golden.Reexport.Exports (binding1) as Reexported
+
+binding2 :: Int
+binding2 = 2
diff --git a/test/ps/golden/Golden/TestReexport.purs b/test/ps/golden/Golden/TestReexport.purs
@@ -0,0 +1,6 @@
+module Golden.TestReexport where
+
+import Golden.Reexport.ReExports
+
+binding3 :: Array Int
+binding3 = [ binding1 , binding2 ]
diff --git a/test/ps/output/Golden.Reexport.Exports/corefn.json b/test/ps/output/Golden.Reexport.Exports/corefn.json
@@ -0,0 +1 @@
+{"builtWith":"0.15.7","comments":[],"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[3,16],"start":[3,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,13],"start":[4,12]}},"type":"Literal","value":{"literalType":"IntLiteral","value":1}},"identifier":"binding1"}],"exports":["binding1"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,13],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Golden","Reexport","Exports"],"modulePath":"golden/Golden/Reexport/Exports.purs","reExports":{},"sourceSpan":{"end":[4,13],"start":[1,1]}}
diff --git a/test/ps/output/Golden.Reexport.Exports/golden.ir b/test/ps/output/Golden.Reexport.Exports/golden.ir
@@ -0,0 +1,14 @@
+[Module
+   {moduleName = ModuleName "Golden.Reexport.Exports",
+    moduleBindings =
+      [Standalone
+         (Name "binding1",
+          Exp
+            {unExp = Lit (Integer 1),
+             expInfo = Info {refsFree = []}})],
+    moduleImports = [],
+    moduleExports = [Name "binding1"],
+    moduleReExports = fromList [],
+    moduleForeigns = [],
+    modulePath = "golden/Golden/Reexport/Exports.purs",
+    dataTypes = fromList []}]
diff --git a/test/ps/output/Golden.Reexport.Exports/golden.lua b/test/ps/output/Golden.Reexport.Exports/golden.lua
@@ -0,0 +1,4 @@
+local Golden_Reexport_Exports = (function()
+  local binding1 = 1
+  return { binding1 = binding1 }
+end)()
diff --git a/test/ps/output/Golden.Reexport.ReExports/corefn.json b/test/ps/output/Golden.Reexport.ReExports/corefn.json
@@ -0,0 +1 @@
+{"builtWith":"0.15.7","comments":[],"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[8,16],"start":[8,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[9,13],"start":[9,12]}},"type":"Literal","value":{"literalType":"IntLiteral","value":2}},"identifier":"binding2"}],"exports":["binding2"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[6,56],"start":[6,1]}},"moduleName":["Golden","Reexport","Exports"]},{"annotation":{"meta":null,"sourceSpan":{"end":[9,13],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Golden","Reexport","ReExports"],"modulePath":"golden/Golden/Reexport/ReExports.purs","reExports":{"Golden.Reexport.Exports":["binding1"]},"sourceSpan":{"end":[9,13],"start":[1,1]}}
diff --git a/test/ps/output/Golden.Reexport.ReExports/golden.ir b/test/ps/output/Golden.Reexport.ReExports/golden.ir
@@ -0,0 +1,16 @@
+[Module
+   {moduleName = ModuleName "Golden.Reexport.ReExports",
+    moduleBindings =
+      [Standalone
+         (Name "binding2",
+          Exp
+            {unExp = Lit (Integer 2),
+             expInfo = Info {refsFree = []}})],
+    moduleImports = [],
+    moduleExports = [Name "binding2"],
+    moduleReExports =
+      fromList
+        [(ModuleName "Golden.Reexport.Exports", [])],
+    moduleForeigns = [],
+    modulePath = "golden/Golden/Reexport/ReExports.purs",
+    dataTypes = fromList []}]
diff --git a/test/ps/output/Golden.Reexport.ReExports/golden.lua b/test/ps/output/Golden.Reexport.ReExports/golden.lua
@@ -0,0 +1,4 @@
+local Golden_Reexport_ReExports = (function()
+  local binding2 = 2
+  return { binding2 = binding2 }
+end)()
diff --git a/test/ps/output/Golden.TestCaseStatements/golden.ir b/test/ps/output/Golden.TestCaseStatements/golden.ir
@@ -2106,11 +2106,6 @@
    {moduleName = ModuleName "Golden.TestValues",
     moduleBindings =
       [Standalone
-         (Name "i",
-          Exp
-            {unExp = Lit (Integer 1),
-             expInfo = Info {refsFree = []}}),
-       Standalone
          (Name "f",
           Exp
             {unExp =
@@ -2120,65 +2115,9 @@
                     (Exp
                        {unExp = Lit (Boolean True),
                         expInfo = Info {refsFree = []}})),
-             expInfo = Info {refsFree = []}}),
-       Standalone
-         (Name "c",
-          Exp
-            {unExp = Lit (Char 'c'),
-             expInfo = Info {refsFree = []}}),
-       Standalone
-         (Name "b",
-          Exp
-            {unExp = Lit (Boolean True),
-             expInfo = Info {refsFree = []}}),
-       Standalone
-         (Name "o",
-          Exp
-            {unExp =
-               Lit
-                 (Object
-                    [(PropName "i",
-                      Exp
-                        {unExp = RefFree (Local (Name "i")),
-                         expInfo = Info {refsFree = [Local (Name "i")]}}),
-                     (PropName "b",
-                      Exp
-                        {unExp = RefFree (Local (Name "b")),
-                         expInfo = Info {refsFree = [Local (Name "b")]}}),
-                     (PropName "c",
-                      Exp
-                        {unExp = RefFree (Local (Name "c")),
-                         expInfo = Info {refsFree = [Local (Name "c")]}})]),
-             expInfo =
-               Info
-                 {refsFree =
-                    [Local (Name "i"),
-                     Local (Name "b"),
-                     Local (Name "c")]}}),
-       Standalone
-         (Name "a",
-          Exp
-            {unExp =
-               Lit
-                 (Array
-                    [Exp
-                       {unExp = Lit (Integer 1),
-                        expInfo = Info {refsFree = []}},
-                     Exp
-                       {unExp = Lit (Integer 2),
-                        expInfo = Info {refsFree = []}},
-                     Exp
-                       {unExp = Lit (Integer 3),
-                        expInfo = Info {refsFree = []}}]),
              expInfo = Info {refsFree = []}})],
     moduleImports = [],
-    moduleExports =
-      [Name "i",
-       Name "b",
-       Name "c",
-       Name "a",
-       Name "o",
-       Name "f"],
+    moduleExports = [Name "f"],
     moduleReExports = fromList [],
     moduleForeigns = [],
     modulePath = "golden/Golden/TestValues.purs",

diff --git a/test/ps/output/Golden.TestCaseStatements/golden.lua b/test/ps/output/Golden.TestCaseStatements/golden.lua
@@ -1,11 +1,6 @@
 local Golden_TestValues = (function()
-  local i = 1
   local f = function() return true end
-  local c = "c"
-  local b = true
-  local o = { i = i, b = b, c = c }
-  local a = { 1, 2, 3 }
-  return { i = i, b = b, c = c, a = a, o = o, f = f }
+  return { f = f }
 end)()
 local Golden_TestCaseStatements = (function()
   local J = function(value0)
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		{"builtWith":"0.15.7","comments":[],"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[3,16],"start":[3,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,13],"start":[4,12]}},"type":"Literal","value":{"literalType":"IntLiteral","value":1}},"identifier":"binding1"}],"exports":["binding1"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,13],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Golden","Reexport","Exports"],"modulePath":"golden/Golden/Reexport/Exports.purs","reExports":{},"sourceSpan":{"end":[4,13],"start":[1,1]}}