[Git][ghc/ghc][wip/js-staging] 2 commits: Linker: refactor and cleanup after compactor removal

Sylvain Henry (@hsyl20) gitlab at gitlab.haskell.org
Fri Oct 14 13:17:57 UTC 2022



Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC


Commits:
21f88955 by Sylvain Henry at 2022-10-14T15:12:12+02:00
Linker: refactor and cleanup after compactor removal

- - - - -
18a51ca6 by Sylvain Henry at 2022-10-14T15:15:06+02:00
Filter empty exports to avoid printing a lot of useless newlines

- - - - -


3 changed files:

- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/StgToJS/Linker/Types.hs
- compiler/ghc.cabal.in


Changes:

=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -50,8 +50,6 @@ import GHC.StgToJS.Printer
 import GHC.StgToJS.Arg
 import GHC.StgToJS.Closure
 
-import GHC.Types.Unique.Map
-
 import GHC.Unit.State
 import GHC.Unit.Env
 import GHC.Unit.Home
@@ -67,9 +65,6 @@ import GHC.Utils.Binary
 import qualified GHC.Utils.Ppr as Ppr
 import GHC.Utils.Monad
 import GHC.Utils.TmpFs
-import GHC.Utils.Misc
-import GHC.Utils.Monad.State.Strict (State, runState)
-import qualified GHC.Utils.Monad.State.Strict as State
 
 import qualified GHC.SysTools.Ar          as Ar
 
@@ -172,9 +167,8 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex
       mods <- collectDeps dep_map dep_units all_deps
 
       -- LTO + rendering of JS code
-      link_stats <- withBinaryFile (out </> "out.js") WriteMode $ \h -> do
-        (_compactorState, stats) <- renderLinker cfg h emptyCompactorState mods jsFiles
-        pure stats
+      link_stats <- withBinaryFile (out </> "out.js") WriteMode $ \h ->
+        renderLinker h mods jsFiles
 
       -------------------------------------------------------------
 
@@ -280,33 +274,36 @@ computeLinkDependencies cfg logger target unit_env units objFiles extraStaticDep
   return (dep_map, dep_units, all_deps, rts_wired_functions, dep_archives)
 
 
+-- | Compiled module
 data ModuleCode = ModuleCode
   { mc_module   :: !Module
-  , mc_js_code  :: JStat
+  , mc_js_code  :: !JStat
   , mc_exports  :: !B.ByteString        -- ^ rendered exports
   , mc_closures :: ![ClosureInfo]
   , mc_statics  :: ![StaticInfo]
   , mc_frefs    :: ![ForeignJSRef]
   }
 
+-- | ModuleCode after link with other modules.
+--
+-- It contains less information than ModuleCode because they have been commoned
+-- up into global "metadata" for the whole link.
+data CompactedModuleCode = CompactedModuleCode
+  { cmc_module  :: !Module
+  , cmc_js_code :: !JStat
+  , cmc_exports :: !B.ByteString        -- ^ rendered exports
+  }
+
+-- | Link modules and pretty-print them into the given Handle
 renderLinker
-  :: StgToJSConfig
-  -> Handle
-  -> CompactorState
+  :: Handle
   -> [ModuleCode] -- ^ linked code per module
   -> [FilePath]   -- ^ additional JS files
-  -> IO (CompactorState, LinkerStats)
-renderLinker cfg h renamer_state mods jsFiles = do
-
-  -- extract ModuleCode fields required to make a LinkedUnit
-  let code_to_linked_unit c = LinkedUnit
-        { lu_js_code  = mc_js_code c
-        , lu_closures = mc_closures c
-        , lu_statics  = mc_statics c
-        }
+  -> IO LinkerStats
+renderLinker h mods jsFiles = do
 
-  -- call the compactor
-  let (renamer_state', compacted, meta) = rename cfg renamer_state (map code_to_linked_unit mods)
+  -- link modules
+  let (compacted_mods, meta) = linkModules mods
 
   let
     putBS   = B.hPut h
@@ -325,16 +322,16 @@ renderLinker cfg h renamer_state mods jsFiles = do
   -- file.
 
   -- modules themselves
-  mod_sizes <- forM (mods `zip` compacted) $ \(mod,compacted_mod) -> do
-    !mod_size <- fromIntegral <$> putJS compacted_mod
-    let !mod_mod  = mc_module mod
+  mod_sizes <- forM compacted_mods $ \m -> do
+    !mod_size <- fromIntegral <$> putJS (cmc_js_code m)
+    let !mod_mod  = cmc_module m
     pure (mod_mod, mod_size)
 
-  -- metadata
+  -- commoned up metadata
   !meta_length <- fromIntegral <$> putJS meta
 
-  -- exports
-  mapM_ (putBS . mc_exports) mods
+  -- module exports
+  mapM_ (putBS . cmc_exports) compacted_mods
 
   -- explicit additional JS files
   mapM_ (\i -> B.readFile i >>= putBS) jsFiles
@@ -345,7 +342,7 @@ renderLinker cfg h renamer_state mods jsFiles = do
         , packedMetaDataSize = meta_length
         }
 
-  pure (renamer_state', link_stats)
+  pure link_stats
 
 -- | Render linker stats
 renderLinkerStats :: LinkerStats -> String
@@ -568,11 +565,12 @@ extractDeps ar_state units deps loc =
   where
     mod           = depsModule deps
     newline       = BC.pack "\n"
-    unlines'      = intersperse newline . map oiRaw
+    mk_exports    = mconcat . intersperse newline . filter (not . BS.null) . map oiRaw
+    mk_js_code    = mconcat . map oiStat
     collectCode l = ModuleCode
                       { mc_module   = mod
-                      , mc_js_code  = mconcat (map oiStat l)
-                      , mc_exports  = mconcat (unlines' l)
+                      , mc_js_code  = mk_js_code l
+                      , mc_exports  = mk_exports l
                       , mc_closures = concatMap oiClInfo l
                       , mc_statics  = concatMap oiStatic l
                       , mc_frefs    = concatMap oiFImports l
@@ -865,96 +863,68 @@ jsFileNeedsCpp fn = do
   opts <- getOptionsFromJsFile fn
   pure (CPP `elem` opts)
 
-rename :: StgToJSConfig
-       -> CompactorState
-       -> [LinkedUnit]
-       -> (CompactorState, [JStat], JStat)
-rename cfg cs0 input0
-  = renameInternals cfg cs0 input0
-
-renameInternals :: HasDebugCallStack
-                => StgToJSConfig
-                -> CompactorState
-                -> [LinkedUnit]
-                -> (CompactorState, [JStat], JStat)
-renameInternals cfg cs0 stats0a = (cs, stats, meta)
+-- | Link module codes.
+--
+-- Performs link time optimizations and produces one JStat per module plus some
+-- commoned up initialization code.
+linkModules :: [ModuleCode] -> ([CompactedModuleCode], JStat)
+linkModules mods = (compact_mods, meta)
   where
-    (stbs, stats0) = (mempty, stats0a)
-    ((stats, meta), cs) = runState renamed cs0
-
-    renamed :: State CompactorState ([JStat], JStat)
-    renamed
-
-      | True = do
-        cs <- State.get
-        let renamedStats = map (identsS' (lookupRenamed cs) . lu_js_code) stats0
-            statics      = map (renameStaticInfo cs)  $
-                               concatMap lu_statics stats0
-            infos        = map (renameClosureInfo cs) $
-                               concatMap lu_closures stats0
+    compact_mods = map compact mods
+
+    -- here GHCJS used to:
+    --  - deduplicate declarations
+    --  - rename local variables into shorter ones
+    --  - compress initialization data
+    -- but we haven't ported it (yet).
+
+    compact m = CompactedModuleCode
+      { cmc_js_code = mc_js_code m
+      , cmc_module  = mc_module m
+      , cmc_exports = mc_exports m
+      }
+
+    statics = concatMap mc_statics  mods
+    infos   = concatMap mc_closures mods
+    meta = mconcat
             -- render metadata as individual statements
-            meta = mconcat (map staticDeclStat statics) <>
-                   identsS' (lookupRenamed cs) stbs <>
-                   mconcat (map (staticInitStat $ csProf cfg) statics) <>
-                   mconcat (map (closureInfoStat True) infos)
-        return (renamedStats, meta)
-
-lookupRenamed :: CompactorState -> Ident -> Ident
-lookupRenamed cs i@(TxtI t) =
-  fromMaybe i (lookupUniqMap (csNameMap cs) t)
-
--- | rename a compactor info entry according to the compactor state (no new renamings are added)
-renameClosureInfo :: CompactorState
-                  -> ClosureInfo
-                  -> ClosureInfo
-renameClosureInfo cs (ClosureInfo v rs n l t s)  =
-  ClosureInfo (renameV v) rs n l t (f s)
-    where
-      renameV t = maybe t itxt (lookupUniqMap m t)
-      m                   = csNameMap cs
-      f (CIStaticRefs rs) = CIStaticRefs (map renameV rs)
-
--- | rename a static info entry according to the compactor state (no new renamings are added)
-renameStaticInfo :: CompactorState
-                 -> StaticInfo
-                 -> StaticInfo
-renameStaticInfo cs = staticIdents renameIdent
-  where
-    renameIdent t = maybe t itxt (lookupUniqMap (csNameMap cs) t)
-
--- | initialize a global object. all global objects have to be declared (staticInfoDecl) first
---   (this is only used with -debug, normal init would go through the static data table)
-staticInitStat :: Bool         -- ^ profiling enabled
-               -> StaticInfo
-               -> JStat
-staticInitStat _prof (StaticInfo i sv cc) =
+            [ mconcat (map staticDeclStat statics)
+            , mconcat (map staticInitStat statics)
+            , mconcat (map (closureInfoStat True) infos)
+            ]
+
+-- | Initialize a global object.
+--
+-- All global objects have to be declared (staticInfoDecl) first.
+staticInitStat :: StaticInfo -> JStat
+staticInitStat (StaticInfo i sv mcc) =
   case sv of
-    StaticData con args -> appS "h$sti" ([var i, var con, jsStaticArgs args] ++ ccArg)
-    StaticFun  f   args -> appS "h$sti" ([var i, var f, jsStaticArgs args] ++ ccArg)
-    StaticList args mt   ->
-      appS "h$stl" ([var i, jsStaticArgs args, toJExpr $ maybe null_ (toJExpr . TxtI) mt] ++ ccArg)
-    StaticThunk (Just (f,args)) ->
-      appS "h$stc" ([var i, var f, jsStaticArgs args] ++ ccArg)
-    _                    -> mempty
+    StaticData con args         -> appS "h$sti" $ add_cc_arg
+                                    [ var i
+                                    , var con
+                                    , jsStaticArgs args
+                                    ]
+    StaticFun  f   args         -> appS "h$sti" $ add_cc_arg
+                                    [ var i
+                                    , var f
+                                    , jsStaticArgs args
+                                    ]
+    StaticList args mt          -> appS "h$stl" $ add_cc_arg
+                                    [ var i
+                                    , jsStaticArgs args
+                                    , toJExpr $ maybe null_ (toJExpr . TxtI) mt
+                                    ]
+    StaticThunk (Just (f,args)) -> appS "h$stc" $ add_cc_arg
+                                    [ var i
+                                    , var f
+                                    , jsStaticArgs args
+                                    ]
+    _                           -> mempty
   where
-    ccArg = maybeToList (fmap toJExpr cc)
-
-staticIdents :: (FastString -> FastString)
-             -> StaticInfo
-             -> StaticInfo
-staticIdents f (StaticInfo i v cc) = StaticInfo (f i) (staticIdentsV f v) cc
-
-staticIdentsV ::(FastString -> FastString) -> StaticVal -> StaticVal
-staticIdentsV f (StaticFun i args) = StaticFun (f i) (staticIdentsA f <$> args)
-staticIdentsV f (StaticThunk (Just (i, args))) = StaticThunk . Just $
-                                                 (f i, staticIdentsA f <$> args)
-staticIdentsV f (StaticData con args) = StaticData (f con) (staticIdentsA f <$> args)
-staticIdentsV f (StaticList xs t)              = StaticList (staticIdentsA f <$> xs) (f <$> t)
-staticIdentsV _ x                              = x
-
-staticIdentsA :: (FastString -> FastString) -> StaticArg -> StaticArg
-staticIdentsA f (StaticObjArg t) = StaticObjArg $! f t
-staticIdentsA _ x = x
+    -- add optional cost-center argument
+    add_cc_arg as = case mcc of
+      Nothing -> as
+      Just cc -> as ++ [toJExpr cc]
 
 -- | declare and do first-pass init of a global object (create JS object for heap objects)
 staticDeclStat :: StaticInfo -> JStat
@@ -977,42 +947,3 @@ staticDeclStat (StaticInfo global_name static_value _) = decl
       StaticUnboxedStringOffset {} -> 0
 
     to_byte_list = JList . map (Int . fromIntegral) . BS.unpack
-
-identsE' :: (Ident -> Ident) -> JExpr -> JExpr
-identsE' f (ValExpr v)         = ValExpr     $! identsV' f v
-identsE' f (SelExpr e i)       = SelExpr     (identsE' f e) i -- do not rename properties
-identsE' f (IdxExpr e1 e2)     = IdxExpr     (identsE' f e1) (identsE' f e2)
-identsE' f (InfixExpr s e1 e2) = InfixExpr s  (identsE' f e1) (identsE' f e2)
-identsE' f (UOpExpr o e)       = UOpExpr o   $! identsE' f e
-identsE' f (IfExpr e1 e2 e3)   = IfExpr      (identsE' f e1) (identsE' f e2) (identsE' f e3)
-identsE' f (ApplExpr e es)     = ApplExpr    (identsE' f e)  (identsE' f <$> es)
-identsE' _ UnsatExpr{}         = error "identsE': UnsatExpr"
-
-identsV' :: (Ident -> Ident) -> JVal -> JVal
-identsV' f (JVar i)       = JVar  $! f i
-identsV' f (JList xs)     = JList $! (fmap . identsE') f xs
-identsV' _ d at JDouble{}    = d
-identsV' _ i at JInt{}       = i
-identsV' _ s at JStr{}       = s
-identsV' _ r at JRegEx{}     = r
-identsV' f (JHash m)      = JHash $! (fmap . identsE') f m
-identsV' f (JFunc args s) = JFunc (fmap f args) (identsS' f s)
-identsV' _ UnsatVal{}     = error "identsV': UnsatVal"
-
-identsS' :: (Ident -> Ident) -> JStat -> JStat
-identsS' f (DeclStat i e)       = DeclStat       (f i) e
-identsS' f (ReturnStat e)       = ReturnStat     $! identsE' f e
-identsS' f (IfStat e s1 s2)     = IfStat         (identsE' f e) (identsS' f s1) (identsS' f s2)
-identsS' f (WhileStat b e s)    = WhileStat b    (identsE' f e) (identsS' f s)
-identsS' f (ForInStat b i e s)  = ForInStat b    (f i) (identsE' f e) (identsS' f s)
-identsS' f (SwitchStat e xs s)  = SwitchStat     (identsE' f e) (fmap (traverseCase f) xs) (identsS' f s)
-  where traverseCase g (e,s) = (identsE' g e, identsS' g s)
-identsS' f (TryStat s1 i s2 s3) = TryStat     (identsS' f s1) (f i) (identsS' f s2) (identsS' f s3)
-identsS' f (BlockStat xs)       = BlockStat   $! identsS' f <$> xs
-identsS' f (ApplStat e es)      = ApplStat    (identsE' f e) (identsE' f <$> es)
-identsS' f (UOpStat op e)       = UOpStat op  $! identsE' f e
-identsS' f (AssignStat e1 e2)   = AssignStat  (identsE' f e1) (identsE' f e2)
-identsS' _ UnsatBlock{}         = error "identsS': UnsatBlock"
-identsS' f (LabelStat l s)      = LabelStat l $! identsS' f s
-identsS' _ b at BreakStat{}        = b
-identsS' _ c at ContinueStat{}     = c


=====================================
compiler/GHC/StgToJS/Linker/Types.hs
=====================================
@@ -18,21 +18,23 @@
 --
 -----------------------------------------------------------------------------
 
-module GHC.StgToJS.Linker.Types where
+module GHC.StgToJS.Linker.Types
+  ( GhcjsEnv (..)
+  , newGhcjsEnv
+  , JSLinkConfig (..)
+  , generateAllJs
+  , LinkedObj (..)
+  , LinkableUnit
+  )
+where
 
-import GHC.JS.Syntax
 import GHC.StgToJS.Object
-import GHC.StgToJS.Types (ClosureInfo, StaticInfo)
 
 import GHC.Unit.Types
-import GHC.Data.FastString
-import GHC.Types.Unique.Map
 import GHC.Utils.Outputable (hsep,Outputable(..),text,ppr)
 
 import Control.Monad
 
-import Data.Array
-import Data.ByteString      (ByteString)
 import Data.Map.Strict      (Map)
 import qualified Data.Map.Strict as M
 import Data.Set             (Set)
@@ -43,217 +45,26 @@ import System.IO
 
 import Prelude
 
---------------------------------------------------------------------------------
--- CompactorState
---------------------------------------------------------------------------------
-
-data CompactorState = CompactorState
-  { csNameMap       :: !(UniqMap FastString Ident) -- ^ renaming mapping for internal names
-  , csEntries       :: !(UniqMap FastString Int)   -- ^ entry functions (these get listed in the metadata init
-                                                   -- array)
-  , csNumEntries    :: !Int
-  , csStatics       :: !(UniqMap FastString Int)   -- ^ mapping of global closure -> index in current block,
-                                                   -- for static initialisation
-  , csNumStatics    :: !Int                        -- ^ number of static entries
-  , csLabels        :: !(UniqMap FastString Int)   -- ^ non-Haskell JS labels
-  , csNumLabels     :: !Int                        -- ^ number of labels
-  , csParentEntries :: !(UniqMap FastString Int)   -- ^ entry functions we're not linking, offset where parent
-                                                   -- gets [0..n], grandparent [n+1..k] etc
-  , csParentStatics :: !(UniqMap FastString Int)   -- ^ objects we're not linking in base bundle
-  , csParentLabels  :: !(UniqMap FastString Int)   -- ^ non-Haskell JS labels in parent
-  , csStringTable   :: !StringTable
-  }
-
--- | A Table of Strings representing @Ident at s and their payloads in
--- @CompactorState@
-data StringTable = StringTable
-  { stTableIdents :: !(Array Int FastString)                -- ^ An array of table identifiers, used in the compactor
-  , stOffsets     :: !(M.Map ByteString (Int, Int))         -- ^ content of the table
-  , stIdents      :: !(UniqMap FastString (Either Int Int)) -- ^ identifiers in the table
-  }
-
--- | The empty @CompactorState@
-emptyCompactorState :: CompactorState
-emptyCompactorState = CompactorState
-  { csNameMap       = mempty
-  , csEntries       = mempty
-  , csNumEntries    = 0
-  , csStatics       = mempty
-  , csNumStatics    = 0
-  , csLabels        = mempty
-  , csNumLabels     = 0
-  , csParentEntries = mempty
-  , csParentStatics = mempty
-  , csParentLabels  = mempty
-  , csStringTable   = emptyStringTable
-  }
-
--- | The empty @StringTable@
-emptyStringTable :: StringTable
-emptyStringTable = StringTable (listArray (0,-1) []) M.empty emptyUniqMap
-
-
---------------------------------------------------------------------------------
--- CompactorState helper functors
---------------------------------------------------------------------------------
-
--- | Update @csEntries@ in @CompactorState@
-entries :: Functor f
-        => (UniqMap FastString Int -> f (UniqMap FastString Int))
-        -> CompactorState
-        -> f CompactorState
-entries f cs = fmap (\x -> cs { csEntries = x }) (f $ csEntries cs)
-{-# INLINE entries #-}
-
--- | Update @csLabels@ in @CompactorState@
-labels :: Functor f
-       => (UniqMap FastString Int -> f (UniqMap FastString Int))
-       -> CompactorState
-       -> f CompactorState
-labels f cs = fmap (\x -> cs { csLabels = x }) (f $ csLabels cs)
-{-# INLINE labels #-}
-
--- | Update @csNameMap@ in @CompactorState@
-nameMap :: Functor f
-        => (UniqMap FastString Ident -> f (UniqMap FastString Ident))
-        -> CompactorState
-        -> f CompactorState
-nameMap f cs = fmap (\x -> cs { csNameMap = x }) (f $ csNameMap cs)
-{-# INLINE nameMap #-}
-
--- | Update @csNumEntries@ in @CompactorState@
-numEntries :: Functor f
-           => (Int -> f Int)
-           -> CompactorState
-           -> f CompactorState
-numEntries f cs = fmap (\x -> cs { csNumEntries = x }) (f $ csNumEntries cs)
-{-# INLINE numEntries #-}
-
--- | Update @csNumLabels@ in @CompactorState@
-numLabels :: Functor f
-          => (Int -> f Int)
-          -> CompactorState
-          -> f CompactorState
-numLabels f cs = fmap (\x -> cs { csNumLabels = x }) (f $ csNumLabels cs)
-{-# INLINE numLabels #-}
-
--- | Update @csNumStatics@ in @CompactorState@
-numStatics :: Functor f
-           => (Int -> f Int)
-           -> CompactorState
-           -> f CompactorState
-numStatics f cs = fmap (\x -> cs { csNumStatics = x }) (f $ csNumStatics cs)
-{-# INLINE numStatics #-}
-
--- | Update @csParentEntries@ in @CompactorState@
-parentEntries :: Functor f
-              => (UniqMap FastString Int -> f (UniqMap FastString Int))
-              -> CompactorState
-              -> f CompactorState
-parentEntries f cs = fmap (\x -> cs { csParentEntries = x }) (f $ csParentEntries cs)
-{-# INLINE parentEntries #-}
-
--- | Update @csParentLabels@ in @CompactorState@
-parentLabels :: Functor f
-             => (UniqMap FastString Int -> f (UniqMap FastString Int))
-             -> CompactorState
-             -> f CompactorState
-parentLabels f cs = fmap (\x -> cs { csParentLabels = x }) (f $ csParentLabels cs)
-{-# INLINE parentLabels #-}
-
--- | Update @csParentStatics@ in @CompactorState@
-parentStatics :: Functor f
-              => (UniqMap FastString Int -> f (UniqMap FastString Int))
-              -> CompactorState
-              -> f CompactorState
-parentStatics f cs = fmap (\x -> cs { csParentStatics = x }) (f $ csParentStatics cs)
-{-# INLINE parentStatics #-}
-
--- | Update @csStatics@ in @CompactorState@
-statics :: Functor f
-        => (UniqMap FastString Int -> f (UniqMap FastString Int))
-        -> CompactorState
-        -> f CompactorState
-statics f cs = fmap (\x -> cs { csStatics = x }) (f $ csStatics cs)
-{-# INLINE statics #-}
-
--- | Update @csStringTable@ in @CompactorState@
-stringTable :: Functor f
-            => (StringTable -> f StringTable)
-            -> CompactorState
-            -> f CompactorState
-stringTable f cs = fmap (\x -> cs { csStringTable = x }) (f $ csStringTable cs)
-{-# INLINE stringTable #-}
-
-
---------------------------------------------------------------------------------
--- CompactorState Insertions
---------------------------------------------------------------------------------
-
--- | Given a static entry, add the entry to @CompactorState@
-addStaticEntry :: FastString        -- ^ The static entry to add
-               -> CompactorState    -- ^ the old state
-               -> CompactorState    -- ^ the new state
-addStaticEntry new cs =
-  -- check if we have seen new before
-  let cur_statics = csStatics cs
-      go          = lookupUniqMap cur_statics new >> lookupUniqMap (csParentStatics cs) new
-  in case go of
-    Just _  -> cs                      -- we have so return
-    Nothing -> let cnt = csNumStatics cs -- we haven't so do the business
-                   newStatics = addToUniqMap cur_statics new cnt
-                   newCnt = cnt + 1
-               in cs {csStatics = newStatics, csNumStatics = newCnt}
-
--- | Given an entry function, add the entry function to @CompactorState@
-addEntry :: FastString        -- ^ The entry function to add
-         -> CompactorState    -- ^ the old state
-         -> CompactorState    -- ^ the new state
-addEntry new cs =
-  let cur_entries = csEntries cs
-      go          = lookupUniqMap cur_entries new >> lookupUniqMap (csParentEntries cs) new
-  in case go of
-    Just _  -> cs
-    Nothing -> let cnt = csNumEntries cs
-                   newEntries = addToUniqMap cur_entries new cnt
-                   newCnt = cnt + 1
-               in cs {csEntries = newEntries, csNumEntries = newCnt}
-
--- | Given a label, add the label to @CompactorState@
-addLabel :: FastString        -- ^ The label to add
-         -> CompactorState    -- ^ the old state
-         -> CompactorState    -- ^ the new state
-addLabel new cs =
-  let cur_lbls = csLabels cs
-      go       = lookupUniqMap cur_lbls new >> lookupUniqMap (csParentLabels cs) new
-  in case go of
-    Just _  -> cs
-    Nothing -> let cnt = csNumLabels cs
-                   newLabels = addToUniqMap cur_lbls new cnt
-                   newCnt = cnt + 1
-               in cs {csEntries = newLabels, csNumLabels = newCnt}
-
 --------------------------------------------------------------------------------
 -- Linker Config
 --------------------------------------------------------------------------------
 
-data JSLinkConfig =
-  JSLinkConfig { lcNativeExecutables  :: Bool
-               , lcNativeToo          :: Bool
-               , lcBuildRunner        :: Bool
-               , lcNoJSExecutables    :: Bool
-               , lcNoHsMain           :: Bool
-               , lcStripProgram       :: Maybe FilePath
-               , lcLogCommandLine     :: Maybe FilePath
-               , lcGhc                :: Maybe FilePath
-               , lcOnlyOut            :: Bool
-               , lcNoRts              :: Bool
-               , lcNoStats            :: Bool
-               , lcLinkJsLib          :: Maybe String
-               , lcJsLibOutputDir     :: Maybe FilePath
-               , lcJsLibSrcs          :: [FilePath]
-               , lcDedupe             :: Bool
-               }
+data JSLinkConfig = JSLinkConfig
+  { lcNativeExecutables  :: Bool
+  , lcNativeToo          :: Bool
+  , lcBuildRunner        :: Bool
+  , lcNoJSExecutables    :: Bool
+  , lcNoHsMain           :: Bool
+  , lcStripProgram       :: Maybe FilePath
+  , lcLogCommandLine     :: Maybe FilePath
+  , lcGhc                :: Maybe FilePath
+  , lcOnlyOut            :: Bool
+  , lcNoRts              :: Bool
+  , lcNoStats            :: Bool
+  , lcLinkJsLib          :: Maybe String
+  , lcJsLibOutputDir     :: Maybe FilePath
+  , lcJsLibSrcs          :: [FilePath]
+  }
 
 -- | we generate a runnable all.js only if we link a complete application,
 --   no incremental linking and no skipped parts
@@ -276,7 +87,6 @@ instance Monoid JSLinkConfig where
             , lcLinkJsLib          = Nothing
             , lcJsLibOutputDir     = Nothing
             , lcJsLibSrcs          = mempty
-            , lcDedupe             = False
             }
 
 instance Semigroup JSLinkConfig where
@@ -298,7 +108,6 @@ instance Semigroup JSLinkConfig where
             , lcLinkJsLib          = comb (<>) lcLinkJsLib
             , lcJsLibOutputDir     = comb (<>) lcJsLibOutputDir
             , lcJsLibSrcs          = comb (<>) lcJsLibSrcs
-            , lcDedupe             = comb (||) lcDedupe
             }
 
 --------------------------------------------------------------------------------
@@ -309,13 +118,6 @@ instance Semigroup JSLinkConfig where
 -- object file
 type LinkableUnit = (Module, Int)
 
--- | A @LinkedUnit@ is a payload of JS code with its closures and any static info.
-data LinkedUnit = LinkedUnit
-  { lu_js_code  :: !JStat
-  , lu_closures :: ![ClosureInfo]
-  , lu_statics  :: ![StaticInfo]
-  }
-
 -- | An object file that's either already in memory (with name) or on disk
 data LinkedObj
   = ObjFile   FilePath      -- ^ load from this file


=====================================
compiler/ghc.cabal.in
=====================================
@@ -661,7 +661,6 @@ Library
         GHC.StgToJS.Types
         GHC.StgToJS.UnitUtils
         GHC.StgToJS.Utils
-        GHC.StgToJS.Linker.Compactor
         GHC.StgToJS.Linker.Linker
         GHC.StgToJS.Linker.Types
         GHC.StgToJS.Linker.Utils



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89db61b634d3077e8ef9e99f73bc90f7ed5f2226...18a51ca67f1f7e44a2eefa5e7c121732ad88f675

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89db61b634d3077e8ef9e99f73bc90f7ed5f2226...18a51ca67f1f7e44a2eefa5e7c121732ad88f675
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221014/8c28f1e7/attachment-0001.html>


More information about the ghc-commits mailing list