Eliminate unused foreign declarations

Author: Unisay

lib/Language/PureScript/Backend/IR/DCE.hs

@@ -41,7 +41,17 @@ eliminateDeadCode uber@UberModule {..} =
     }
  where
   preservedForeigns ∷ [(ModuleName, FilePath, NonEmpty Name)]
-  preservedForeigns = uberModuleForeigns
+  preservedForeigns = do
+    (modname, path, foreignNames) ← annotatedForeigns
+    case NE.nonEmpty (preservedNames foreignNames) of
+      Nothing → []
+      Just names → [(modname, path, names)]
+   where
+    preservedNames ∷ [(Id, Name)] → [Name]
+    preservedNames foreignNames = do
+      (idName, foreignName) ← foreignNames
+      guard $ idName `Set.member` reachableIds
+      pure foreignName
 
   preserveBindings ∷ [Grouping (QName, Exp)]
   preserveBindings = do
@@ -68,12 +78,15 @@ eliminateDeadCode uber@UberModule {..} =
 
   annotatedExports ∷ [(Id, Name, AExp)]
   annotatedBindings ∷ [Grouping (Id, QName, AExp)]
-  (annotatedExports, annotatedBindings) = runAnnM do
+  annotatedForeigns ∷ [(ModuleName, FilePath, [(Id, Name)])]
+  (annotatedExports, annotatedBindings, annotatedForeigns) = runAnnM do
     annExports ← forM uberModuleExports \(name, expr) →
       (,name,) <$> nextId <*> annotateExp expr
     annBindings ← forM uberModuleBindings $ traverse \(qname, expr) →
       (,qname,) <$> nextId <*> annotateExp expr
-    pure (annExports, annBindings)
+    annForeignNames ← forM uberModuleForeigns \(modname, path, names) →
+      (modname,path,) <$> forM (toList names) \name → fmap (,name) nextId
+    pure (annExports, annBindings, annForeignNames)
 
   dceAnnotatedExp ∷ AExp → Exp
   dceAnnotatedExp =
@@ -128,7 +141,15 @@ eliminateDeadCode uber@UberModule {..} =
 
   adjacencyList ∷ [((), Id, [Id])]
   adjacencyList =
-    DL.toList $ adjacencyListFromExports <> adjacencyListFromBindings
+    DL.toList $
+      adjacencyListFromExports
+        <> adjacencyListFromBindings
+        <> adjacencyListFromForeigns
+
+  adjacencyListFromExports ∷ DList ((), Id, [Id])
+  adjacencyListFromExports =
+    annotatedExports & foldMap \(nodeId, _name, expr) →
+      adjacencyListFromExport nodeId expr
 
   adjacencyListFromBindings ∷ DList ((), Id, [Id])
   adjacencyListFromBindings =
@@ -139,18 +160,22 @@ eliminateDeadCode uber@UberModule {..} =
         recBinds & foldMap \(nodeId, _qname, expr) →
           adjacencyListForExpr bindingsInScope (nodeId, expr)
 
-  adjacencyListFromExports ∷ DList ((), Id, [Id])
-  adjacencyListFromExports =
-    annotatedExports & foldMap \(nodeId, _name, expr) →
-      adjacencyListFromExport nodeId expr
+  adjacencyListFromForeigns ∷ DList ((), Id, [Id])
+  adjacencyListFromForeigns =
+    annotatedForeigns & foldMap \(_modname, _path, names) →
+      DL.fromList (((),,[]) . fst <$> names)
 
   bindingsInScope ∷ Map (Qualified Name, Index) Id
   bindingsInScope =
-    Map.fromList
-      [ ((Imported m name, 0), bindId)
+    Map.fromList $
+      [ ((Imported modname name, 0), bindId)
       | grouping ← annotatedBindings
-      , (bindId, QName m name, _boundExpr) ← listGrouping grouping
+      , (bindId, QName modname name, _boundExpr) ← listGrouping grouping
       ]
+        <> [ ((Imported modname name, 0), foreignNameId)
+           | (modname, _path, foreignNames) ← annotatedForeigns
+           , (foreignNameId, name) ← foreignNames
+           ]
 
   adjacencyListFromExport ∷ Id → AExp → DList ((), Id, [Id])
   adjacencyListFromExport = curry (adjacencyListForExpr bindingsInScope)

test/ps/output/Golden.TestHelloPrelude/golden.ir

@@ -344,50 +344,9 @@ UberModule
       )
     ], uberModuleForeigns =
     [
-      ( ModuleName "Data.Symbol", ".spago/prelude/v6.0.3/src/Data/Symbol.purs", Name "unsafeCoerce" :| []
-      ),
       ( ModuleName "Data.Unit", ".spago/prelude/v6.0.3/src/Data/Unit.purs", Name "unit" :| [] ),
-      ( ModuleName "Record.Unsafe", ".spago/prelude/v6.0.3/src/Record/Unsafe.purs", Name "unsafeHas" :|
-        [ Name "unsafeGet", Name "unsafeSet", Name "unsafeDelete" ]
-      ),
-      ( ModuleName "Data.HeytingAlgebra", ".spago/prelude/v6.0.3/src/Data/HeytingAlgebra.purs", Name "boolConj" :|
-        [ Name "boolDisj", Name "boolNot" ]
-      ),
-      ( ModuleName "Data.Eq", ".spago/prelude/v6.0.3/src/Data/Eq.purs", Name "eqBooleanImpl" :|
-        [ Name "eqIntImpl", Name "eqNumberImpl", Name "eqCharImpl", Name "eqStringImpl", Name "eqArrayImpl"
-        ]
-      ),
-      ( ModuleName "Data.Semigroup", ".spago/prelude/v6.0.3/src/Data/Semigroup.purs", Name "concatString" :|
-        [ Name "concatArray" ]
-      ),
-      ( ModuleName "Data.Show", ".spago/prelude/v6.0.3/src/Data/Show.purs", Name "showIntImpl" :|
-        [ Name "showNumberImpl", Name "showCharImpl", Name "showStringImpl", Name "showArrayImpl" ]
-      ),
-      ( ModuleName "Data.Semiring", ".spago/prelude/v6.0.3/src/Data/Semiring.purs", Name "intAdd" :|
-        [ Name "intMul", Name "numAdd", Name "numMul" ]
-      ),
-      ( ModuleName "Data.Ring", ".spago/prelude/v6.0.3/src/Data/Ring.purs", Name "intSub" :|
-        [ Name "numSub" ]
-      ),
-      ( ModuleName "Data.Ord", ".spago/prelude/v6.0.3/src/Data/Ord.purs", Name "ordBooleanImpl" :|
-        [ Name "ordIntImpl", Name "ordNumberImpl", Name "ordStringImpl", Name "ordCharImpl", Name "ordArrayImpl"
-        ]
-      ),
-      ( ModuleName "Data.Functor", ".spago/prelude/v6.0.3/src/Data/Functor.purs", Name "arrayMap" :| []
-      ),
-      ( ModuleName "Control.Apply", ".spago/prelude/v6.0.3/src/Control/Apply.purs", Name "arrayApply" :| []
-      ),
-      ( ModuleName "Control.Bind", ".spago/prelude/v6.0.3/src/Control/Bind.purs", Name "arrayBind" :| []
-      ),
-      ( ModuleName "Data.Bounded", ".spago/prelude/v6.0.3/src/Data/Bounded.purs", Name "topInt" :|
-        [ Name "bottomInt", Name "topChar", Name "bottomChar", Name "topNumber", Name "bottomNumber"
-        ]
-      ),
-      ( ModuleName "Data.EuclideanRing", ".spago/prelude/v6.0.3/src/Data/EuclideanRing.purs", Name "intDegree" :|
-        [ Name "intDiv", Name "intMod", Name "numDiv" ]
-      ),
       ( ModuleName "Effect", ".spago/effect/v4.0.0/src/Effect.purs", Name "pureE" :|
-        [ Name "bindE", Name "untilE", Name "whileE", Name "forE", Name "foreachE" ]
+        [ Name "bindE" ]
       )
     ], uberModuleExports =
     [