[Git][ghc/ghc][wip/reinstallable-th] Restore implicit deps

Teo Camarasu (@teo) gitlab at gitlab.haskell.org
Fri May 24 19:28:35 UTC 2024



Teo Camarasu pushed to branch wip/reinstallable-th at Glasgow Haskell Compiler / GHC


Commits:
48eaf400 by Teo Camarasu at 2024-05-24T20:28:26+01:00
Restore implicit deps

- - - - -


6 changed files:

- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Runtime/Interpreter/JS.hs
- compiler/GHC/Unit/State.hs
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- testsuite/tests/th/TH_Roles2.stderr


Changes:

=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -596,7 +596,7 @@ checkDependencies hsc_env summary iface
         liftIO $
           check_mods (sort hs) prev_dep_mods
           `recompThen`
-            let allPkgDeps = sortBy (comparing snd) $ nubOrdOn snd ps
+            let allPkgDeps = sortBy (comparing snd) $ nubOrdOn snd (ps ++ implicit_deps)
             in check_packages allPkgDeps prev_dep_pkgs
  where
 
@@ -621,6 +621,8 @@ checkDependencies hsc_env summary iface
    prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface))
                                             (dep_plugin_pkgs (mi_deps iface)))
 
+   implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags)
+
    -- GHC.Prim is very special and doesn't appear in ms_textual_imps but
    -- ghc-prim will appear in the package dependencies still. In order to not confuse
    -- the recompilation logic we need to not forget we imported GHC.Prim.


=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -215,7 +215,11 @@ rnImports imports = do
     let (decls, imp_user_spec, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)
     -- Update imp_boot_mods if imp_direct_mods mentions any of them
     let merged_import_avail = clobberSourceImports imp_avails
-    return (decls, imp_user_spec, rdr_env, merged_import_avail, hpc_usage)
+    dflags <- getDynFlags
+    let final_import_avail  =
+          merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags)
+                                                        `S.union` imp_dep_direct_pkgs merged_import_avail}
+    return (decls, imp_user_spec, rdr_env, final_import_avail, hpc_usage)
 
   where
     clobberSourceImports imp_avails =


=====================================
compiler/GHC/Runtime/Interpreter/JS.hs
=====================================
@@ -303,8 +303,8 @@ jsLinkObjects logger tmpfs tmp_dir cfg unit_env inst objs is_root = do
         }
 
   let units = preloadUnits (ue_units unit_env)
-                ++ [ghcInternalUnitId] -- don't forget ghc-internal which is an implicit dep
-                                       -- eg, for desugaring TH quotes
+              ++ [ghcInternalUnitId] -- don't forget ghc-internal which is an implicit dep
+                                     -- eg, for desugaring TH quotes
 
   -- compute dependencies
   let link_spec = LinkSpec


=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -68,7 +68,8 @@ module GHC.Unit.State (
         pprWithUnitState,
 
         -- * Utils
-        unwireUnit)
+        unwireUnit,
+        implicitPackageDeps)
 where
 
 import GHC.Prelude
@@ -115,6 +116,7 @@ import Data.Set (Set)
 import Data.Monoid (First(..))
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Set as Set
+import GHC.LanguageExtensions
 import Control.Applicative
 
 -- ---------------------------------------------------------------------------
@@ -2266,3 +2268,11 @@ pprWithUnitState :: UnitState -> SDoc -> SDoc
 pprWithUnitState state = updSDocContext (\ctx -> ctx
    { sdocUnitIdForUser = \fs -> pprUnitIdForUser state (UnitId fs)
    })
+
+-- | Add package dependencies on the wired-in packages we use
+implicitPackageDeps :: DynFlags -> [UnitId]
+implicitPackageDeps dflags
+   = [ghcInternalUnitId | xopt TemplateHaskellQuotes dflags]
+   -- TODO: Should also include `base` and `ghc-prim` if we use those implicitly, but
+   -- it is possible to not depend on base (for example, see `ghc-prim`)
+


=====================================
testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
=====================================
@@ -1,11 +1,11 @@
-Preprocessing library 'impl' for bkpcabal08-0.1.0.0...
-Building library 'impl' for bkpcabal08-0.1.0.0...
 Preprocessing library 'p' for bkpcabal08-0.1.0.0...
 Building library 'p' instantiated with
   A = <A>
   B = <B>
 for bkpcabal08-0.1.0.0...
 [2 of 2] Compiling B[sig]           ( p/B.hsig, nothing )
+Preprocessing library 'impl' for bkpcabal08-0.1.0.0...
+Building library 'impl' for bkpcabal08-0.1.0.0...
 Preprocessing library 'q' for bkpcabal08-0.1.0.0...
 Building library 'q' instantiated with
   A = <A>
@@ -13,13 +13,13 @@ Building library 'q' instantiated with
 for bkpcabal08-0.1.0.0...
 [2 of 4] Compiling B[sig]           ( q/B.hsig, nothing )
 [3 of 4] Compiling M                ( q/M.hs, nothing ) [A changed]
-[4 of 4] Instantiating bkpcabal08-0.1.0.0-5O1mUtZZLBeDZEqqtwJcCj-p
+[4 of 4] Instantiating bkpcabal08-0.1.0.0-CoQJNXLfoYQ4TyvApzFHv-p
 Preprocessing library 'q' for bkpcabal08-0.1.0.0...
 Building library 'q' instantiated with
-  A = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:A
-  B = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:B
+  A = bkpcabal08-0.1.0.0-5HJrxUERN7CD204UZeT4Ws-impl:A
+  B = bkpcabal08-0.1.0.0-5HJrxUERN7CD204UZeT4Ws-impl:B
 for bkpcabal08-0.1.0.0...
-[1 of 3] Compiling A[sig]           ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/A.o ) [Prelude package changed]
-[2 of 3] Compiling B[sig]           ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/B.o ) [Prelude package changed]
+[1 of 3] Compiling A[sig]           ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-1DQJ9DKc4h59P07qcb0kBc-q+J5mAfRWG9IgLmFQVftCb8t/A.o ) [Prelude package changed]
+[2 of 3] Compiling B[sig]           ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-1DQJ9DKc4h59P07qcb0kBc-q+J5mAfRWG9IgLmFQVftCb8t/B.o ) [Prelude package changed]
 Preprocessing library 'r' for bkpcabal08-0.1.0.0...
 Building library 'r' for bkpcabal08-0.1.0.0...


=====================================
testsuite/tests/th/TH_Roles2.stderr
=====================================
@@ -2,7 +2,8 @@ TYPE CONSTRUCTORS
   data type T{2} :: forall k. k -> *
     roles nominal representational
 Dependent modules: []
-Dependent packages: [base-4.17.0.0, template-haskell-2.19.0.0]
+Dependent packages: [base-4.20.0.0, ghc-internal-9.1001.0,
+                     template-haskell-2.22.0.0]
 
 ==================== Typechecker ====================
 TH_Roles2.$tcT



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48eaf400057639cdb702359ec5c65c23c4059a83

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48eaf400057639cdb702359ec5c65c23c4059a83
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/20240524/10ddddfc/attachment-0001.html>


More information about the ghc-commits mailing list