- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/fendor/dep-json] 2 commits: New json output schema that works with multiple home units
by Hannes Siebenhandl (＠fendor) 02 Oct '26

02 Oct '26

Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC Commits: 96653c51 by fendor at 2026-10-02T11:51:44+02:00 New json output schema that works with multiple home units Update testsuite - - - - - 359dc739 by fendor at 2026-10-02T11:51:44+02:00 Add support for multiple home units - - - - - 11 changed files: - compiler/GHC/Driver/MakeFile.hs - ghc/Main.hs - testsuite/driver/testlib.py - testsuite/tests/driver/T24384/Makefile - testsuite/tests/driver/T24384/T24384a.stdout - testsuite/tests/driver/T24384/T24384b.stdout - + testsuite/tests/driver/T24384/T24384b.stdout-mingw - + testsuite/tests/driver/T24384/T24384c.stdout - testsuite/tests/driver/T24384/all.T - + testsuite/tests/driver/T24384/format_json.sh - + testsuite/tests/driver/T24384/format_makefile.sh Changes: ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -11,7 +11,8 @@ {-# LANGUAGE RecordWildCards #-} module GHC.Driver.MakeFile - ( doMkDependHS + ( doMkDepend + , doMkDependHS , doMkDependModuleGraph ) where @@ -80,6 +81,8 @@ import System.IO.Error (isEOFError) import qualified System.OsString as OsString import qualified Data.Monoid as Monoid import qualified System.FilePath as FilePath +import GHC.Unit.Home.Graph (HomeUnitEnv(homeUnitEnv_dflags)) +import GHC (setProgramHUG) ----------------------------------------------------------------- -- @@ -117,7 +120,39 @@ doMkDependHS srcs = do module_graph <- GHC.depanal excl_mods True {- Allow dup roots -} doMkDependModuleGraph dflags module_graph +doMkDepend :: GhcMonad m => m () +doMkDepend = do + hug_ <- hsc_HUG <$> getSession + + let hug = + fmap (\ hue -> + let + -- We kludge things a bit for dependency generation. Rather than + -- generating dependencies for each way separately, we generate + -- them once and then duplicate them for each way's osuf/hisuf. + -- We therefore do the initial dependency generation with an empty + -- way and .o/.hi extensions, regardless of any flags that might + -- be specified. + dflags1 = (homeUnitEnv_dflags hue) + { targetWays_ = Set.empty + , hiSuf_ = "hi" + , objectSuf_ = "o" + } + in + hue {homeUnitEnv_dflags = dflags1} + ) hug_ + + _ <- setProgramHUG hug + + dflagsGlobal <- GHC.getSessionDynFlags + -- If no suffix is provided, use the default -- the empty one + let dflags = if null (depSuffixes dflagsGlobal) + then dflagsGlobal { depSuffixes = [""] } + else dflagsGlobal + let excl_mods = depExcludeMods dflags + module_graph <- GHC.depanal excl_mods True {- Allow dup roots -} + doMkDependModuleGraph dflags module_graph doMkDependModuleGraph :: GhcMonad m => DynFlags -> ModuleGraph -> m () doMkDependModuleGraph dflags module_graph = do @@ -610,127 +645,188 @@ writeJsonFile doc p = do -------------------------------------------------------------------------------- -- Payload for -dep-json -newtype PackageDeps - = PackageDeps (Map.Map (String, UnitId, DPackageId) DepsImports) - deriving newtype (Monoid) - newtype DPackageId = DPackageId PackageId deriving newtype (Eq) instance Ord DPackageId where DPackageId (PackageId d1) `compare` DPackageId (PackageId d2) = d1 `lexicalCompareFS` d2 -instance Semigroup PackageDeps where - PackageDeps l <> PackageDeps r = PackageDeps (Map.unionWith (Semigroup.<>) l r) - -data Deps = Deps - { sources :: Set.Set OsPath - , moduleImports :: DepsImports - , sourceImports :: DepsImports - , packages :: PackageDeps +data ModuleNodeDeps = ModuleNodeDeps + { source :: OsPath + , imports :: ImportDeps , cpp :: Set.Set OsPath , options :: [String] , preprocessor :: Maybe FilePath } deriving stock (Generic) - deriving (Semigroup, Monoid) via (Generically Deps) + deriving (Semigroup, Monoid) via (Generically ModuleNodeDeps) -data DepsImports - = DepsImports - { normalImport :: Set.Set Module - , spliceImport :: Set.Set Module - , quoteImport :: Set.Set Module - } +addImport :: ImportDep -> ModuleNodeDeps -> ModuleNodeDeps +addImport import_dep mod_node_deps = + mod_node_deps + { imports = ImportDeps $ Map.insertWith Set.union uid (Set.singleton import_dep) (getImports $ imports mod_node_deps) + } + where + uid = toUnitId $ moduleUnit $ imp_mod import_dep + +addCpp :: OsPath -> ModuleNodeDeps -> ModuleNodeDeps +addCpp p mod_node_deps = + mod_node_deps + { cpp = Set.insert p (cpp mod_node_deps) + } + +newtype ImportDeps = ImportDeps { getImports :: Map.Map UnitId (Set.Set ImportDep) } deriving stock (Generic) - deriving (Semigroup, Monoid) via (Generically DepsImports) + deriving (Semigroup, Monoid) via (Generically ImportDeps) + +data ImportDep = ImportDep + { imp_mod :: Module + , imp_level :: ImportLevel + , imp_isBoot :: IsBootInterface + } deriving (Eq, Ord) + +mkImportDep :: Module -> ImportLevel -> IsBootInterface -> ImportDep +mkImportDep modl level isBoot = ImportDep + { imp_mod = modl + , imp_level = level + , imp_isBoot = isBoot + } -newtype DepJson = DepJson (Map.Map ModuleWithIsBoot Deps) +data HomeUnitDeps = HomeUnitDeps + { homeModules :: Map.Map ModuleWithIsBoot ModuleNodeDeps + } + deriving stock (Generic) + deriving (Semigroup, Monoid) via (Generically HomeUnitDeps) + +data ExtUnitDep = ExtUnitDep + { extUnitId :: UnitId + -- ^ The 'UnitId' of a unit. This is assumed to be globally unique. + , extUnitName :: String + , extUnitPackageId :: DPackageId + } deriving (Eq, Ord) + +data DepJson = DepJson + { homeUnitDeps :: Map.Map UnitId HomeUnitDeps + , externalDeps :: Set.Set ExtUnitDep + } instance ToJson DepJson where - json (DepJson m) = - JSObject - [ (homeUnitModuleKey target, homeUnitModule deps) - | (target, deps) <- Map.toList m + json (DepJson homeUnits extDeps) = + JSObject $ + [ homeUnit huid hud + | (huid, hud) <- Map.toList homeUnits + ] ++ + [ mkExtDepObj dep + | dep <- Set.toList extDeps ] where + homeUnit uid hud = + ( unitIdString uid + , JSObject + [ + ( "modules" + , JSObject + [ (homeUnitModuleKey modl, homeUnitModule deps) + | (modl, deps) <- Map.toList $ homeModules hud + ] + ) + ] + ) + homeUnitModuleKey :: ModuleWithIsBoot -> String - homeUnitModuleKey t = moduleNameString (moduleName (gwib_mod t)) ++ case gwib_isBoot t of + homeUnitModuleKey t = moduleKey (gwib_mod t) (gwib_isBoot t) + + moduleKey :: Module -> IsBootInterface -> String + moduleKey t b = moduleNameString (moduleName t) ++ case b of IsBoot -> "[boot]" NotBoot -> "" - homeUnitModule :: Deps -> JsonDoc - homeUnitModule Deps {packages = PackageDeps packages, ..} = + homeUnitModule :: ModuleNodeDeps -> JsonDoc + homeUnitModule ModuleNodeDeps {source, imports, cpp, options, preprocessor} = JSObject - [ ("sources", array sources (showOsPath . normalise)) - , ("modules", JSObject $ importsObj moduleImports) - , ("modules-boot", JSObject $ importsObj sourceImports) - , ("packages", JSArray - [ package name unit_id package_id mods - | ((name, unit_id, dpkd_id), mods) <- Map.toList packages - , let DPackageId package_id = dpkd_id - ] - ) - , ("cpp", array cpp showOsPath) + [ ("source", JSString . showOsPath $ normalise source) + , ("imports", importsObj imports) + , ("includes", strArray cpp showOsPath) , ("options", JSArray $ map JSString options) , ("preprocessor", maybe JSNull JSString preprocessor) ] - package :: String -> UnitId -> PackageId -> DepsImports -> JsonDoc - package name unit_id (PackageId package_id) mods = + importsObj :: ImportDeps -> JsonDoc + importsObj importDeps = JSArray $ map importObj (Map.toList $ getImports importDeps) + + importObj :: (UnitId, Set.Set ImportDep) -> JsonDoc + importObj (uid, importSet) = JSObject - [ ("id", JSString (unitIdString unit_id)) - , ("name", JSString name) - , ("package-id", JSString (unpackFS package_id)) - , ("modules", JSObject $ importsObj mods) + [ (unitIdString uid, array importSet importDepObj ) ] - array values render = JSArray (fmap (JSString . render) (Set.toList values)) + importDepObj :: ImportDep -> JsonDoc + importDepObj ImportDep {imp_mod, imp_level, imp_isBoot} + | NormalLevel <- imp_level = JSString (moduleKey imp_mod imp_isBoot) + | otherwise = JSObject + [ ("module", JSString (moduleKey imp_mod imp_isBoot)) + , ("level" , importLevel imp_level) + ] - showOsPath = unsafeDecodeUtf + importLevel :: ImportLevel -> JsonDoc + importLevel lvl = + JSString $ case lvl of + NormalLevel -> "normal" + SpliceLevel -> "splice" + QuoteLevel -> "quote" + + mkExtDepObj :: ExtUnitDep -> (String, JsonDoc) + mkExtDepObj ExtUnitDep{..} = + ( unitIdString extUnitId + , JSObject + [ ("package-name", JSString extUnitName) + , ("package-id", JSString $ showPackageId extUnitPackageId) + ] + ) + + array values render = JSArray (fmap render (Set.toList values)) + strArray values render = JSArray (fmap (JSString . render) (Set.toList values)) - importsObj :: DepsImports -> [(String, JsonDoc)] - importsObj DepsImports{..} = - [ ("normal", array normalImport (moduleNameString . moduleName)) - , ("quote" , array quoteImport (moduleNameString . moduleName)) - , ("splice", array spliceImport (moduleNameString . moduleName)) - ] + showOsPath = unsafeDecodeUtf + showPackageId (DPackageId (PackageId pid)) = unpackFS pid initDepJson :: IO (IORef DepJson) -initDepJson = newIORef $ DepJson Map.empty +initDepJson = newIORef $ DepJson Map.empty Set.empty -insertDepJson :: [ModuleWithIsBoot] -> Deps -> DepJson -> DepJson -insertDepJson targets dep (DepJson m0) = +insertDepJson :: ModuleWithIsBoot -> ModuleNodeDeps -> Set.Set ExtUnitDep -> DepJson -> DepJson +insertDepJson target modNode extUnits (DepJson m0 e0) = DepJson - $ foldl' - ( \acc target -> - Map.insertWithKey - (\ k _l _r -> pprPanic "insertDepJson" (text "Conflicting entries for: " <+> ppr k)) - target - dep - acc - ) - m0 - targets + { homeUnitDeps = + Map.insertWith + (Semigroup.<>) + modUnitId + (HomeUnitDeps $ Map.singleton target modNode) + m0 + , externalDeps = + Set.union e0 extUnits + } + where + modUnitId = toUnitId $ moduleUnit $ gwib_mod target updateDepJson :: Bool -> DepNode -> [Dep] -> DepJson -> DepJson updateDepJson include_pkgs DepNode {..} deps = - insertDepJson [dn_mod] payload + insertDepJson dn_mod payload externalDeps where - payload = node_data Semigroup.<> foldMap mkDep deps + (externalDeps, payload) = foldl' go (Set.empty, initial_node_data) deps - node_data = - mempty - { sources = Set.singleton dn_src + initial_node_data = + ModuleNodeDeps + { source = dn_src , preprocessor = pn_preprocessor dn_preprocessing , options = pn_options dn_preprocessing + , cpp = Set.empty + , imports = ImportDeps Map.empty } - mkDep = \case + go (extDeps, node_data) = \ case DepHi {dep_mod, dep_local, dep_unit, dep_boot, dep_level} | dep_local - -> case dep_boot of - IsBoot -> mempty {sourceImports = depsImportForImport dep_mod dep_level} - NotBoot -> mempty {moduleImports = depsImportForImport dep_mod dep_level } + -> (extDeps, addImport (mkImportDep dep_mod dep_level dep_boot) node_data) | include_pkgs , Just unit <- dep_unit @@ -738,19 +834,21 @@ updateDepJson include_pkgs DepNode {..} deps = name = unpackFS nameFS withLibName (PackageName c) = name ++ ":" ++ unpackFS c lname = maybe name withLibName (unitComponentName unit) - key = (lname, unitId unit, DPackageId $ unitPackageId unit) - -> mempty {packages = PackageDeps (Map.singleton key (depsImportForImport dep_mod dep_level))} + newExtDep = ExtUnitDep + { extUnitId = unitId unit + , extUnitName = lname + , extUnitPackageId = DPackageId $ unitPackageId unit + } + -> + ( Set.insert newExtDep extDeps + , addImport (mkImportDep dep_mod dep_level dep_boot) node_data + ) | otherwise - -> mempty + -> (extDeps, node_data) DepCpp {dep_path} -> - mempty {cpp = Set.singleton dep_path} - - depsImportForImport mod_name = \ case - NormalLevel -> mempty { normalImport = Set.singleton mod_name } - SpliceLevel -> mempty { spliceImport = Set.singleton mod_name } - QuoteLevel -> mempty { quoteImport = Set.singleton mod_name } + (extDeps, addCpp dep_path node_data) ----------------------------------------------------------------- -- Module cycles ===================================== ghc/Main.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Driver.Phases import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Driver.Pipeline ( oneShot ) -import GHC.Driver.MakeFile ( doMkDependHS ) +import qualified GHC.Driver.MakeFile as MakeFile import GHC.Driver.Backpack ( doBackpack ) import GHC.Driver.Plugins import GHC.Driver.Config.Logger (initLogFlags) @@ -271,7 +271,7 @@ main' postLoadMode units dflags0 args flagWarnings = do f ShowByteCode f -> liftIO $ showByteCode logger hsc_env f DoMake -> doMake units srcs - DoMkDependHS -> doMkDependHS (map fst srcs) + DoMkDependHS -> doMkDepend units srcs StopBefore p -> liftIO (oneShot hsc_env p srcs) DoInteractive -> ghciUI units srcs Nothing DoEval exprs -> ghciUI units srcs $ Just $ reverse exprs @@ -332,6 +332,24 @@ doMake units targets = do ok_flag <- GHC.load LoadAllTargets when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1)) +-- ---------------------------------------------------------------------------- +-- Run -M mode + +doMkDepend :: [String] -> [(String, Maybe Phase)] -> Ghc () +doMkDepend units targets = do + hs_srcs <- case NE.nonEmpty units of + Just ne_units -> do + initMulti ne_units (checkOptions DoMake) + Nothing -> do + s <- initMake targets -- TODO: @fendor: This feels wrong + return $ map (uncurry (,Nothing,)) s + case hs_srcs of + [] -> return () + _ -> do + targets' <- mapM (\(src, uid, phase) -> GHC.guessTarget src uid phase) hs_srcs + GHC.setTargets targets' + MakeFile.doMkDepend + -- --------------------------------------------------------------------------- -- Various banners and verbosity output. ===================================== testsuite/driver/testlib.py ===================================== @@ -20,6 +20,7 @@ from pathlib import Path, PurePath import collections import collections.abc import subprocess +import json from testglobals import config, ghc_env, default_testopts, brokens, t, \ TestRun, TestResult, TestOptions, PerfMetric @@ -3265,6 +3266,58 @@ def normalise_asm( s: str ) -> str: out.append(ins[0]) return '\n'.join(out) +def normalise_dep_json(s: str) -> str: + """ + Normalise the json output of `ghc -M -dep-json output.json` + """ + + def normalise_includes(j): + # Only normalise proper json objects. + # Strings might be parsed as json strings, but we that's not what we are looking for + if not isinstance(j, dict): + return j + for unit in j.values(): + for module in unit.get("modules", {}).values(): + rewritten = [ + __replace_absolute_path(p) + for p in module["includes"] + ] + # we sort to make sure this never + module["includes"] = sorted(rewritten) + return j + + output = "" + try: + normalised_dep_json = normalise_includes(json.loads(s)) + output = json.dumps(normalised_dep_json, indent=2, sort_keys=True, ensure_ascii=False) + except json.JSONDecodeError: + output = s + return output + +def normalise_dep_makefile(s: str) -> str: + """ + Normalise the Makefile output of `ghc -M` + """ + + output = [] + rules = [] + for line in s.split("\n"): + target, sep, dep = line.partition(" : ") + if sep: + rules.append(target + sep + __replace_absolute_path(dep)) + else: + # sort each block of rules so the order doesn't depend on the original absolute paths + output.extend(sorted(rules)) + rules = [] + output.append(line) + output.extend(sorted(rules)) + return "\n".join(output) + +def __replace_absolute_path(s: str) -> str: + if s.startswith("/"): + return "<absolute-path>/" + s.rsplit("/", 1)[-1] + return s + def safe_print(s: str) -> None: s2 = s.encode(sys.stdout.encoding, errors='replace').decode(sys.stdout.encoding) print(s2) ===================================== testsuite/tests/driver/T24384/Makefile ===================================== @@ -45,4 +45,12 @@ T24384b: T24384_prep -package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \ A.hs lib/B.hs C.hs D.hs E.hs - cat dep.json | jq --sort-keys + cat dep.json + +T24384c: T24384_prep + '$(TEST_HC)' -M -dep-json dep.json \ + -hide-all-packages -package base -package containers -package template-haskell \ + -package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \ + A.hs lib/B.hs C.hs D.hs E.hs + + cat dep.json ===================================== testsuite/tests/driver/T24384/T24384a.stdout ===================================== @@ -1,34 +1,39 @@ # DO NOT DELETE: Beginning of Haskell dependencies -E.o : E.hs -E.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi -E.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi -E.o : dep-public/outdir/DepPublic.hi -E.o : dep/outdir/Dep.hi -E.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/template-haskell-2.25.0.0-inplace/Language/Haskell/TH/Syntax.hi -C.o-boot : C.hs-boot -C.o : C.hi-boot -C.o-boot : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi -C.o-boot : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi -C.o-boot : E.hi +A.o : <absolute-path>/Essentials.hi +A.o : <absolute-path>/Prelude.hi +A.o : <absolute-path>/ghcversion.h +A.o : <absolute-path>/stdc-predef.h A.o : A.hs -A.o : foo.h -A.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/rts-1.0.3/include/ghcversion.h -A.o : /usr/include/stdc-predef.h -A.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi -A.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi A.o : C.hi-boot -C.o : C.hs -C.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi -C.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi -C.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/containers-0.8-inplace/Data/Set.hi +A.o : foo.h +C.o : <absolute-path>/Essentials.hi +C.o : <absolute-path>/Prelude.hi +C.o : <absolute-path>/Set.hi C.o : A.hi -lib/B.o : lib/B.hs -lib/B.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi -lib/B.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi -lib/B.o : A.hi -D.o : D.hs -D.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi -D.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi +C.o : C.hi-boot +C.o : C.hs +C.o-boot : <absolute-path>/Essentials.hi +C.o-boot : <absolute-path>/Prelude.hi +C.o-boot : C.hs-boot +C.o-boot : E.hi +D.o : <absolute-path>/Essentials.hi +D.o : <absolute-path>/Prelude.hi D.o : C.hi +D.o : D.hs D.o : lib/B.hi +E.o : <absolute-path>/Essentials.hi +E.o : <absolute-path>/Prelude.hi +E.o : <absolute-path>/Syntax.hi +E.o : E.hs +E.o : dep-public/outdir/DepPublic.hi +E.o : dep/outdir/Dep.hi +lib/B.o : <absolute-path>/Essentials.hi +lib/B.o : <absolute-path>/Prelude.hi +lib/B.o : A.hi +lib/B.o : lib/B.hi-boot +lib/B.o : lib/B.hs +lib/B.o-boot : <absolute-path>/Essentials.hi +lib/B.o-boot : <absolute-path>/Prelude.hi +lib/B.o-boot : A.hi +lib/B.o-boot : lib/B.hs-boot # DO NOT DELETE: End of Haskell dependencies ===================================== testsuite/tests/driver/T24384/T24384b.stdout ===================================== @@ -1,310 +1,191 @@ { - "A": { - "cpp": [ - "/home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/rts-1.0.3/include/ghcversion.h", - "/usr/include/stdc-predef.h", - "foo.h" - ], - "modules": { - "normal": [], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [ - "C" - ], - "quote": [], - "splice": [] - }, - "options": [ - "-XStrict", - "-XCPP", - "-fexpose-all-unfoldings" - ], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": null, - "sources": [ - "A.hs" - ] + "base-<VERSION>-<HASH>": { + "package-id": "base-<VERSION>-<HASH>", + "package-name": "base" }, - "B": { - "cpp": [], - "modules": { - "normal": [ - "A" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [ - "-F", - "-pgmF", - "./preproc.sh" - ], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": "./preproc.sh", - "sources": [ - "lib/B.hs" - ] + "containers-<VERSION>-<HASH>": { + "package-id": "containers-<VERSION>-<HASH>", + "package-name": "containers" }, - "B[boot]": { - "cpp": [], - "modules": { - "normal": [ - "A" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [ - "-F", - "-pgmF", - "./preproc.sh" - ], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": "./preproc.sh", - "sources": [ - "lib/B.hs-boot" - ] + "dep-1-XXX": { + "package-id": "dep-1", + "package-name": "dep" }, - "C": { - "cpp": [], - "modules": { - "normal": [ - "A" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - }, - { - "id": "containers-0.8-inplace", - "modules": { - "normal": [ - "Data.Set" - ], - "quote": [], - "splice": [] - }, - "name": "containers", - "package-id": "containers-0.8" - } - ], - "preprocessor": null, - "sources": [ - "C.hs" - ] + "dep-public-1-XXX": { + "package-id": "dep-public-1", + "package-name": "dep-public" }, - "C[boot]": { - "cpp": [], + "main": { "modules": { - "normal": [ - "E" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": null, - "sources": [ - "C.hs-boot" - ] - }, - "D": { - "cpp": [], - "modules": { - "normal": [ - "B", - "C" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": null, - "sources": [ - "D.hs" - ] - }, - "E": { - "cpp": [], - "modules": { - "normal": [], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" + "A": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "C[boot]" + ] + } + ], + "includes": [ + "<absolute-path>/ghcversion.h", + "<absolute-path>/stdc-predef.h", + "foo.h" + ], + "options": [ + "-XStrict", + "-XCPP", + "-fexpose-all-unfoldings" + ], + "preprocessor": null, + "source": "A.hs" }, - { - "id": "dep-1-XXX", - "modules": { - "normal": [ - "Dep" - ], - "quote": [], - "splice": [] - }, - "name": "dep", - "package-id": "dep-1" + "B": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs" }, - { - "id": "dep-public-1-XXX", - "modules": { - "normal": [ - "DepPublic" - ], - "quote": [], - "splice": [] - }, - "name": "dep-public", - "package-id": "dep-public-1" + "B[boot]": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs-boot" }, - { - "id": "template-haskell-2.25.0.0-inplace", - "modules": { - "normal": [ - "Language.Haskell.TH.Syntax" - ], - "quote": [], - "splice": [] - }, - "name": "template-haskell", - "package-id": "template-haskell-2.25.0.0" + "C": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "containers-<VERSION>-<HASH>": [ + "Data.Set" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs" + }, + "C[boot]": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "E" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs-boot" + }, + "D": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "B", + "C" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "D.hs" + }, + "E": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "dep-1-XXX": [ + "Dep" + ] + }, + { + "dep-public-1-XXX": [ + "DepPublic" + ] + }, + { + "template-haskell-<VERSION>-<HASH>": [ + "Language.Haskell.TH.Syntax" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "E.hs" } - ], - "preprocessor": null, - "sources": [ - "E.hs" - ] + } + }, + "template-haskell-<VERSION>-<HASH>": { + "package-id": "template-haskell-<VERSION>-<HASH>", + "package-name": "template-haskell" } } ===================================== testsuite/tests/driver/T24384/T24384b.stdout-mingw ===================================== @@ -0,0 +1,191 @@ +{ + "base-<VERSION>-<HASH>": { + "package-id": "base-<VERSION>-<HASH>", + "package-name": "base" + }, + "containers-<VERSION>-<HASH>": { + "package-id": "containers-<VERSION>-<HASH>", + "package-name": "containers" + }, + "dep-1-XXX": { + "package-id": "dep-1", + "package-name": "dep" + }, + "dep-public-1-XXX": { + "package-id": "dep-public-1", + "package-name": "dep-public" + }, + "main": { + "modules": { + "A": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "C[boot]" + ] + } + ], + "includes": [ + "<absolute-path>/ghcversion.h", + "<absolute-path>/stdc-predef.h", + "foo.h" + ], + "options": [ + "-XStrict", + "-XCPP", + "-fexpose-all-unfoldings" + ], + "preprocessor": null, + "source": "A.hs" + }, + "B": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs" + }, + "B[boot]": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs-boot" + }, + "C": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "containers-<VERSION>-<HASH>": [ + "Data.Set" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs" + }, + "C[boot]": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "E" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs-boot" + }, + "D": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "B", + "C" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "D.hs" + }, + "E": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "dep-1-XXX": [ + "Dep" + ] + }, + { + "dep-public-1-XXX": [ + "DepPublic" + ] + }, + { + "template-haskell-<VERSION>-<HASH>": [ + "Language.Haskell.TH.Syntax" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "E.hs" + } + } + }, + "template-haskell-<VERSION>-<HASH>": { + "package-id": "template-haskell-<VERSION>-<HASH>", + "package-name": "template-haskell" + } +} ===================================== testsuite/tests/driver/T24384/T24384c.stdout ===================================== @@ -0,0 +1,104 @@ +{ + "main": { + "modules": { + "A": { + "imports": [ + { + "main": [ + "C[boot]" + ] + } + ], + "includes": [], + "options": [ + "-XStrict", + "-XCPP", + "-fexpose-all-unfoldings" + ], + "preprocessor": null, + "source": "A.hs" + }, + "B": { + "imports": [ + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs" + }, + "B[boot]": { + "imports": [ + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs-boot" + }, + "C": { + "imports": [ + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs" + }, + "C[boot]": { + "imports": [ + { + "main": [ + "E" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs-boot" + }, + "D": { + "imports": [ + { + "main": [ + "B", + "C" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "D.hs" + }, + "E": { + "imports": [], + "includes": [], + "options": [], + "preprocessor": null, + "source": "E.hs" + } + } + } +} ===================================== testsuite/tests/driver/T24384/all.T ===================================== @@ -1,3 +1,11 @@ + +json_normalisers = [ normalise_version('base', 'containers', 'template-haskell') + , normalise_slashes + , normalise_fun(normalise_dep_json) + ] + +makefile_normalisers = [ normalise_slashes, normalise_fun(normalise_dep_makefile) ] + test_extras = extra_files( ['A.hs', 'lib/', 'C.hs', 'C.hs-boot', 'D.hs', 'E.hs', 'foo.h', @@ -5,7 +13,8 @@ test_extras = extra_files( 'preproc.sh' ]) -normalisers = normalise_version('base', 'containers', 'template-haskell') +skip_on_mingw = when(opsys('mingw32'), skip) -test('T24384a', [ test_extras, normalisers, pre_cmd('$MAKE -s --no-print-directory T24384_prep') ], makefile_test, []) -test('T24384b', [ test_extras, normalisers, pre_cmd('$MAKE -s --no-print-directory T24384_prep') ], makefile_test, []) +test('T24384a', [ test_extras, pre_cmd('$MAKE -s --no-print-directory T24384_prep'), *makefile_normalisers ], makefile_test, []) +test('T24384b', [ test_extras, pre_cmd('$MAKE -s --no-print-directory T24384_prep'), skip_on_mingw, *json_normalisers ], makefile_test, []) +test('T24384c', [ test_extras, pre_cmd('$MAKE -s --no-print-directory T24384_prep'), skip_on_mingw, *json_normalisers ], makefile_test, []) ===================================== testsuite/tests/driver/T24384/format_json.sh ===================================== @@ -0,0 +1,35 @@ +#! /usr/bin/env bash +set -euo pipefail + +# Packages whose ids are rewritten to <pkg>-<VERSION>-<HASH> +pkgs='base|containers|template-haskell' + +usage() { + cat <<EOF +Usage: $(basename "$0") FILE + +Format one of the test -dep-json output file with jq and normalise it: + - absolute paths in "includes" become <absolute-path>/<filename>, + and the "includes" lists are sorted + - ids of the packages ${packages[*]} + (e.g. base-4.23.0.0-inplace) become <pkg>-<VERSION>-<HASH> + +Writes the output to FILE +EOF +} + +case "${1:-}" in -h|--help) usage; exit 0 ;; esac +[ $# -eq 1 ] || { usage >&2; exit 1; } + +# Escape regex metacharacters (and the / delimiter) for sed +esc() { sed 's/[][\.*^$+?(){}|/]/\\&/g'; } + +json=$(jq --sort-keys ' + (.. | objects | select(has("includes")) | .includes) |= + (map(if startswith("/") then "<absolute-path>/" + (split("/") | last) else . end) | sort) +' "$1") + +tmp=$(mktemp "$1.XXXXXX") +trap 'rm -f "$tmp"' EXIT +sed -E "s/($pkgs)-[0-9.]+(-[0-9a-zA-Z+]+)?(-[0-9a-zA-Z]+)?/\\1-<VERSION>-<HASH>/g" <<<"$json" > "$tmp" +mv "$tmp" "$1" ===================================== testsuite/tests/driver/T24384/format_makefile.sh ===================================== @@ -0,0 +1,28 @@ +#! /usr/bin/env bash +set -euo pipefail + +usage() { + cat <<EOF +Usage: $(basename "$0") FILE + +Normalise a Makefile written by 'ghc -M': + - absolute dependency paths become <absolute-path>/<filename> + - each block of "target : dependency" rules is sorted + +Writes the output to FILE +EOF +} + +case "${1:-}" in -h|--help) usage; exit 0 ;; esac +[ $# -eq 1 ] || { usage >&2; exit 1; } + +tmp=$(mktemp "$1.XXXXXX") +trap 'rm -f "$tmp"' EXIT + +sed -E 's#^(.* : )/.*/#\1<absolute-path>/#' "$1" | + awk ' + / : / { print | "LC_ALL=C sort"; next } + { close("LC_ALL=C sort"); print; fflush() } + END { close("LC_ALL=C sort") } + ' > "$tmp" +mv "$tmp" "$1" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f694e9869ab6062d8f8d321ea8f34d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f694e9869ab6062d8f8d321ea8f34d… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Remove bitSize from MINIMAL pragma of class Bits
by Marge Bot (＠marge-bot) 02 Oct '26

02 Oct '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1d2a26ee by Andrew Lelechenko at 2026-10-01T20:22:04-04:00 Remove bitSize from MINIMAL pragma of class Bits Cf. https://github.com/haskell/core-libraries-committee/issues/441 The function is deprecated for 12 years and has a default implementation, yet it was never removed from the MINIMAL pragma, putting library authors in a very awkward position. Let's finally remove bitSize from MINIMAL. - - - - - 3cc21e4c by Hannes Siebenhandl at 2026-10-01T20:22:59-04:00 Add regression test for #27641 - - - - - c35096f5 by Hannes Siebenhandl at 2026-10-01T20:23:00-04:00 Don't `:add` modules the loader will reject Only home modules can be actually added to the loader context, thus we only accept the module if it belongs to a home unit. - - - - - 49b7d017 by Simon Jakobi at 2026-10-02T08:25:40-04:00 ci: accept modified changelog.d entries in lint-changelog The changelog guide says to extend an existing entry rather than add a new one when the feature is already documented. lint_changelog only counted added files, so such MRs failed before the validator ran. Fixes #27779. Assisted-by: Claude Fable 5.1 - - - - - c67e8aad by Hannes Siebenhandl at 2026-10-02T08:25:41-04:00 Extend the `TrustOverlay` for wired-in units The TrustOverlay only contained the `UnitId` of all on-disk units. However, wired-in units are referred to by their wired-in unit id, which is not the same as the on-disk unit id. Thus, trust checks for wired-in units failed because the lookup was using the wired-in unit, which wasn't present in the `TrustOverlay`. We fix #27834, by copying the trust info for wired-in unit ids. - - - - - 18 changed files: - .gitlab/ci.sh - + changelog.d/27641 - changelog.d/unit-index - compiler/GHC/Unit/External/Wired.hs - compiler/GHC/Unit/State.hs - ghc/GHCi/UI.hs - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Bits.hs - + testsuite/tests/ghci/scripts/T27641.script - + testsuite/tests/ghci/scripts/T27641.stderr - + testsuite/tests/ghci/scripts/T27641.stdout - + testsuite/tests/ghci/scripts/T27834.hs - + testsuite/tests/ghci/scripts/T27834.script - + testsuite/tests/ghci/scripts/T27834.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 Changes: ===================================== .gitlab/ci.sh ===================================== @@ -982,23 +982,24 @@ function lint_changelog() { exit 0 fi - # Check that the MR adds at least one changelog entry. + # Check that the MR adds or modifies at least one changelog entry. git fetch --depth=1 \ "$CI_MERGE_REQUEST_PROJECT_URL" \ "$CI_MERGE_REQUEST_DIFF_BASE_SHA" - local added - added=$(git diff --name-only --diff-filter=A \ + local entries + entries=$(git diff --name-only --diff-filter=AM \ "$CI_MERGE_REQUEST_DIFF_BASE_SHA..$CI_COMMIT_SHA" -- \ 'changelog.d/' | grep -v '^changelog.d/config$' || true) - if [ -z "$added" ]; then + if [ -z "$entries" ]; then error "No changelog entry found in changelog.d/" - echo "Please add a changelog entry file describing your user-facing changes." + echo "Please add a changelog entry file describing your user-facing changes," + echo "or add this MR to the 'mrs' field of an existing entry." echo "If this MR does not need a changelog entry, apply the 'no-changelog' label." exit 1 fi - echo "Found changelog entries: $added" + echo "Found changelog entries: $entries" # Build changelog-d with the bootstrap compiler and validate all entries # (checks required fields, section names, and the MR number). ===================================== changelog.d/27641 ===================================== @@ -0,0 +1,4 @@ +section: ghci +synopsis: Don't accept modules in `:add` that the loader will reject +issues: #27641 +mrs: !16734 ===================================== changelog.d/unit-index ===================================== @@ -1,7 +1,7 @@ section: compiler synopsis: Use global ``UnitIndex`` to deduplicate ``UnitInfo``s over multiple home units -issues: #27500 #26423 #27748 -mrs: !16115 !16598 +issues: #27500 #26423 #27748 #27834 +mrs: !16115 !16598 !16743 description: { The ``UnitState`` used to be duplicated for all ``HomeUnitEnv``, not sharing any of the ``UnitInfo``s. ===================================== compiler/GHC/Unit/External/Wired.hs ===================================== @@ -5,6 +5,7 @@ module GHC.Unit.External.Wired ( isWireMapEmpty, lookupWireMap, listWireMap, + nonDetFoldWireMap, -- * 'UnwireMap' UnwireMap, emptyUnwireMap, @@ -48,6 +49,9 @@ lookupWireMap uid (WireMap wmap) = lookupUniqMap wmap uid listWireMap :: WireMap -> [(UnitId, UnitId)] listWireMap (WireMap wmap) = nonDetUniqMapToList wmap +nonDetFoldWireMap :: ((UnitId, UnitId) -> b -> b) -> b -> WireMap -> b +nonDetFoldWireMap go z (WireMap uniq) = nonDetFoldUniqMap go z uniq + -- | The reverse of 'WireMap'. -- Records the mapping from the wired-in 'UnitId' to the on-disk 'UnitId'. newtype UnwireMap = ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -286,6 +286,21 @@ trustUnits elements (TrustOverlay to) = TrustOverlay $ foldl' (\ acc uid -> addT emptyTrustOverlay :: TrustOverlay emptyTrustOverlay = TrustOverlay emptyUniqMap +-- | For all values in the 'WireMap', copy the recorded trust/distrust +-- for the wired-in unit id. +-- +extendForWireMap :: TrustOverlay -> WireMap -> TrustOverlay +extendForWireMap to wmap = + nonDetFoldWireMap go to wmap + where + go (onDiskUid, wiredInUid) overlay = + case lookupTrustOverlay overlay onDiskUid of + Nothing -> overlay + Just Trusted -> + trustUnits [wiredInUid] overlay + Just Distrusted -> + distrustUnits [wiredInUid] overlay + {- Note [Sharing 'UnitInfo's across the 'UnitEnv'] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -957,7 +972,7 @@ mkUnitState logger unit_index cfg = do , explicitUnits = explicit_pkgs , homeUnitDepends = home_unit_deps , unitInfoMap = pkg_db - , trustedUnits = trustUnitsOverlay + , trustedUnits = trustUnitsOverlay `extendForWireMap` wired_map , moduleNameProvidersMap = mod_map , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger (unitConfigAllowVirtual cfg) pkg_db plugin_vis_map , packageNameMap = pkgname_map ===================================== ghc/GHCi/UI.hs ===================================== @@ -180,6 +180,7 @@ import GHC.IO.Handle ( hFlushAll ) import GHC.TopHandler ( topHandler ) import qualified GHC.Unit.Module.Graph as GHC +import GHC.Unit.Home.Graph (memberHugUnit) ----------------------------------------------------------------------------- @@ -2400,7 +2401,9 @@ addModule files = do result <- liftIO $ Finder.findImportedModule hsc_env Finder.LookupUser m NoPkgQual case result of - Found _ _ -> return True + -- We could find a module from a dependency, such as `Data.List`, but we can't + -- actualy load that unless the module is located in a home unit. + Found _ m | moduleUnit m `memberHugUnit` hsc_HUG hsc_env -> return True _ -> do reportError (GhciModuleError $ GhciModuleNotFound (moduleNameString m)) return False ===================================== libraries/base/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `Data.List.NonEmpty.{zip{3..7},zipWith{3..7},unzip{3..7}}` ([CLC proposal #409)(https://github.com/haskell/core-libraries-committee/issues/409)) * Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412)) * Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378)) + * Remove `bitSize` from `MINIMAL` pragma of `class Bits`. ([CLC proposal #440](https://github.com/haskell/core-libraries-committee/issues/440)) * Change `Generically a`'s `Monoid` definition to require a `Semigroup` constraint, and define its `mconcat` using `(<>)` from that constraint. ([CLC proposal #413](https://github.com/haskell/core-libraries-committee/issues/413)) * Add `withEmptyCallStack` to `GHC.Stack`. ([CLC proposal #428](https://github.com/haskell/core-libraries-committee/issues/428)) * Add new `Data.RealFloat` module re-exporting `RealFloat` from `GHC.Float` ([CLC proposal #394](https://github.com/haskell/core-libraries-committee/issues/394)) ===================================== libraries/ghc-internal/src/GHC/Internal/Bits.hs ===================================== @@ -90,7 +90,7 @@ class Eq a => Bits a where {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), - bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + bitSizeMaybe, isSigned, testBit, bit, popCount #-} -- | Bitwise \"and\" (.&.) :: a -> a -> a ===================================== testsuite/tests/ghci/scripts/T27641.script ===================================== @@ -0,0 +1,3 @@ +:add Data.List +:reload +putStrLn ":add Data.List should fail and a subsequent :reload should succeed" ===================================== testsuite/tests/ghci/scripts/T27641.stderr ===================================== @@ -0,0 +1,2 @@ +<interactive>: error: [GHCi-23305] Module Data.List not found + ===================================== testsuite/tests/ghci/scripts/T27641.stdout ===================================== @@ -0,0 +1 @@ +:add Data.List should fail and a subsequent :reload should succeed ===================================== testsuite/tests/ghci/scripts/T27834.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE Safe #-} +module Main where + +-- Importing a wired-in in module should honour trustworthiness +import GHC.Internal.Char (chr) + +main :: IO () +main = print (chr 120) ===================================== testsuite/tests/ghci/scripts/T27834.script ===================================== @@ -0,0 +1,2 @@ +:load T27834 +putStrLn "Can import trusted module from ghc-internal" ===================================== testsuite/tests/ghci/scripts/T27834.stdout ===================================== @@ -0,0 +1 @@ +Can import trusted module from ghc-internal ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -402,3 +402,5 @@ test('GhciPackageRename', ghci_script, ['GhciPackageRename.script']) test('T26233', normal, ghci_script, ['T26233.script']) +test('T27641', normal, ghci_script, ['T27641.script']) +test('T27834', [extra_hc_opts("-fpackage-trust -trust base -trust ghc-internal -package ghc-internal")], ghci_script, ['T27834.script']) ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5070,7 +5070,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5070,7 +5070,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5073,7 +5073,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8515790b30bd71ab4f8523b8f2ffd1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8515790b30bd71ab4f8523b8f2ffd1… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/sjakobi/changelog-d-fixes] 16 commits: Improve the `mhu-closure` makefile
by Zubin (＠wz1000) 02 Oct '26

02 Oct '26

Zubin pushed to branch wip/sjakobi/changelog-d-fixes at Glasgow Haskell Compiler / GHC Commits: 1abef1ef by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Improve the `mhu-closure` makefile - - - - - a79a68ea by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Make `ghci-multi` hide all unneeded packages - - - - - d6e72450 by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Improve the definition of the home unit closure property - - - - - c9a2766d by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Re-implement the home unit closure check Compared to the previous implementation, the new one has the following advantages: * It is correct. - It distinguishes between units that have the same unit ID but different ABI hashes. - When `-hide-all-packages` is not used, it considers as home unit dependencies also units that are made implicitly available because they are in the package database. * It seems to be faster in usual settings. - In particular, it does not have a preparation phase in which it merges the dependency information from all home units, so that its running time does not grow linearly with the size of the package database in normal Cabal scenarios. * It is (hopefully) clearer. * It is better documented. - - - - - fa96acf8 by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Remove erroneous GHC flag in `hadrian-multi` The flag was `-Werror=-Wno-error=incomplete-record-selectors`. Its purpose was to permit incomplete record selectors, but because of the illegal combination of `-Werror=` and `-Wno-error` it was ignored, without any negative consequences. - - - - - 9f48a5b9 by Alan Zimmerman at 2026-09-25T17:02:50-04:00 EPA: Add specific layout field to AnnList Up to now AnnList has effectively served to represent lists of things having layout, regardless of whether they do or not. In Haskell, layout is optional in many places, as there is also an alternative syntax using braces and semi-colons, which is free-form. This commit introduces AnnListLayout, a data structure capturing this distinction. It is deliberately set up similarly to EpLayout, so that these two can be merged in time. The transition is done mechanically, where AnnListBraces is not used yet, the original Nothing case maps to AnnListNoLayout, and the Just case to AnnListLayout. Later commits will fine tune these against the actual parser layout. - - - - - 234bab08 by Vladislav Zavialov at 2026-09-29T17:22:54-04:00 Add regression test for #7803 Commit 2effe18ab5, first shipped with GHC 8.2.1, fixed #7803 "Superclass methods are left unspecialized". This change turns the example from the ticket description into a regression test, checking that foo1 is fully specialised at Double, with no calls to the overloaded exp5Tail. Closes #7803 Assisted-by: Claude Opus 5 - - - - - c406135c by Andreas Klebinger at 2026-10-01T06:57:28-04:00 RTS: Update flag parsing/handling: Using 0 as argument to any of these flags now resets the flags setting to default: - ``-n0`` disables nursery chunking. - ``-K0`` (or a bare ``-K``) removes the stack size limit. - ``-M0`` removes the heap size limit. - ``-H0`` resets the suggested heap size, including the nursery scaling set by ``-H``. - ``-AL0`` makes the large object allocation limit follow ``-A`` again. GC Generations are now limited to 64. -n larger than -A now emits a warning and disables chunking. Fixes #27830 #27829 - - - - - 984ee82b by Andreas Klebinger at 2026-10-01T06:58:10-04:00 Fix MultiLayerModules timeout multiplier. We accidentally used the compile multiplier for ghci commands which use the run timeout setting to set the timeout. Fixes #26263 and #27796. - - - - - 50a9cf26 by Andreas Klebinger at 2026-10-01T06:58:10-04:00 testsuite: Include runtime in JUnit report. - - - - - e358619f by Alan Zimmerman at 2026-10-01T06:59:01-04:00 EPA: Use EpaLocation in EpVirtualBraces Haddock processing uses EpLayout.EpVirtualBraces to record the current layout column, for allocating haddock comments correctly. For exact printing, we need the line as well as the col, so we know how many lines to skip when the indented code block starts. This commit updates EpLayout.EpVirtualBraces so that it carries an EpaLocation instead of just the Int column, to allow it to be used for both purposes. It is a simple mechanical change, with no other impact, but it allows us to use EpLayout instead of AnnListLayout in AnnList, in the next commit in this series. - - - - - 1d2a26ee by Andrew Lelechenko at 2026-10-01T20:22:04-04:00 Remove bitSize from MINIMAL pragma of class Bits Cf. https://github.com/haskell/core-libraries-committee/issues/441 The function is deprecated for 12 years and has a default implementation, yet it was never removed from the MINIMAL pragma, putting library authors in a very awkward position. Let's finally remove bitSize from MINIMAL. - - - - - 3cc21e4c by Hannes Siebenhandl at 2026-10-01T20:22:59-04:00 Add regression test for #27641 - - - - - c35096f5 by Hannes Siebenhandl at 2026-10-01T20:23:00-04:00 Don't `:add` modules the loader will reject Only home modules can be actually added to the loader context, thus we only accept the module if it belongs to a home unit. - - - - - 279a13c0 by Simon Jakobi at 2026-10-02T16:11:39+05:30 changelog.d: Fix warning flag name in the semaphore-v2 entry The entry refers to -Wsemaphore-version-mismatch, which does not exist. The warning GHC emits when it cannot use a -jsem semaphore, including on a protocol version mismatch, is -Wsemaphore-open-failure. Context: !15729, #25087 Assisted-by: Claude Fable 5.1 - - - - - 24a8a13c by Simon Jakobi at 2026-10-02T16:11:39+05:30 changelog.d: Fix the CLC proposal link in the T27455 entry The entry used the Sphinx :ref: role with a URL as its target. :ref: resolves only internal labels, so the generated release notes would show the proposal name without a link. Use the plain hyperlink form like the other entries. Context: !16274, #27455 Assisted-by: Claude Fable 5.1 - - - - - 70 changed files: - .gitlab-ci.yml - + changelog.d/27641 - changelog.d/T27455 - + changelog.d/T27830-rts-flag-bounds - changelog.d/semaphore-v2 - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Unit/Env.hs - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - hadrian/ghci-multi-cabal.in - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Bits.hs - rts/RtsFlags.c - rts/include/rts/Flags.h - rts/include/rts/storage/GC.h - rts/sm/GC.c - rts/sm/Storage.c - testsuite/driver/junit.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/driver/multipleHomeUnits/mhu-closure/Makefile - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stderr - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stdout - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - + testsuite/tests/ghci/scripts/T27641.script - + testsuite/tests/ghci/scripts/T27641.stderr - + testsuite/tests/ghci/scripts/T27641.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T15279.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20718b.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/AnnotationNoListTuplePuns.stdout - testsuite/tests/printer/T18791.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - testsuite/tests/rts/all.T - testsuite/tests/rts/rtsflags001.stderr-ws-32 - testsuite/tests/rts/rtsflags001.stderr-ws-64 - + testsuite/tests/simplCore/should_compile/T7803.hs - + testsuite/tests/simplCore/should_compile/T7803.stderr - + testsuite/tests/simplCore/should_compile/T7803a.hs - testsuite/tests/simplCore/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91e6cb9e86b34457886a52781bfead… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91e6cb9e86b34457886a52781bfead… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/27672] configure: fix sed script and subst tooldir script
by Hannes Siebenhandl (＠fendor) 02 Oct '26

02 Oct '26

Hannes Siebenhandl pushed to branch wip/mangoiv/27672 at Glasgow Haskell Compiler / GHC Commits: 2e06635e by mangoiv at 2026-10-02T11:16:03+02:00 configure: fix sed script and subst tooldir script Fixes #27672 Adds sanity checking for SUBST_TOOLDIR Metric Decrease: LinkableUsage01 MultiLayerModulesTH_OneShot T10547 T12234 T12425 T13035 T13820 T18140 T18730 T18923 T9198 TcPlugin_RewritePerf mhu-perf - - - - - 2 changed files: - distrib/configure.ac.in - m4/subst_tooldir.m4 Changes: ===================================== distrib/configure.ac.in ===================================== @@ -103,7 +103,7 @@ AC_ARG_ENABLE(distro-toolchain, AC_SUBST([EnableDistroToolchain]) if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then - FP_SETUP_WINDOWS_TOOLCHAIN([$hardtop/mingw/], [\$\$topdir/../mingw/]) + FP_SETUP_WINDOWS_TOOLCHAIN([$hardtop/mingw/], [\$topdir/../mingw/]) fi ===================================== m4/subst_tooldir.m4 ===================================== @@ -41,5 +41,13 @@ dnl ghc-toolchain. # See Note [How we configure the bundled windows toolchain] AC_DEFUN([SUBST_TOOLDIR], [ - sed -i.bkp $1 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g' + if ! grep -qF "$mingw_prefix" $1; then + AC_MSG_ERROR([SUBST_TOOLDIR: $1 does not refer to the bundled mingw toolchain at $mingw_prefix]) + fi + if ! sed -i.bkp 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g' $1; then + AC_MSG_ERROR([SUBST_TOOLDIR: failed to substitute $mingw_prefix in $1]) + fi + if grep -qF "$mingw_prefix" $1; then + AC_MSG_ERROR([SUBST_TOOLDIR: $1 still refers to $mingw_prefix after substitution]) + fi ]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e06635e593997342d63d96cb82c24e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e06635e593997342d63d96cb82c24e… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/27672] 9 commits: Add regression test for #7803
by Zubin (＠wz1000) 02 Oct '26

02 Oct '26

Zubin pushed to branch wip/mangoiv/27672 at Glasgow Haskell Compiler / GHC Commits: 234bab08 by Vladislav Zavialov at 2026-09-29T17:22:54-04:00 Add regression test for #7803 Commit 2effe18ab5, first shipped with GHC 8.2.1, fixed #7803 "Superclass methods are left unspecialized". This change turns the example from the ticket description into a regression test, checking that foo1 is fully specialised at Double, with no calls to the overloaded exp5Tail. Closes #7803 Assisted-by: Claude Opus 5 - - - - - c406135c by Andreas Klebinger at 2026-10-01T06:57:28-04:00 RTS: Update flag parsing/handling: Using 0 as argument to any of these flags now resets the flags setting to default: - ``-n0`` disables nursery chunking. - ``-K0`` (or a bare ``-K``) removes the stack size limit. - ``-M0`` removes the heap size limit. - ``-H0`` resets the suggested heap size, including the nursery scaling set by ``-H``. - ``-AL0`` makes the large object allocation limit follow ``-A`` again. GC Generations are now limited to 64. -n larger than -A now emits a warning and disables chunking. Fixes #27830 #27829 - - - - - 984ee82b by Andreas Klebinger at 2026-10-01T06:58:10-04:00 Fix MultiLayerModules timeout multiplier. We accidentally used the compile multiplier for ghci commands which use the run timeout setting to set the timeout. Fixes #26263 and #27796. - - - - - 50a9cf26 by Andreas Klebinger at 2026-10-01T06:58:10-04:00 testsuite: Include runtime in JUnit report. - - - - - e358619f by Alan Zimmerman at 2026-10-01T06:59:01-04:00 EPA: Use EpaLocation in EpVirtualBraces Haddock processing uses EpLayout.EpVirtualBraces to record the current layout column, for allocating haddock comments correctly. For exact printing, we need the line as well as the col, so we know how many lines to skip when the indented code block starts. This commit updates EpLayout.EpVirtualBraces so that it carries an EpaLocation instead of just the Int column, to allow it to be used for both purposes. It is a simple mechanical change, with no other impact, but it allows us to use EpLayout instead of AnnListLayout in AnnList, in the next commit in this series. - - - - - 1d2a26ee by Andrew Lelechenko at 2026-10-01T20:22:04-04:00 Remove bitSize from MINIMAL pragma of class Bits Cf. https://github.com/haskell/core-libraries-committee/issues/441 The function is deprecated for 12 years and has a default implementation, yet it was never removed from the MINIMAL pragma, putting library authors in a very awkward position. Let's finally remove bitSize from MINIMAL. - - - - - 3cc21e4c by Hannes Siebenhandl at 2026-10-01T20:22:59-04:00 Add regression test for #27641 - - - - - c35096f5 by Hannes Siebenhandl at 2026-10-01T20:23:00-04:00 Don't `:add` modules the loader will reject Only home modules can be actually added to the loader context, thus we only accept the module if it belongs to a home unit. - - - - - 8c0a11ef by mangoiv at 2026-10-02T14:29:46+05:30 configure: fix sed script and subst tooldir script Fixes #27672 Metric Decrease: LinkableUsage01 MultiLayerModulesTH_OneShot T10547 T12234 T12425 T13035 T13820 T18140 T18730 T18923 T9198 TcPlugin_RewritePerf mhu-perf - - - - - 55 changed files: - + changelog.d/27641 - + changelog.d/T27830-rts-flag-bounds - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - distrib/configure.ac.in - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Bits.hs - m4/subst_tooldir.m4 - rts/RtsFlags.c - rts/include/rts/Flags.h - rts/include/rts/storage/GC.h - rts/sm/GC.c - rts/sm/Storage.c - testsuite/driver/junit.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - + testsuite/tests/ghci/scripts/T27641.script - + testsuite/tests/ghci/scripts/T27641.stderr - + testsuite/tests/ghci/scripts/T27641.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20718b.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/AnnotationNoListTuplePuns.stdout - testsuite/tests/printer/T18791.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - testsuite/tests/rts/all.T - testsuite/tests/rts/rtsflags001.stderr-ws-32 - testsuite/tests/rts/rtsflags001.stderr-ws-64 - + testsuite/tests/simplCore/should_compile/T7803.hs - + testsuite/tests/simplCore/should_compile/T7803.stderr - + testsuite/tests/simplCore/should_compile/T7803a.hs - testsuite/tests/simplCore/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae260fb6ffd0e7c1ccfc1c93ef9eba… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae260fb6ffd0e7c1ccfc1c93ef9eba… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/fendor/27834] 9 commits: Add regression test for #7803
by Hannes Siebenhandl (＠fendor) 02 Oct '26

02 Oct '26

Hannes Siebenhandl pushed to branch wip/fendor/27834 at Glasgow Haskell Compiler / GHC Commits: 234bab08 by Vladislav Zavialov at 2026-09-29T17:22:54-04:00 Add regression test for #7803 Commit 2effe18ab5, first shipped with GHC 8.2.1, fixed #7803 "Superclass methods are left unspecialized". This change turns the example from the ticket description into a regression test, checking that foo1 is fully specialised at Double, with no calls to the overloaded exp5Tail. Closes #7803 Assisted-by: Claude Opus 5 - - - - - c406135c by Andreas Klebinger at 2026-10-01T06:57:28-04:00 RTS: Update flag parsing/handling: Using 0 as argument to any of these flags now resets the flags setting to default: - ``-n0`` disables nursery chunking. - ``-K0`` (or a bare ``-K``) removes the stack size limit. - ``-M0`` removes the heap size limit. - ``-H0`` resets the suggested heap size, including the nursery scaling set by ``-H``. - ``-AL0`` makes the large object allocation limit follow ``-A`` again. GC Generations are now limited to 64. -n larger than -A now emits a warning and disables chunking. Fixes #27830 #27829 - - - - - 984ee82b by Andreas Klebinger at 2026-10-01T06:58:10-04:00 Fix MultiLayerModules timeout multiplier. We accidentally used the compile multiplier for ghci commands which use the run timeout setting to set the timeout. Fixes #26263 and #27796. - - - - - 50a9cf26 by Andreas Klebinger at 2026-10-01T06:58:10-04:00 testsuite: Include runtime in JUnit report. - - - - - e358619f by Alan Zimmerman at 2026-10-01T06:59:01-04:00 EPA: Use EpaLocation in EpVirtualBraces Haddock processing uses EpLayout.EpVirtualBraces to record the current layout column, for allocating haddock comments correctly. For exact printing, we need the line as well as the col, so we know how many lines to skip when the indented code block starts. This commit updates EpLayout.EpVirtualBraces so that it carries an EpaLocation instead of just the Int column, to allow it to be used for both purposes. It is a simple mechanical change, with no other impact, but it allows us to use EpLayout instead of AnnListLayout in AnnList, in the next commit in this series. - - - - - 1d2a26ee by Andrew Lelechenko at 2026-10-01T20:22:04-04:00 Remove bitSize from MINIMAL pragma of class Bits Cf. https://github.com/haskell/core-libraries-committee/issues/441 The function is deprecated for 12 years and has a default implementation, yet it was never removed from the MINIMAL pragma, putting library authors in a very awkward position. Let's finally remove bitSize from MINIMAL. - - - - - 3cc21e4c by Hannes Siebenhandl at 2026-10-01T20:22:59-04:00 Add regression test for #27641 - - - - - c35096f5 by Hannes Siebenhandl at 2026-10-01T20:23:00-04:00 Don't `:add` modules the loader will reject Only home modules can be actually added to the loader context, thus we only accept the module if it belongs to a home unit. - - - - - db831164 by Hannes Siebenhandl at 2026-10-02T10:12:23+02:00 Extend the `TrustOverlay` for wired-in units The TrustOverlay only contained the `UnitId` of all on-disk units. However, wired-in units are referred to by their wired-in unit id, which is not the same as the on-disk unit id. Thus, trust checks for wired-in units failed because the lookup was using the wired-in unit, which wasn't present in the `TrustOverlay`. We fix #27834, by copying the trust info for wired-in unit ids. - - - - - 59 changed files: - + changelog.d/27641 - + changelog.d/T27830-rts-flag-bounds - changelog.d/unit-index - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Unit/External/Wired.hs - compiler/GHC/Unit/State.hs - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Bits.hs - rts/RtsFlags.c - rts/include/rts/Flags.h - rts/include/rts/storage/GC.h - rts/sm/GC.c - rts/sm/Storage.c - testsuite/driver/junit.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - + testsuite/tests/ghci/scripts/T27641.script - + testsuite/tests/ghci/scripts/T27641.stderr - + testsuite/tests/ghci/scripts/T27641.stdout - + testsuite/tests/ghci/scripts/T27834.hs - + testsuite/tests/ghci/scripts/T27834.script - + testsuite/tests/ghci/scripts/T27834.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20718b.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/AnnotationNoListTuplePuns.stdout - testsuite/tests/printer/T18791.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - testsuite/tests/rts/all.T - testsuite/tests/rts/rtsflags001.stderr-ws-32 - testsuite/tests/rts/rtsflags001.stderr-ws-64 - + testsuite/tests/simplCore/should_compile/T7803.hs - + testsuite/tests/simplCore/should_compile/T7803.stderr - + testsuite/tests/simplCore/should_compile/T7803a.hs - testsuite/tests/simplCore/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50b56b9c8ac9e5cd5cf7ac19037910… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50b56b9c8ac9e5cd5cf7ac19037910… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][master] 2 commits: Add regression test for #27641
by Marge Bot (＠marge-bot) 01 Oct '26

01 Oct '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3cc21e4c by Hannes Siebenhandl at 2026-10-01T20:22:59-04:00 Add regression test for #27641 - - - - - c35096f5 by Hannes Siebenhandl at 2026-10-01T20:23:00-04:00 Don't `:add` modules the loader will reject Only home modules can be actually added to the loader context, thus we only accept the module if it belongs to a home unit. - - - - - 6 changed files: - + changelog.d/27641 - ghc/GHCi/UI.hs - + testsuite/tests/ghci/scripts/T27641.script - + testsuite/tests/ghci/scripts/T27641.stderr - + testsuite/tests/ghci/scripts/T27641.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== changelog.d/27641 ===================================== @@ -0,0 +1,4 @@ +section: ghci +synopsis: Don't accept modules in `:add` that the loader will reject +issues: #27641 +mrs: !16734 ===================================== ghc/GHCi/UI.hs ===================================== @@ -180,6 +180,7 @@ import GHC.IO.Handle ( hFlushAll ) import GHC.TopHandler ( topHandler ) import qualified GHC.Unit.Module.Graph as GHC +import GHC.Unit.Home.Graph (memberHugUnit) ----------------------------------------------------------------------------- @@ -2400,7 +2401,9 @@ addModule files = do result <- liftIO $ Finder.findImportedModule hsc_env Finder.LookupUser m NoPkgQual case result of - Found _ _ -> return True + -- We could find a module from a dependency, such as `Data.List`, but we can't + -- actualy load that unless the module is located in a home unit. + Found _ m | moduleUnit m `memberHugUnit` hsc_HUG hsc_env -> return True _ -> do reportError (GhciModuleError $ GhciModuleNotFound (moduleNameString m)) return False ===================================== testsuite/tests/ghci/scripts/T27641.script ===================================== @@ -0,0 +1,3 @@ +:add Data.List +:reload +putStrLn ":add Data.List should fail and a subsequent :reload should succeed" ===================================== testsuite/tests/ghci/scripts/T27641.stderr ===================================== @@ -0,0 +1,2 @@ +<interactive>: error: [GHCi-23305] Module Data.List not found + ===================================== testsuite/tests/ghci/scripts/T27641.stdout ===================================== @@ -0,0 +1 @@ +:add Data.List should fail and a subsequent :reload should succeed ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -402,3 +402,4 @@ test('GhciPackageRename', ghci_script, ['GhciPackageRename.script']) test('T26233', normal, ghci_script, ['T26233.script']) +test('T27641', normal, ghci_script, ['T27641.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d2a26eee4c05dde46bccc83af3ea0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d2a26eee4c05dde46bccc83af3ea0… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][master] Remove bitSize from MINIMAL pragma of class Bits
by Marge Bot (＠marge-bot) 01 Oct '26

01 Oct '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1d2a26ee by Andrew Lelechenko at 2026-10-01T20:22:04-04:00 Remove bitSize from MINIMAL pragma of class Bits Cf. https://github.com/haskell/core-libraries-committee/issues/441 The function is deprecated for 12 years and has a default implementation, yet it was never removed from the MINIMAL pragma, putting library authors in a very awkward position. Let's finally remove bitSize from MINIMAL. - - - - - 5 changed files: - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Bits.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 Changes: ===================================== libraries/base/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `Data.List.NonEmpty.{zip{3..7},zipWith{3..7},unzip{3..7}}` ([CLC proposal #409)(https://github.com/haskell/core-libraries-committee/issues/409)) * Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412)) * Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378)) + * Remove `bitSize` from `MINIMAL` pragma of `class Bits`. ([CLC proposal #440](https://github.com/haskell/core-libraries-committee/issues/440)) * Change `Generically a`'s `Monoid` definition to require a `Semigroup` constraint, and define its `mconcat` using `(<>)` from that constraint. ([CLC proposal #413](https://github.com/haskell/core-libraries-committee/issues/413)) * Add `withEmptyCallStack` to `GHC.Stack`. ([CLC proposal #428](https://github.com/haskell/core-libraries-committee/issues/428)) * Add new `Data.RealFloat` module re-exporting `RealFloat` from `GHC.Float` ([CLC proposal #394](https://github.com/haskell/core-libraries-committee/issues/394)) ===================================== libraries/ghc-internal/src/GHC/Internal/Bits.hs ===================================== @@ -90,7 +90,7 @@ class Eq a => Bits a where {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), - bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + bitSizeMaybe, isSigned, testBit, bit, popCount #-} -- | Bitwise \"and\" (.&.) :: a -> a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5070,7 +5070,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5070,7 +5070,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -726,7 +726,7 @@ module Data.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int @@ -2024,7 +2024,7 @@ module Foreign where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -2938,7 +2938,7 @@ module Foreign.Safe where rotateL :: a -> Int -> a rotateR :: a -> Int -> a popCount :: a -> Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FinalizerEnvPtr :: * -> * -> * type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> GHC.Internal.Types.IO ()) type FinalizerPtr :: * -> * @@ -5073,7 +5073,7 @@ module GHC.Bits where rotateL :: a -> GHC.Internal.Types.Int -> a rotateR :: a -> GHC.Internal.Types.Int -> a popCount :: a -> GHC.Internal.Types.Int - {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-} + {-# MINIMAL (.&.), (.|.), xor, complement, (shift | (shiftL, shiftR)), (rotate | (rotateL, rotateR)), bitSizeMaybe, isSigned, testBit, bit, popCount #-} type FiniteBits :: * -> Constraint class Bits b => FiniteBits b where finiteBitSize :: b -> GHC.Internal.Types.Int View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d2a26eee4c05dde46bccc83af3ea0d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d2a26eee4c05dde46bccc83af3ea0d… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/jeltsch/smaller-pit] 7 commits: Add regression test for #7803
by Wolfgang Jeltsch (＠jeltsch) 01 Oct '26

01 Oct '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/smaller-pit at Glasgow Haskell Compiler / GHC Commits: 234bab08 by Vladislav Zavialov at 2026-09-29T17:22:54-04:00 Add regression test for #7803 Commit 2effe18ab5, first shipped with GHC 8.2.1, fixed #7803 "Superclass methods are left unspecialized". This change turns the example from the ticket description into a regression test, checking that foo1 is fully specialised at Double, with no calls to the overloaded exp5Tail. Closes #7803 Assisted-by: Claude Opus 5 - - - - - c406135c by Andreas Klebinger at 2026-10-01T06:57:28-04:00 RTS: Update flag parsing/handling: Using 0 as argument to any of these flags now resets the flags setting to default: - ``-n0`` disables nursery chunking. - ``-K0`` (or a bare ``-K``) removes the stack size limit. - ``-M0`` removes the heap size limit. - ``-H0`` resets the suggested heap size, including the nursery scaling set by ``-H``. - ``-AL0`` makes the large object allocation limit follow ``-A`` again. GC Generations are now limited to 64. -n larger than -A now emits a warning and disables chunking. Fixes #27830 #27829 - - - - - 984ee82b by Andreas Klebinger at 2026-10-01T06:58:10-04:00 Fix MultiLayerModules timeout multiplier. We accidentally used the compile multiplier for ghci commands which use the run timeout setting to set the timeout. Fixes #26263 and #27796. - - - - - 50a9cf26 by Andreas Klebinger at 2026-10-01T06:58:10-04:00 testsuite: Include runtime in JUnit report. - - - - - e358619f by Alan Zimmerman at 2026-10-01T06:59:01-04:00 EPA: Use EpaLocation in EpVirtualBraces Haddock processing uses EpLayout.EpVirtualBraces to record the current layout column, for allocating haddock comments correctly. For exact printing, we need the line as well as the col, so we know how many lines to skip when the indented code block starts. This commit updates EpLayout.EpVirtualBraces so that it carries an EpaLocation instead of just the Int column, to allow it to be used for both purposes. It is a simple mechanical change, with no other impact, but it allows us to use EpLayout instead of AnnListLayout in AnnList, in the next commit in this series. - - - - - 43ef4e4c by Wolfgang Jeltsch at 2026-10-02T00:54:20+03:00 Make Haddock avoid the PIT To this end, Haddock has been using `loadSysInterface` to fetch module interfaces. The `loadSysInterface` operation is very complex, containing many bits that do not seem to be needed by Haddock. In particular, storing interface data in and potentially retrieving it from the PIT seems to be superfluous. This interaction with the PIT limits how much we can statically shrink the amount of information that is stored in the PIT. Therefore, we drop the use of `loadSysInterface` and implement the necessary bits of interface fetching directly in `loadHiFile`, where `loadSysInterface` use to be invoked. - - - - - 3216168c by Wolfgang Jeltsch at 2026-10-02T00:54:20+03:00 Statically enforce module interface reduction for the PIT `GHC.Iface.Load.loadInterface` used to replace certain fields of each fetched module interface by `panic` applications before storing it in the PIT. With the present change, the absence of those fields in the PIT is guaranteed statically. See #27044 for the bigger picture. - - - - - 64 changed files: - + changelog.d/T27830-rts-flag-bounds - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session/Inspect.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Load.hs-boot - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Unit/External.hs - compiler/GHC/Unit/Module/ModIface.hs - docs/users_guide/runtime_control.rst - ghc/Main.hs - rts/RtsFlags.c - rts/include/rts/Flags.h - rts/include/rts/storage/GC.h - rts/sm/GC.c - rts/sm/Storage.c - testsuite/driver/junit.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20718b.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/AnnotationNoListTuplePuns.stdout - testsuite/tests/printer/T18791.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - testsuite/tests/rts/all.T - testsuite/tests/rts/rtsflags001.stderr-ws-32 - testsuite/tests/rts/rtsflags001.stderr-ws-64 - + testsuite/tests/simplCore/should_compile/T7803.hs - + testsuite/tests/simplCore/should_compile/T7803.stderr - + testsuite/tests/simplCore/should_compile/T7803a.hs - testsuite/tests/simplCore/should_compile/all.T - utils/haddock/haddock-api/src/Haddock/Interface.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5da11526ad25f059f76c1e00ca7e63… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5da11526ad25f059f76c1e00ca7e63… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/jeltsch/smaller-pit] 2 commits: Make Haddock avoid the PIT
by Wolfgang Jeltsch (＠jeltsch) 01 Oct '26

01 Oct '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/smaller-pit at Glasgow Haskell Compiler / GHC Commits: 52b7a873 by Wolfgang Jeltsch at 2026-10-02T00:00:39+03:00 Make Haddock avoid the PIT To this end, Haddock has been using `loadSysInterface` to fetch module interfaces. The `loadSysInterface` operation is very complex, containing many bits that do not seem to be needed by Haddock. In particular, storing interface data in and potentially retrieving it from the PIT seems to be superfluous. This interaction with the PIT limits how much we can statically shrink the amount of information that is stored in the PIT. Therefore, we drop the use of `loadSysInterface` and implement the necessary bits of interface fetching directly in `loadHiFile`, where `loadSysInterface` use to be invoked. - - - - - 5da11526 by Wolfgang Jeltsch at 2026-10-02T00:33:09+03:00 Statically enforce module interface reduction for the PIT `GHC.Iface.Load.loadInterface` used to replace certain fields of each fetched module interface by `panic` applications before storing it in the PIT. With the present change, the absence of those fields in the PIT is guaranteed statically. See #27044 for the bigger picture. - - - - - 22 changed files: - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session/Inspect.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Load.hs-boot - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Unit/External.hs - compiler/GHC/Unit/Module/ModIface.hs - ghc/Main.hs - utils/haddock/haddock-api/src/Haddock/Interface.hs Changes: ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -688,7 +688,8 @@ expandFixedModuleNode key loc = do -- part of the compiler. lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case Just iface -> return (M.Succeeded iface) - Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc) + Nothing -> fmap shrinkModIface <$> + readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc) case read_result of M.Succeeded iface -> do -- Computer information about this node ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -372,10 +372,10 @@ lookupIfaceByModule :: HomeUnitGraph -> PackageIfaceTable -> Module - -> IO (Maybe ModIface) + -> IO (Maybe RetainedModIface) lookupIfaceByModule hug pit mod = HUG.lookupHugByModule mod hug >>= pure . \case - Just hm -> Just (hm_iface hm) + Just hm -> Just (shrinkModIface (hm_iface hm)) Nothing -> lookupModuleEnv pit mod -- If the module does come from the home package, why do we look in the PIT as well? -- (a) In OneShot mode, even home-package modules accumulate in the PIT @@ -384,7 +384,7 @@ lookupIfaceByModule hug pit mod -- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package -- of its own, but it doesn't seem worth the bother. -lookupIfaceByModuleHsc :: HscEnv -> Module -> IO (Maybe ModIface) +lookupIfaceByModuleHsc :: HscEnv -> Module -> IO (Maybe RetainedModIface) lookupIfaceByModuleHsc hsc_env mod = do eps <- hscEPS hsc_env lookupIfaceByModule (hsc_HUG hsc_env) (eps_PIT eps) mod ===================================== compiler/GHC/Driver/Main/Interactive.hs ===================================== @@ -148,7 +148,7 @@ hscIsGHCiMonad :: HscEnv -> String -> IO Name hscIsGHCiMonad hsc_env name = runHsc hsc_env $ ioMsgMaybe $ hoistTcRnMessage $ isGHCiMonad hsc_env name -hscGetModuleInterface :: HscEnv -> Module -> IO ModIface +hscGetModuleInterface :: HscEnv -> Module -> IO RetainedModIface hscGetModuleInterface hsc_env0 mod = runInteractiveHsc hsc_env0 $ do hsc_env <- getHscEnv ioMsgMaybe $ hoistTcRnMessage $ getModuleInterface hsc_env mod @@ -270,7 +270,7 @@ hscCheckSafe' m l = do _ | isHomeModule home_unit mod -> True _ -> isUnitTrusted unit_state (moduleUnit m) - lookup' :: Module -> Hsc (Maybe ModIface) + lookup' :: Module -> Hsc (Maybe RetainedModIface) lookup' m = do hsc_env <- getHscEnv iface <- liftIO $ lookupIfaceByModuleHsc hsc_env m ===================================== compiler/GHC/Driver/Main/Passes.hs ===================================== @@ -1335,7 +1335,7 @@ hscCheckSafe' m l = do _ | isHomeModule home_unit mod -> True _ -> isUnitTrusted unit_state (moduleUnit m) - lookup' :: Module -> Hsc (Maybe ModIface) + lookup' :: Module -> Hsc (Maybe RetainedModIface) lookup' m = do hsc_env <- getHscEnv iface <- liftIO $ lookupIfaceByModuleHsc hsc_env m ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -224,7 +224,7 @@ data PluginWithArgs = PluginWithArgs data LoadedPlugin = LoadedPlugin { lpPlugin :: PluginWithArgs -- ^ the actual plugin together with its commandline arguments - , lpModule :: ModIface + , lpModule :: RetainedModIface -- ^ the module containing the plugin } ===================================== compiler/GHC/Driver/Session/Inspect.hs ===================================== @@ -87,7 +87,7 @@ data ModuleInfo = ModuleInfo { minf_type_env :: TypeEnv, minf_exports :: [AvailInfo], minf_instances :: [ClsInst], - minf_iface :: Maybe ModIface, + minf_iface :: Maybe RetainedModIface, minf_safe :: SafeHaskellMode, minf_modBreaks :: Maybe InternalModBreaks } @@ -140,7 +140,7 @@ getHomeModuleInfo hsc_env mdl = Nothing -> return Nothing Just hmi -> do let details = hm_details hmi - iface = hm_iface hmi + iface = shrinkModIface (hm_iface hmi) return (Just (ModuleInfo { minf_type_env = md_types details, minf_exports = md_exports details, @@ -187,7 +187,7 @@ modInfoLookupName minf name = withSession $ \hsc_env -> do Just tyThing -> return (Just tyThing) Nothing -> liftIO (lookupType hsc_env name) -modInfoIface :: ModuleInfo -> Maybe ModIface +modInfoIface :: ModuleInfo -> Maybe RetainedModIface modInfoIface = minf_iface -- | Retrieve module safe haskell mode ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -276,7 +276,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports imp_decls u -- a) we used something from it; has something in used_names -- b) we imported it, even if we used nothing from it -- (need to recompile if its export list changes: export_fprint) - mkUsage :: Module -> ModIface -> Maybe Usage + mkUsage :: Module -> RetainedModIface -> Maybe Usage mkUsage mod iface | toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, @@ -302,9 +302,9 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports imp_decls u usg_entities = Map.toList ent_hashs, usg_safe = imp_safe } where - finsts_mod = mi_finsts iface + finsts_mod = mi_abi_finsts (mi_abi_hashes iface) hash_env = mi_hash_fn iface - mod_hash = mi_mod_hash iface + mod_hash = mi_abi_mod_hash (mi_abi_hashes iface) imported_exports = if not depend_on_exports then Nothing @@ -312,9 +312,9 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports imp_decls u Just $ HomeModImport { hmiu_orphanLikeHash - = mi_orphan_like_hash iface + = mi_abi_orphan_like_hash (mi_abi_hashes iface) , hmiu_importedAvails - = moduleImportedAvails mod (mi_export_avails_hash iface) imp_decls + = moduleImportedAvails mod (mi_abi_export_avails_hash (mi_abi_hashes iface)) imp_decls } by_is_safe (ImportedByUser imv) = imv_is_safe imv ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -308,7 +308,7 @@ loadKnownKeyOccMaps known_key_maps :: Module -> IfM lcl KnownKeyNameMaps known_key_maps mod = do { iface <- loadInterfaceWithException doc mod ImportBySystem - ; let !abi_hash = mi_mod_hash iface + ; let !abi_hash = mi_abi_mod_hash (mi_abi_hashes iface) ; eps <- getEps ; case lookupModuleEnv (eps_known_keys eps) mod of Just (cached_hash, kk_maps) @@ -321,7 +321,7 @@ loadKnownKeyOccMaps (abi_hash, kk_maps) } ; return kk_maps } } - build_maps :: ModIface -> KnownKeyNameMaps + build_maps :: RetainedModIface -> KnownKeyNameMaps build_maps iface = (kk_map, occ_map) where kk_map :: UniqFM KnownKey Name @@ -628,7 +628,7 @@ loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -- {-# SOURCE #-} ? -> PkgQual -- "package", if any - -> RnM ModIface + -> RnM RetainedModIface loadSrcInterface doc scope mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc scope mod want_boot maybe_pkg @@ -648,7 +648,7 @@ loadSrcInterface_maybe :: SDoc -> ModuleName -> IsBootInterface -- {-# SOURCE #-} ? -> PkgQual -- "package", if any - -> RnM (MaybeErr MissingInterfaceError ModIface) + -> RnM (MaybeErr MissingInterfaceError RetainedModIface) loadSrcInterface_maybe doc scope mod want_boot maybe_pkg -- We must first find which Module this import refers to. This involves @@ -667,7 +667,7 @@ loadSrcInterface_maybe doc scope mod want_boot maybe_pkg -- rare operation, but in particular it is used to load orphan modules -- in order to pull their instances into the global package table and to -- handle some operations in GHCi). -loadModuleInterface :: SDoc -> Module -> TcM ModIface +loadModuleInterface :: SDoc -> Module -> TcM RetainedModIface loadModuleInterface doc mod = initIfaceTcRn (loadSysInterface doc mod) -- | Load interfaces for a collection of modules. @@ -681,7 +681,7 @@ loadModuleInterfaces doc mods -- | Loads the interface for a given Name. -- Should only be called for an imported name; -- otherwise loadSysInterface may not find the interface -loadInterfaceForName :: SDoc -> Name -> TcRn ModIface +loadInterfaceForName :: SDoc -> Name -> TcRn RetainedModIface loadInterfaceForName doc name = do { when debugIsOn $ -- Check pre-condition do { this_mod <- getModule @@ -690,7 +690,7 @@ loadInterfaceForName doc name initIfaceTcRn $ loadSysInterface doc (nameModule name) } -- | Loads the interface for a given Module. -loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface +loadInterfaceForModule :: SDoc -> Module -> TcRn RetainedModIface loadInterfaceForModule doc m = do -- Should not be called with this module @@ -724,23 +724,23 @@ loadWiredInHomeIface name ------------------ -- | Loads a system interface and throws an exception if it fails -loadSysInterface :: SDoc -> Module -> IfM lcl ModIface +loadSysInterface :: SDoc -> Module -> IfM lcl RetainedModIface loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem ------------------ -- | Loads a user interface and throws an exception if it fails. The first parameter indicates -- whether we should import the boot variant of the module -loadUserInterface :: IsBootInterface -> SDoc -> Module -> IfM lcl ModIface +loadUserInterface :: IsBootInterface -> SDoc -> Module -> IfM lcl RetainedModIface loadUserInterface is_boot doc mod_name = loadInterfaceWithException doc mod_name (ImportByUser is_boot) -loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface +loadPluginInterface :: SDoc -> Module -> IfM lcl RetainedModIface loadPluginInterface doc mod_name = loadInterfaceWithException doc mod_name ImportByPlugin ------------------ -- | A wrapper for 'loadInterface' that throws an exception if it fails -loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface +loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl RetainedModIface loadInterfaceWithException doc mod_name where_from = do dflags <- getDynFlags @@ -749,7 +749,7 @@ loadInterfaceWithException doc mod_name where_from ------------------ loadInterface :: SDoc -> Module -> WhereFrom - -> IfM lcl (MaybeErr MissingInterfaceError ModIface) + -> IfM lcl (MaybeErr MissingInterfaceError RetainedModIface) -- loadInterface looks in both the HPT and PIT for the required interface -- If not found, it loads it, and puts it in the PIT (always). @@ -796,7 +796,7 @@ loadInterface doc_str mod from liftIO $ computeInterface hsc_env doc_str hi_boot_file mod ; case read_result of { Failed err -> do - { let fake_iface = emptyFullModIface mod + { let fake_iface = shrinkModIface (emptyFullModIface mod) ; updateEps_ $ \eps -> eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface } @@ -856,16 +856,7 @@ loadInterface doc_str mod from ; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) ; purged_hsc_env <- getTopEnv - ; let final_iface = iface - & set_mi_decls (panic "No mi_decls in PIT") - & set_mi_insts (panic "No mi_insts in PIT") - & set_mi_defaults (panic "No mi_defaults in PIT") - & set_mi_fam_insts (panic "No mi_fam_insts in PIT") - & set_mi_rules (panic "No mi_rules in PIT") - & set_mi_anns (panic "No mi_anns in PIT") - & set_mi_simplified_core (panic "No mi_simplified_core in PIT") - - bad_boot = mi_boot iface == IsBoot + ; let bad_boot = mi_boot iface == IsBoot && isJust (lookupKnotVars (if_rec_types gbl_env) mod) -- Warn against an EPS-updating import -- of one's own boot file! (one-shot only) @@ -892,7 +883,7 @@ loadInterface doc_str mod from then eps { eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls } else eps { - eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface, + eps_PIT = extendModuleEnv (eps_PIT eps) mod (shrinkModIface iface), eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls, eps_iface_bytecode = add_bytecode (eps_iface_bytecode eps), eps_rule_base = extendRuleBaseList (eps_rule_base eps) @@ -921,10 +912,8 @@ loadInterface doc_str mod from eps_defaults = extendModuleEnv (eps_defaults eps) mod new_eps_defaults } - ; -- invoke plugins with *full* interface, not final_iface, to ensure - -- that plugins have access to declarations, etc. - res <- withPlugins (hsc_plugins hsc_env) (\p -> interfaceLoadAction p) iface - ; return (Succeeded res) + ; res <- withPlugins (hsc_plugins hsc_env) (\p -> interfaceLoadAction p) iface + ; return (Succeeded (shrinkModIface res)) }}}} {- Note [Loading your own hi-boot file] ===================================== compiler/GHC/Iface/Load.hs-boot ===================================== @@ -2,7 +2,7 @@ module GHC.Iface.Load where import GHC.Unit.Module (Module) import GHC.Tc.Utils.Monad (IfM) -import GHC.Unit.Module.ModIface (ModIface) +import GHC.Unit.Module.ModIface (RetainedModIface) import GHC.Utils.Outputable (SDoc) -loadSysInterface :: SDoc -> Module -> IfM lcl ModIface +loadSysInterface :: SDoc -> Module -> IfM lcl RetainedModIface ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -707,7 +707,7 @@ checkDependencies hsc_env summary iface return $ needsRecompileBecause $ ModulePackageChanged new_name -needInterface :: Module -> (ModIface -> IO RecompileRequired) +needInterface :: Module -> (RetainedModIface -> IO RecompileRequired) -> IfG RecompileRequired needInterface mod continue = do @@ -727,7 +727,7 @@ needBytecode mod continue Nothing -> return $ NeedsRecompile MustCompile Just mbc -> liftIO $ continue mbc -tryGetModIface :: String -> Module -> IfG (Maybe ModIface) +tryGetModIface :: String -> Module -> IfG (Maybe RetainedModIface) tryGetModIface doc_msg mod = do -- Load the imported interface if possible logger <- getLogger @@ -779,7 +779,7 @@ checkModUsage _ UsagePackageModule{ logger <- getLogger needInterface mod $ \iface -> do let reason = ModuleChanged (moduleName mod) - checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface) + checkModuleFingerprint logger reason old_mod_hash (mi_abi_mod_hash (mi_abi_hashes iface)) -- We only track the ABI hash of package modules, rather than -- individual entity usages, so if the ABI hash changes we must -- recompile. This is safe but may entail more recompilation when @@ -789,7 +789,7 @@ checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_ha logger <- getLogger needInterface mod $ \iface -> do let reason = ModuleChangedRaw (moduleName mod) - checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface) + checkModuleFingerprint logger reason old_mod_hash (mi_abi_mod_hash (mi_abi_hashes iface)) checkModUsage _ UsageHomeModuleBytecode{ usg_mod_name = mod_name , usg_unit_id = uid , usg_bytecode_hash = old_bytecode_hash } = do @@ -810,7 +810,7 @@ checkModUsage _ UsageHomeModule{ logger <- getLogger needInterface mod $ \iface -> do let - new_mod_hash = mi_mod_hash iface + new_mod_hash = mi_abi_mod_hash (mi_abi_hashes iface) new_decl_hash = mi_hash_fn iface reason = ModuleChanged (moduleName mod) @@ -864,7 +864,7 @@ checkModUsage fc UsageDirectory{ usg_dir_path = dir, -- Does this require recompilation? -- -- See Note [When to recompile when export lists change?] -checkHomeModImport :: Logger -> RecompReason -> Maybe HomeModImport -> ModIface -> IO RecompileRequired +checkHomeModImport :: Logger -> RecompReason -> Maybe HomeModImport -> RetainedModIface -> IO RecompileRequired checkHomeModImport _ _ Nothing _ = return UpToDate checkHomeModImport logger reason (Just (HomeModImport old_orphan_like_hash old_avails)) @@ -901,8 +901,8 @@ checkHomeModImport logger reason 2 (ppr changes) return $ needsRecompileBecause reason where - new_orphan_like_hash = mi_orphan_like_hash iface - new_avails_hash = mi_export_avails_hash iface + new_orphan_like_hash = mi_abi_orphan_like_hash (mi_abi_hashes iface) + new_avails_hash = mi_abi_export_avails_hash (mi_abi_hashes iface) new_exports = mi_exports iface -- | The exported avails of a module have changed. Should this cause recompilation @@ -1617,7 +1617,7 @@ getOrphanHashes hsc_env mods = do get_orph_hash mod = do iface <- initIfaceLoad hsc_env . withIfaceErr ctx $ loadInterface (text "getOrphanHashes") mod ImportBySystem - return (mi_orphan_hash iface) + return (mi_abi_orphan_hash (mi_abi_hashes iface)) mapM get_orph_hash mods ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -517,7 +517,7 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of -- interface, but without 'imp_mods'. calculateAvails :: HomeUnit -> S.Set UnitId - -> ModIface + -> RetainedModIface -> IsSafeImport -> IsBootInterface -> ImportedBy @@ -525,8 +525,8 @@ calculateAvails :: HomeUnit calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by = let imp_mod = mi_module iface imp_sem_mod= mi_semantic_module iface - orph_iface = mi_orphan iface - has_finsts = mi_finsts iface + orph_iface = mi_abi_orphan (mi_abi_hashes iface) + has_finsts = mi_abi_finsts (mi_abi_hashes iface) deps = mi_deps iface trust = getSafeMode $ mi_trust iface trust_pkg = mi_trust_pkg iface @@ -1209,7 +1209,7 @@ gresFromAvail hsc_env prov avail = gresFromAvails :: HscEnv -> Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt] gresFromAvails hsc_env prov = concatMap (gresFromAvail hsc_env prov) -importsFromIface :: HscEnv -> ModIface -> ImpDeclSpec -> Maybe NameSet -> GlobalRdrEnv +importsFromIface :: HscEnv -> RetainedModIface -> ImpDeclSpec -> Maybe NameSet -> GlobalRdrEnv importsFromIface hsc_env iface decl_spec hidden = mkGlobalRdrEnv $ case hidden of Nothing -> all_gres Just hidden_names -> filter (not . (`elemNameSet` hidden_names) . greName) all_gres @@ -1225,7 +1225,7 @@ rnNamespaceSpecifier (DataNamespaceSpecifier x) = DataNamespaceSpecifier x filterImports :: HasDebugCallStack => HscEnv - -> ModIface + -> RetainedModIface -> ImpDeclSpec -- ^ Import spec -> Maybe (ImportListInterpretation, [LIE GhcPs]) @@ -2327,7 +2327,7 @@ getMinimalImports ie_decls where doc = text "Compute minimal imports for" <+> ppr decl - to_ie :: GlobalRdrEnv -> ModIface -> AvailInfo -> RnM [IE GhcRn] + to_ie :: GlobalRdrEnv -> RetainedModIface -> AvailInfo -> RnM [IE GhcRn] -- The main trick here is that if we're importing all the constructors -- we want to say "T(..)", but if we're importing only a subset we want -- to say "T(A,B,C)". So we have to find out what the module exports. @@ -2529,7 +2529,7 @@ DRFPatSynExport for a test of this. -} badImportItemErr - :: ModIface -> ImpDeclSpec -> IE GhcPs + :: RetainedModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinateError -> [AvailInfo] -> TcRn (NonEmpty ImportLookupReason) ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -534,7 +534,7 @@ warnIfDeclDeprecated gre@(GRE { gre_imp = iss }) definedMod = moduleName $ assertPpr (isExternalName name) (ppr name) (nameModule name) doc = text "The name" <+> quotes (ppr occ) <+> text "is mentioned explicitly" -lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn) +lookupImpDeclDeprec :: RetainedModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn) lookupImpDeclDeprec iface gre -- Bleat if the thing, or its parent, is warn'd = mi_decl_warn_fn iface (greOccName gre) `mplus` ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -190,7 +190,7 @@ checkExternalInterpreter hsc_env = case interpInstance <$> hsc_interp hsc_env of -> throwIO (InstallationError "Plugins require -fno-external-interpreter") _ -> pure () -loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [LinkableUsage], PkgsLoaded) +loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, RetainedModIface, [LinkableUsage], PkgsLoaded) loadPlugin' occ_name plugin_name hsc_env mod_name = do { let plugin_rdr_name = mkRdrQual mod_name occ_name dflags = hsc_dflags hsc_env @@ -341,7 +341,7 @@ lessUnsafeCoerce logger context what = do -- Need the module as well to record information in the interface file lookupRdrNameInModuleForPlugins :: HasDebugCallStack => HscEnv -> ModuleName -> RdrName - -> IO (Maybe (Name, ModIface)) + -> IO (Maybe (Name, RetainedModIface)) lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do let dflags = hsc_dflags hsc_env -- First find the unit the module resides in by searching exposed units and home modules ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -6386,7 +6386,7 @@ pprImportLookup :: ImportLookupReason -> SDoc pprImportLookup = \case ImportLookupBad k iface decl_spec ie _exts -> let - pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc + pprImpDeclSpec :: RetainedModIface -> ImpDeclSpec -> SDoc pprImpDeclSpec iface decl_spec = quotes (ppr (moduleName $ is_mod decl_spec)) <+> case mi_boot iface of IsBoot -> text "(hi-boot interface)" ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -215,7 +215,7 @@ import GHC.Types.DefaultEnv (ClassDefaults) import GHC.Unit.Types (Module) import GHC.Unit.State (UnitState) -import GHC.Unit.Module.ModIface (ModIface) +import GHC.Unit.Module.ModIface (RetainedModIface) import GHC.Utils.Outputable @@ -6635,7 +6635,7 @@ data ImportLookupReason where T9006, T11071, T9905fail2, T5385, T10668 -} ImportLookupBad :: BadImportKind - -> ModIface + -> RetainedModIface -> ImpDeclSpec -> IE GhcPs -> ImportLookupExtensions ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1693,7 +1693,7 @@ lookupArgDoc i nm = do _ -> pure Nothing -- | Returns the module a Name belongs to, if it is isn't local. -getExternalModIface :: Name -> TcM (Maybe ModIface) +getExternalModIface :: Name -> TcM (Maybe RetainedModIface) getExternalModIface nm = do isLocal <- nameIsLocalOrFrom <$> getModule <*> pure nm if isLocal ===================================== compiler/GHC/Tc/Instance/Family.hs ===================================== @@ -308,7 +308,7 @@ checkFamInstConsistency directlyImpMods ifc <- modIface mod deps <- dep_finsts . mi_deps <$> modIface mod pure $ - if mi_finsts ifc + if mi_abi_finsts (mi_abi_hashes ifc) then mod:deps else deps ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2964,7 +2964,7 @@ externaliseAndTidyId this_mod id -- a package module with an interface on disk. If neither of these is -- true, then the result will be an error indicating the interface -- could not be found. -getModuleInterface :: HscEnv -> Module -> IO (Messages TcRnMessage, Maybe ModIface) +getModuleInterface :: HscEnv -> Module -> IO (Messages TcRnMessage, Maybe RetainedModIface) getModuleInterface hsc_env mod = runTcInteractive NoTcMPlugins hsc_env $ loadModuleInterface (text "getModuleInterface") mod ===================================== compiler/GHC/Unit/External.hs ===================================== @@ -49,7 +49,7 @@ type PackageAnnEnv = AnnEnv type PackageCompleteMatches = CompleteMatches -- | Helps us find information about modules in the imported packages -type PackageIfaceTable = ModuleEnv ModIface +type PackageIfaceTable = ModuleEnv RetainedModIface -- Domain = modules in the imported packages -- | Constructs an empty PackageIfaceTable ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE RecordWildCards #-} module GHC.Unit.Module.ModIface ( ModIface @@ -68,19 +69,31 @@ module GHC.Unit.Module.ModIface , set_mi_fix_fn , set_mi_hash_fn , completePartialModIface + , shrinkModIface , IfaceBinHandle(..) , PartialModIface + , RetainedModIface , IfaceAbiHashes (..) , IfaceSelfRecomp (..) , IfaceCache (..) , IfaceSimplifiedCore (..) , withSelfRecomp - , IfaceDeclExts - , IfaceAbiHashesExts + , IfaceSelfRecompData + , IfaceSimplifiedCoreData + , ExtensibleFieldsData + , IfaceAnnotationsData + , IfaceDeclsData + , IfaceDefaultsData + , IfaceClsInstsData + , IfaceFamInstsData + , IfaceRulesData + , IfaceCompleteMatchesData + , IfaceAbiHashesData , IfaceExport , IfacePublic_(..) , IfacePublic , PartialIfacePublic + , RetainedIfacePublic , IfaceModInfo(..) , WhetherHasOrphans , WhetherHasFamInst @@ -167,9 +180,11 @@ We can build a full interface file two ways: type PartialModIface = ModIface_ 'ModIfaceCore type ModIface = ModIface_ 'ModIfaceFinal +type RetainedModIface = ModIface_ 'ModIfaceRetained type PartialIfacePublic = IfacePublic_ 'ModIfaceCore type IfacePublic = IfacePublic_ 'ModIfaceFinal +type RetainedIfacePublic = IfacePublic_ 'ModIfaceRetained -- | Extends a PartialModIface with hashes of the ABI. -- @@ -212,19 +227,11 @@ data IfaceCache = IfaceCache data ModIfacePhase = ModIfaceCore - -- ^ Partial interface built based on output of core pipeline. + -- ^ Partial interface built from the output of the core pipeline | ModIfaceFinal - --- | Selects a IfaceDecl representation. --- For fully instantiated interfaces we also maintain --- a fingerprint, which is used for recompilation checks. -type family IfaceDeclExts (phase :: ModIfacePhase) = decl | decl -> phase where - IfaceDeclExts 'ModIfaceCore = IfaceDecl - IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl) - -type family IfaceAbiHashesExts (phase :: ModIfacePhase) = bk | bk -> phase where - IfaceAbiHashesExts 'ModIfaceCore = () - IfaceAbiHashesExts 'ModIfaceFinal = IfaceAbiHashes + -- ^ Complete interface + | ModIfaceRetained + -- ^ Interface shrunk to the parts that may be retained -- | In-memory byte array representation of a 'ModIface'. -- @@ -237,9 +244,66 @@ data IfaceBinHandle (phase :: ModIfacePhase) where -- See Note [Private fields in ModIface] for when this fields needs to be cleared -- (e.g., set to 'Nothing'). FullIfaceBinHandle :: !(Strict.Maybe FullBinData) -> IfaceBinHandle 'ModIfaceFinal - - -withSelfRecomp :: ModIface_ phase -> r -> (IfaceSelfRecomp -> r) -> r + RetainedIfaceBinHandle :: IfaceBinHandle 'ModIfaceRetained + +type family IfaceSelfRecompData (phase :: ModIfacePhase) where + IfaceSelfRecompData 'ModIfaceCore = Maybe IfaceSelfRecomp + IfaceSelfRecompData 'ModIfaceFinal = Maybe IfaceSelfRecomp + IfaceSelfRecompData 'ModIfaceRetained = () + +type family IfaceSimplifiedCoreData (phase :: ModIfacePhase) where + IfaceSimplifiedCoreData 'ModIfaceCore = Maybe IfaceSimplifiedCore + IfaceSimplifiedCoreData 'ModIfaceFinal = Maybe IfaceSimplifiedCore + IfaceSimplifiedCoreData 'ModIfaceRetained = () + +type family ExtensibleFieldsData (phase :: ModIfacePhase) where + ExtensibleFieldsData 'ModIfaceCore = ExtensibleFields + ExtensibleFieldsData 'ModIfaceFinal = ExtensibleFields + ExtensibleFieldsData 'ModIfaceRetained = () + +type family IfaceAnnotationsData (phase :: ModIfacePhase) where + IfaceAnnotationsData 'ModIfaceCore = [IfaceAnnotation] + IfaceAnnotationsData 'ModIfaceFinal = [IfaceAnnotation] + IfaceAnnotationsData 'ModIfaceRetained = () + +-- | The fingerprint in the 'ModIfaceFinal' case is used for recompilation +-- checks. +type family IfaceDeclsData (phase :: ModIfacePhase) where + IfaceDeclsData 'ModIfaceCore = [IfaceDecl] + IfaceDeclsData 'ModIfaceFinal = [(Fingerprint, IfaceDecl)] + IfaceDeclsData 'ModIfaceRetained = () + +type family IfaceDefaultsData (phase :: ModIfacePhase) where + IfaceDefaultsData 'ModIfaceCore = [IfaceDefault] + IfaceDefaultsData 'ModIfaceFinal = [IfaceDefault] + IfaceDefaultsData 'ModIfaceRetained = () + +type family IfaceClsInstsData (phase :: ModIfacePhase) where + IfaceClsInstsData 'ModIfaceCore = [IfaceClsInst] + IfaceClsInstsData 'ModIfaceFinal = [IfaceClsInst] + IfaceClsInstsData 'ModIfaceRetained = () + +type family IfaceFamInstsData (phase :: ModIfacePhase) where + IfaceFamInstsData 'ModIfaceCore = [IfaceFamInst] + IfaceFamInstsData 'ModIfaceFinal = [IfaceFamInst] + IfaceFamInstsData 'ModIfaceRetained = () + +type family IfaceRulesData (phase :: ModIfacePhase) where + IfaceRulesData 'ModIfaceCore = [IfaceRule] + IfaceRulesData 'ModIfaceFinal = [IfaceRule] + IfaceRulesData 'ModIfaceRetained = () + +type family IfaceCompleteMatchesData (phase :: ModIfacePhase) where + IfaceCompleteMatchesData 'ModIfaceCore = [IfaceCompleteMatch] + IfaceCompleteMatchesData 'ModIfaceFinal = [IfaceCompleteMatch] + IfaceCompleteMatchesData 'ModIfaceRetained = () + +type family IfaceAbiHashesData (phase :: ModIfacePhase) where + IfaceAbiHashesData 'ModIfaceCore = () + IfaceAbiHashesData 'ModIfaceFinal = IfaceAbiHashes + IfaceAbiHashesData 'ModIfaceRetained = IfaceAbiHashes + +withSelfRecomp :: ModIface -> r -> (IfaceSelfRecomp -> r) -> r withSelfRecomp iface nk jk = case mi_self_recomp_info iface of Nothing -> nk @@ -279,11 +343,11 @@ data ModIface_ (phase :: ModIfacePhase) -- importing this module. The main, original part of an interface. - mi_self_recomp_ :: Maybe IfaceSelfRecomp, + mi_self_recomp_ :: IfaceSelfRecompData phase, -- ^ Information needed for checking self-recompilation. -- See Note [Self recompilation information in interface files] - mi_simplified_core_ :: Maybe IfaceSimplifiedCore, + mi_simplified_core_ :: IfaceSimplifiedCoreData phase, -- ^ The part of the interface written when `-fwrite-if-simplified-core` is enabled. -- These parts are used to restart bytecode generation. @@ -301,7 +365,7 @@ data ModIface_ (phase :: ModIfacePhase) -- defined by the user). Used for GHCi and for inspecting -- the contents of modules via the GHC API only. - mi_ext_fields_ :: ExtensibleFields + mi_ext_fields_ :: ExtensibleFieldsData phase -- ^ Additional optional fields, where the Map key represents -- the field name, resulting in a (size, serialized data) pair. -- Because the data is intended to be serialized through the @@ -334,12 +398,12 @@ data IfacePublic_ phase = IfacePublic { -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file - mi_anns_ :: [IfaceAnnotation], + mi_anns_ :: IfaceAnnotationsData phase, -- ^ Annotations -- NOT STRICT! we read this field lazily from the interface file - mi_decls_ :: [IfaceDeclExts phase], + mi_decls_ :: IfaceDeclsData phase, -- ^ Type, class and variable declarations -- The hash of an Id changes if its fixity or deprecations change -- (as well as its type of course) @@ -347,14 +411,14 @@ data IfacePublic_ phase = IfacePublic { -- the hash of the parent class/tycon changes - mi_defaults_ :: [IfaceDefault], + mi_defaults_ :: IfaceDefaultsData phase, -- ^ default declarations exported by the module -- Instance declarations and rules - mi_insts_ :: [IfaceClsInst], -- ^ Sorted class instance - mi_fam_insts_ :: [IfaceFamInst], -- ^ Sorted family instances - mi_rules_ :: [IfaceRule], -- ^ Sorted rules + mi_insts_ :: IfaceClsInstsData phase, -- ^ Sorted class instance + mi_fam_insts_ :: IfaceFamInstsData phase, -- ^ Sorted family instances + mi_rules_ :: IfaceRulesData phase, -- ^ Sorted rules mi_trust_ :: IfaceTrustInfo, @@ -367,20 +431,20 @@ data IfacePublic_ phase = IfacePublic { -- itself) but imports some trustworthy modules from its own -- package (which does require its own package be trusted). -- See Note [Trust Own Package] in GHC.Rename.Names - mi_complete_matches_ :: [IfaceCompleteMatch], + mi_complete_matches_ :: IfaceCompleteMatchesData phase, -- ^ {-# COMPLETE #-} declarations mi_caches_ :: IfaceCache, -- ^ Cached lookups of some parts of mi_public - mi_abi_hashes_ :: (IfaceAbiHashesExts phase) + mi_abi_hashes_ :: IfaceAbiHashesData phase -- ^ Either `()` or `IfaceAbiHashes` for -- a fully instantiated interface. -- These fields are hashes of different parts of the public interface. } mkIfacePublic :: [IfaceExport] - -> [IfaceDeclExts 'ModIfaceFinal] + -> [(Fingerprint, IfaceDecl)] -> [(OccName, Fixity)] -> IfaceWarnings -> [IfaceAnnotation] @@ -501,22 +565,22 @@ That's why in GHC.Driver.Main.hscMaybeWriteIface there is the call to forceModIface. -} -mi_flag_hash :: ModIface_ phase -> Maybe (FingerprintWithValue IfaceDynFlags) +mi_flag_hash :: ModIface -> Maybe (FingerprintWithValue IfaceDynFlags) mi_flag_hash = fmap mi_sr_flag_hash . mi_self_recomp_ -mi_opt_hash :: ModIface_ phase -> Maybe Fingerprint +mi_opt_hash :: ModIface -> Maybe Fingerprint mi_opt_hash = fmap mi_sr_opt_hash . mi_self_recomp_ -mi_hpc_hash :: ModIface_ phase -> Maybe Fingerprint +mi_hpc_hash :: ModIface -> Maybe Fingerprint mi_hpc_hash = fmap mi_sr_hpc_hash . mi_self_recomp_ -mi_src_hash :: ModIface_ phase -> Maybe Fingerprint +mi_src_hash :: ModIface -> Maybe Fingerprint mi_src_hash = fmap mi_sr_src_hash . mi_self_recomp_ -mi_usages :: ModIface_ phase -> Maybe [Usage] +mi_usages :: ModIface -> Maybe [Usage] mi_usages = fmap mi_sr_usages . mi_self_recomp_ -mi_plugin_hash :: ModIface_ phase -> Maybe Fingerprint +mi_plugin_hash :: ModIface -> Maybe Fingerprint mi_plugin_hash = fmap mi_sr_plugin_hash . mi_self_recomp_ -- | Accessor for the module hash of the ABI from a ModIface. @@ -547,7 +611,7 @@ mi_orphan_hash iface = mi_abi_orphan_hash (mi_abi_hashes iface) -- | Old-style accessor for whether or not the ModIface came from an hs-boot -- file. -mi_boot :: ModIface -> IsBootInterface +mi_boot :: ModIface_ phase -> IsBootInterface mi_boot iface = if mi_hsc_src iface == HsBootFile then IsBoot else NotBoot @@ -557,7 +621,7 @@ mi_mnwib iface = GWIB (moduleName $ mi_module iface) (mi_boot iface) -- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be -- found, 'defaultFixity' is returned instead. -mi_fix :: ModIface -> OccName -> Fixity +mi_fix :: ModIface_ phase -> OccName -> Fixity mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity -- | The semantic module for this interface; e.g., if it's a interface @@ -573,7 +637,7 @@ mi_semantic_module iface = mi_mod_info_semantic_module (mi_mod_info iface) -- | The "precise" free holes, e.g., the signatures that this -- 'ModIface' depends on. -mi_free_holes :: ModIface -> UniqDSet ModuleName +mi_free_holes :: ModIface_ phase -> UniqDSet ModuleName mi_free_holes iface = case getModuleInstantiation (mi_module iface) of (_, Just indef) @@ -771,7 +835,7 @@ emptyPartialModIface mod mi_iface_hash_ = fingerprint0, mi_hi_bytes_ = PartialIfaceBinHandle, mi_deps_ = noDependencies, - mi_public_ = emptyPublicModIface (), + mi_public_ = emptyPublicModIface [] [] [] [] [] [] [] (), mi_simplified_core_ = Nothing, mi_top_env_ = IfaceTopEnv emptyDetOrdAvails [] , mi_docs_ = Nothing, @@ -787,24 +851,39 @@ emptyIfaceModInfo mod = IfaceModInfo , mi_mod_info_hsc_src = HsSrcFile } - -emptyPublicModIface :: IfaceAbiHashesExts phase -> IfacePublic_ phase -emptyPublicModIface abi_hashes = IfacePublic - { mi_exports_ = [] - , mi_decls_ = [] - , mi_fixities_ = [] - , mi_warns_ = IfWarnSome [] [] - , mi_anns_ = [] - , mi_defaults_ = [] - , mi_insts_ = [] - , mi_fam_insts_ = [] - , mi_rules_ = [] - , mi_abi_hashes_ = abi_hashes - , mi_trust_ = noIfaceTrustInfo - , mi_trust_pkg_ = False - , mi_caches_ = emptyModIfaceCache - , mi_complete_matches_ = [] - } +emptyPublicModIface :: IfaceAnnotationsData phase + -> IfaceDeclsData phase + -> IfaceDefaultsData phase + -> IfaceClsInstsData phase + -> IfaceFamInstsData phase + -> IfaceRulesData phase + -> IfaceCompleteMatchesData phase + -> IfaceAbiHashesData phase + -> IfacePublic_ phase +emptyPublicModIface anns + decls + defaults + insts + fam_insts + rules + complete_matches + abi_hashes + = IfacePublic + { mi_exports_ = [] + , mi_fixities_ = [] + , mi_warns_ = IfWarnSome [] [] + , mi_anns_ = anns + , mi_decls_ = decls + , mi_defaults_ = defaults + , mi_insts_ = insts + , mi_fam_insts_ = fam_insts + , mi_rules_ = rules + , mi_trust_ = noIfaceTrustInfo + , mi_trust_pkg_ = False + , mi_complete_matches_ = complete_matches + , mi_caches_ = emptyModIfaceCache + , mi_abi_hashes_ = abi_hashes + } emptyModIfaceCache :: IfaceCache emptyModIfaceCache = IfaceCache { @@ -827,7 +906,7 @@ emptyIfaceBackend = IfaceAbiHashes emptyFullModIface :: Module -> ModIface emptyFullModIface mod = (emptyPartialModIface mod) - { mi_public_ = emptyPublicModIface emptyIfaceBackend + { mi_public_ = emptyPublicModIface [] [] [] [] [] [] [] emptyIfaceBackend , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing } @@ -848,8 +927,17 @@ emptyIfaceHashCache _occ = Nothing -- ModIface is completely forced since it will live in memory for a long time. -- If forcing it uses a lot of memory, then store less things in ModIface. -instance ( NFData (IfaceAbiHashesExts (phase :: ModIfacePhase)) - , NFData (IfaceDeclExts (phase :: ModIfacePhase)) +instance ( NFData (IfaceSelfRecompData phase) + , NFData (IfaceSimplifiedCoreData phase) + , NFData (ExtensibleFieldsData phase) + , NFData (IfaceAnnotationsData phase) + , NFData (IfaceDeclsData phase) + , NFData (IfaceDefaultsData phase) + , NFData (IfaceClsInstsData phase) + , NFData (IfaceFamInstsData phase) + , NFData (IfaceRulesData phase) + , NFData (IfaceCompleteMatchesData phase) + , NFData (IfaceAbiHashesData phase) ) => NFData (ModIface_ phase) where rnf (PrivateModIface a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = (a1 :: IfaceBinHandle phase) @@ -882,7 +970,15 @@ instance NFData IfaceAbiHashes where `seq` rnf a5 `seq` rnf a6 -instance (NFData (IfaceAbiHashesExts phase), NFData (IfaceDeclExts phase)) => NFData (IfacePublic_ phase) where +instance ( NFData (IfaceAnnotationsData phase) + , NFData (IfaceDeclsData phase) + , NFData (IfaceDefaultsData phase) + , NFData (IfaceClsInstsData phase) + , NFData (IfaceFamInstsData phase) + , NFData (IfaceRulesData phase) + , NFData (IfaceCompleteMatchesData phase) + , NFData (IfaceAbiHashesData phase) + ) => NFData (IfacePublic_ phase) where rnf (IfacePublic a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) = rnf a1 `seq` rnf a2 @@ -958,7 +1054,6 @@ completePartialModIface partial iface_hash decls extra_decls final_exts cache = , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing , mi_iface_hash_ = iface_hash } - where -- | Given a 'PartialIfacePublic', turn it into an 'IfacePublic' by completing -- missing fields. @@ -973,10 +1068,36 @@ completePublicModIface decls abi_hashes cache partial = partial , mi_caches_ = cache } +shrinkModIface :: ModIface -> RetainedModIface +shrinkModIface PrivateModIface {..} + = PrivateModIface + { + mi_hi_bytes_ = RetainedIfaceBinHandle, + mi_public_ = shrinkIfacePublic mi_public_, + mi_self_recomp_ = (), + mi_simplified_core_ = (), + mi_ext_fields_ = (), + .. + } + +shrinkIfacePublic :: IfacePublic -> RetainedIfacePublic +shrinkIfacePublic IfacePublic {..} + = IfacePublic + { + mi_anns_ = (), + mi_decls_ = (), + mi_defaults_ = (), + mi_insts_ = (), + mi_fam_insts_ = (), + mi_rules_ = (), + mi_complete_matches_ = (), + .. + } + set_mi_mod_info :: IfaceModInfo -> ModIface_ phase -> ModIface_ phase set_mi_mod_info val iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = val } -set_mi_self_recomp :: Maybe IfaceSelfRecomp-> ModIface_ phase -> ModIface_ phase +set_mi_self_recomp :: IfaceSelfRecompData phase -> ModIface_ phase -> ModIface_ phase set_mi_self_recomp val iface = clear_mi_hi_bytes $ iface { mi_self_recomp_ = val } set_mi_hi_bytes :: IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase @@ -988,7 +1109,7 @@ set_mi_deps val iface = clear_mi_hi_bytes $ iface { mi_deps_ = val } set_mi_public :: (IfacePublic_ phase -> IfacePublic_ phase) -> ModIface_ phase -> ModIface_ phase set_mi_public f iface = clear_mi_hi_bytes $ iface { mi_public_ = f (mi_public_ iface) } -set_mi_simplified_core :: Maybe IfaceSimplifiedCore -> ModIface_ phase -> ModIface_ phase +set_mi_simplified_core :: IfaceSimplifiedCoreData phase -> ModIface_ phase -> ModIface_ phase set_mi_simplified_core val iface = clear_mi_hi_bytes $ iface { mi_simplified_core_ = val } set_mi_top_env :: IfaceTopEnv -> ModIface_ phase -> ModIface_ phase @@ -997,7 +1118,7 @@ set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val } set_mi_docs :: Maybe Docs -> ModIface_ phase -> ModIface_ phase set_mi_docs val iface = clear_mi_hi_bytes $ iface { mi_docs_ = val } -set_mi_ext_fields :: ExtensibleFields -> ModIface_ phase -> ModIface_ phase +set_mi_ext_fields :: ExtensibleFieldsData phase -> ModIface_ phase -> ModIface_ phase set_mi_ext_fields val iface = clear_mi_hi_bytes $ iface { mi_ext_fields_ = val } {- Settings for mi_public interface fields -} @@ -1011,22 +1132,22 @@ set_mi_fixities val = set_mi_public (\iface -> iface { mi_fixities_ = val }) set_mi_warns :: IfaceWarnings -> ModIface_ phase -> ModIface_ phase set_mi_warns val = set_mi_public (\iface -> iface { mi_warns_ = val }) -set_mi_anns :: [IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase +set_mi_anns :: IfaceAnnotationsData phase -> ModIface_ phase -> ModIface_ phase set_mi_anns val = set_mi_public (\iface -> iface { mi_anns_ = val }) -set_mi_insts :: [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase +set_mi_insts :: IfaceClsInstsData phase -> ModIface_ phase -> ModIface_ phase set_mi_insts val = set_mi_public (\iface -> iface { mi_insts_ = val }) -set_mi_fam_insts :: [IfaceFamInst] -> ModIface_ phase -> ModIface_ phase +set_mi_fam_insts :: IfaceFamInstsData phase -> ModIface_ phase -> ModIface_ phase set_mi_fam_insts val = set_mi_public (\iface -> iface { mi_fam_insts_ = val }) -set_mi_rules :: [IfaceRule] -> ModIface_ phase -> ModIface_ phase +set_mi_rules :: IfaceRulesData phase -> ModIface_ phase -> ModIface_ phase set_mi_rules val = set_mi_public (\iface -> iface { mi_rules_ = val }) -set_mi_decls :: [IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase +set_mi_decls :: IfaceDeclsData phase -> ModIface_ phase -> ModIface_ phase set_mi_decls val = set_mi_public (\iface -> iface { mi_decls_ = val }) -set_mi_defaults :: [IfaceDefault] -> ModIface_ phase -> ModIface_ phase +set_mi_defaults :: IfaceDefaultsData phase -> ModIface_ phase -> ModIface_ phase set_mi_defaults val = set_mi_public (\iface -> iface { mi_defaults_ = val }) set_mi_trust :: IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase @@ -1035,10 +1156,10 @@ set_mi_trust val = set_mi_public (\iface -> iface { mi_trust_ = val }) set_mi_trust_pkg :: Bool -> ModIface_ phase -> ModIface_ phase set_mi_trust_pkg val = set_mi_public (\iface -> iface { mi_trust_pkg_ = val }) -set_mi_complete_matches :: [IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase +set_mi_complete_matches :: IfaceCompleteMatchesData phase -> ModIface_ phase -> ModIface_ phase set_mi_complete_matches val = set_mi_public (\iface -> iface { mi_complete_matches_ = val }) -set_mi_abi_hashes :: IfaceAbiHashesExts phase -> ModIface_ phase -> ModIface_ phase +set_mi_abi_hashes :: IfaceAbiHashesData phase -> ModIface_ phase -> ModIface_ phase set_mi_abi_hashes val = set_mi_public (\iface -> iface { mi_abi_hashes_ = val }) {- Setters for mi_caches interface fields -} @@ -1084,8 +1205,9 @@ set_mi_mod_info_field f iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = f (mi clear_mi_hi_bytes :: ModIface_ phase -> ModIface_ phase clear_mi_hi_bytes iface = iface { mi_hi_bytes_ = case mi_hi_bytes iface of - PartialIfaceBinHandle -> PartialIfaceBinHandle - FullIfaceBinHandle _ -> FullIfaceBinHandle Strict.Nothing + PartialIfaceBinHandle -> PartialIfaceBinHandle + FullIfaceBinHandle _ -> FullIfaceBinHandle Strict.Nothing + RetainedIfaceBinHandle -> RetainedIfaceBinHandle } -- ---------------------------------------------------------------------------- @@ -1183,22 +1305,22 @@ pattern ModIface :: -> [IfaceExport] -> [(OccName, Fixity)] -> IfaceWarnings - -> [IfaceAnnotation] - -> [IfaceDeclExts phase] - -> Maybe IfaceSimplifiedCore - -> [IfaceDefault] + -> IfaceAnnotationsData phase + -> IfaceDeclsData phase + -> IfaceSimplifiedCoreData phase + -> IfaceDefaultsData phase -> IfaceTopEnv - -> [IfaceClsInst] - -> [IfaceFamInst] - -> [IfaceRule] + -> IfaceClsInstsData phase + -> IfaceFamInstsData phase + -> IfaceRulesData phase -> IfaceTrustInfo -> Bool - -> [IfaceCompleteMatch] + -> IfaceCompleteMatchesData phase -> Maybe Docs - -> IfaceAbiHashesExts phase - -> ExtensibleFields + -> IfaceAbiHashesData phase + -> ExtensibleFieldsData phase -> IfaceBinHandle phase - -> Maybe IfaceSelfRecomp + -> IfaceSelfRecompData phase -> (OccName -> Maybe Fixity) -> (OccName -> Maybe (OccName, Fingerprint)) -> (OccName -> Maybe (WarningTxt GhcRn)) ===================================== ghc/Main.hs ===================================== @@ -515,7 +515,7 @@ abiHash strs = do put_ bh hiVersion -- package hashes change when the compiler version changes (for now) -- see #5328 - mapM_ (put_ bh . mi_mod_hash) ifaces + mapM_ (put_ bh . mi_abi_mod_hash . mi_abi_hashes) ifaces f <- fingerprintBinMem bh putStrLn (showPpr dflags f) ===================================== utils/haddock/haddock-api/src/Haddock/Interface.hs ===================================== @@ -63,7 +63,7 @@ import GHC.Driver.Session hiding (verbosity) import GHC.Driver.Phases import GHC.Driver.Pipeline (compileFile) import GHC.HsToCore.Docs (getMainDeclBinder) -import GHC.Iface.Load (loadSysInterface) +import GHC.Iface.Load (findAndReadIface) import GHC.IfaceToCore (tcIfaceInst, tcIfaceFamInst) import GHC.Tc.Utils.Monad (initIfaceLoad, initIfaceLcl) import GHC.Tc.Utils.Env (lookupGlobal_maybe) @@ -72,6 +72,7 @@ import GHC.Types.Name.Occurrence (emptyOccEnv) import GHC.Unit.Finder (findImportedModule, ModuleLookupScope(..), FindResult(Found)) import GHC.Unit.Home.ModInfo import GHC.Unit.Home.PackageTable +import GHC.Unit.Module (getModuleInstantiation) import GHC.Unit.Module.Graph (ModuleGraphNode (..), ModuleNodeInfo(..)) import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModIface (mi_semantic_module, mi_boot) @@ -254,19 +255,20 @@ dropErr :: MaybeErr e a -> Maybe a dropErr (Succeeded a) = Just a dropErr (Failed _) = Nothing -loadHiFile :: HscEnv -> Outputable.SDoc -> Module -> IO (ModIface, ([ClsInst], [FamInst])) -loadHiFile hsc_env doc theModule = initIfaceLoad hsc_env $ do - - mod_iface <- loadSysInterface doc theModule - - insts <- initIfaceLcl (mi_semantic_module mod_iface) doc (mi_boot mod_iface) $ do - - new_eps_insts <- mapM tcIfaceInst (mi_insts mod_iface) - new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts mod_iface) - - pure (new_eps_insts, new_eps_fam_insts) - - pure (mod_iface, insts) +loadHiFile :: Verbosity -> HscEnv -> Outputable.SDoc -> Module -> IO (ModIface, ([ClsInst], [FamInst])) +loadHiFile verbosity hsc_env doc requested = initIfaceLoad hsc_env $ do + let installed = fst (getModuleInstantiation requested) + iface_fetch_result <- liftIO $ findAndReadIface hsc_env doc installed requested NotBoot + case iface_fetch_result of + Failed _ -> do + out verbosity normal "Interface fetching failed" + liftIO exitFailure + Succeeded (mod_iface, _) -> do + insts <- initIfaceLcl (mi_semantic_module mod_iface) doc (mi_boot mod_iface) $ do + new_eps_insts <- mapM tcIfaceInst (mi_insts mod_iface) + new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts mod_iface) + pure (new_eps_insts, new_eps_fam_insts) + pure (mod_iface, insts) processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> WarningMap -> Ghc (Maybe Interface) processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do @@ -279,7 +281,7 @@ processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do unit_state = hsc_units hsc_env (mod_iface, insts) <- if Flag_NoCompilation `elem` flags - then liftIO $ loadHiFile hsc_env doc $ ms_mod modSummary + then liftIO $ loadHiFile verbosity hsc_env doc $ ms_mod modSummary else do hmi <- liftIO $ lookupHpt (hsc_HPT hsc_env) (moduleName $ ms_mod modSummary) >>= \case Nothing -> error "processModule: All modules should be loaded into the HPT by this point" @@ -374,7 +376,7 @@ createOneShotIface verbosity flags instIfaceMap moduleNameStr = do modifySession $ hscSetFlags dflags hsc_env <- getSession - (iface, insts) <- liftIO $ loadHiFile hsc_env doc $ mkMainModule_ moduleNm + (iface, insts) <- liftIO $ loadHiFile verbosity hsc_env doc $ mkMainModule_ moduleNm -- Update the DynFlags with the extensions from the source file (as stored in the interface file) -- This is instead of ms_hspp_opts from ModSummary, which is not available in one-shot mode. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d98c999ba9904de469303b93125bc8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d98c999ba9904de469303b93125bc8… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0