Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC Commits: 17b19e16 by Hannes Siebenhandl at 2026-11-03T12:09:16+01:00 fixup! Refactor Makefile to use phases appropriately - - - - - 6d6bf5a5 by Hannes Siebenhandl at 2026-11-03T12:13:17+01:00 fixup! Refactor Makefile to use phases appropriately - - - - - 2f317369 by Hannes Siebenhandl at 2026-11-03T12:50:48+01:00 fixup! Refactor Makefile to use phases appropriately - - - - - 43b31259 by Hannes Siebenhandl at 2026-11-03T12:51:07+01:00 fixup! Add `-dep-json` flag to `ghc -M` - - - - - 1 changed file: - compiler/GHC/Driver/MakeFile.hs Changes: ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -196,36 +196,37 @@ doMkDependModuleGraph dflags module_graph = do -- | A 'DepNode' is a direct translation of a 'ModuleGraphNode' that -- can be serialised to a Makefile or json lines format. data DepNode = - ModuleDepNode DepModuleNode [Dep] + ModuleDepNode HomeModuleNode [Dep] -- ^ A dependency node of a home module with its dependencies -- | A home module node. -- Everything we know about home modules that can be serialised. -data DepModuleNode = - DepModuleNode - { dn_unitId :: UnitId +data HomeModuleNode = + HomeModuleNode + { hmn_unitId :: UnitId -- ^ 'UnitId' of the 'HomeUnitEnv' this home module belongs to. - , dn_packageName :: Maybe String + , hmn_packageName :: Maybe String -- ^ Optional package name, used for @-XPackageImports@. - , dn_mod :: ModuleWithIsBoot + , hmn_mod :: ModuleWithIsBoot -- ^ 'Module' of this home module with 'IsBootInterface' information. - , dn_src :: OsPath + , hmn_src :: OsPath -- ^ Where is the source for this home module located. - , dn_obj :: OsPath + , hmn_obj :: OsPath -- ^ Where is the object file for this home module located if it exists. - , dn_hi :: OsPath + , hmn_hi :: OsPath -- ^ Where is the interface file for this home module located if it exists. - , dn_preprocessing :: PreprocessingNode + , hmn_preprocessing :: Maybe PreprocessingNode -- ^ Is there a preprocessor that needs to be run for this module before compilation. - , dn_includePkgDeps :: Bool + , hmn_includePkgDeps :: Bool -- ^ When serialising this home module, should we include external package dependencies -- (such as importing @Data.List@ from @base@) in the output? } -- | Preprocessor that needs to be run before a module can be compiled. data PreprocessingNode = PreprocessingNode - { pn_preprocessor :: Maybe String + { pn_preprocessor :: String -- ^ The preprocessor. + , pn_arguments :: [String] } -- | A dependency edge on another module, or cpp path. @@ -249,7 +250,7 @@ data Dep -- as the 'DepModuleNode'. } | DepCpp - -- ^ A dependency on a CPP @#include@. + -- ^ A dependency on a CPP @#include@ in the Haskell source file, identified by the preprocessor. { dep_path :: OsPath -- ^ Path to the @#include@d path. } @@ -307,7 +308,6 @@ processDeps _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {}))) = return Nothing processDeps hsc_env0 excl_mods (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) = do - pp <- preprocessor let find_deps imps = do cpp_deps <- find_cpp_deps @@ -318,7 +318,7 @@ processDeps hsc_env0 excl_mods (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node if null missing_dep_errs then do - pure $ Just $ ModuleDepNode (mkDepNode pp) deps + pure $ Just $ ModuleDepNode mkDepNode deps else do let sec = initSourceErrorContext dflags throwErrors sec (mkMessages (listToBag missing_dep_errs)) @@ -328,25 +328,29 @@ processDeps hsc_env0 excl_mods (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node -- separate dependencies and options. -- Thus, we need to set the active unit id to the one of the module we are processing. local_hsc_env = hscSetActiveUnitId (ms_unitid node) hsc_env0 - unit_dflags = hsc_dflags local_hsc_env dflags = ms_hspp_opts node src_file = msHsFileOsPath node - mkDepNode preproc = - DepModuleNode - { dn_unitId = ms_unitid node - , dn_packageName = thisPackageName dflags - , dn_mod = GWIB (ms_mod node) (isBootSummary node) - , dn_src = src_file - , dn_obj = msObjFileOsPath node - , dn_hi = msHiFileOsPath node - , dn_preprocessing = preproc - , dn_includePkgDeps = depIncludePkgDeps unit_dflags + mkDepNode = + HomeModuleNode + { hmn_unitId = ms_unitid node + , hmn_packageName = thisPackageName dflags + , hmn_mod = GWIB (ms_mod node) (isBootSummary node) + , hmn_src = src_file + , hmn_obj = msObjFileOsPath node + , hmn_hi = msHiFileOsPath node + , hmn_preprocessing = preprocessor + , hmn_includePkgDeps = depIncludePkgDeps dflags } - preprocessor :: IO PreprocessingNode + preprocessor :: Maybe PreprocessingNode preprocessor = do - pure PreprocessingNode - { pn_preprocessor = find_preprocessor dflags + guard (gopt Opt_Pp dflags) + let pp = pgm_F dflags + guard (not $ null pp) + let args = opt_F dflags + pure $ PreprocessingNode + { pn_preprocessor = pp + , pn_arguments = args } -- Emit a dependency for each CPP import @@ -356,7 +360,7 @@ processDeps hsc_env0 excl_mods (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node -- fails to parse, which may not be desirable (see #16616). find_cpp_deps :: IO [Dep] find_cpp_deps = - if depIncludeCppDeps unit_dflags + if depIncludeCppDeps dflags then do session <- Session <$> newIORef local_hsc_env parsedMod <- reflectGhc (GHC.parseModule node) session @@ -402,13 +406,6 @@ findDependency hsc_env (L srcloc imp) = do mod_name = ui_mod_name imp is_boot = ui_boot imp -find_preprocessor :: DynFlags -> Maybe String -find_preprocessor d = do - guard (gopt Opt_Pp d) - let pp = pgm_F d - guard (not $ null pp) - Just pp - ----------------------------------------------------------------- -- -- beginMkDependHs @@ -486,7 +483,7 @@ writeDependencies :: Handle -> [OsString] -> -- ^ Suffixes - DepModuleNode -> + HomeModuleNode -> [Dep] -> IO () writeDependencies root hdl suffixes node deps = @@ -496,12 +493,12 @@ writeDependencies root hdl suffixes node deps = -- Emit std dependency of the object(s) on the source file -- Something like A.o : A.hs - source_dep = (obj_files, dn_src) + source_dep = (obj_files, hmn_src) -- add dependency between objects and their corresponding .hi-boot -- files if the module has a corresponding .hs-boot file (#14482) - boot_dep = case gwib_isBoot dn_mod of - IsBoot -> [([obj], hi) | (obj, hi) <- zip (suffixed (removeBootSuffix dn_obj)) (suffixed dn_hi)] + boot_dep = case gwib_isBoot hmn_mod of + IsBoot -> [([obj], hi) | (obj, hi) <- zip (suffixed (removeBootSuffix hmn_obj)) (suffixed hmn_hi)] NotBoot -> [] -- Add one dependency for each suffix; @@ -509,7 +506,7 @@ writeDependencies root hdl suffixes node deps = -- A.x_o : B.x_hi import_dep = \case DepHi {dep_path, dep_local} - | dep_local || dn_includePkgDeps + | dep_local || hmn_includePkgDeps -> [([obj], hi) | (obj, hi) <- zip obj_files (suffixed dep_path)] | otherwise @@ -519,11 +516,11 @@ writeDependencies root hdl suffixes node deps = write (from, to) = writeDependency root hdl from to - obj_files = suffixed dn_obj + obj_files = suffixed hmn_obj suffixed f = insertSuffixes f suffixes - DepModuleNode {dn_src, dn_obj, dn_hi, dn_mod, dn_includePkgDeps} = node + HomeModuleNode {hmn_src, hmn_obj, hmn_hi, hmn_mod, hmn_includePkgDeps} = node ----------------------------- writeDependency :: OsPath -> Handle -> [OsPath] -> OsPath -> IO () @@ -684,7 +681,7 @@ data HomeUnitDep = HomeUnitDep , source :: OsPath , imports :: ImportDeps , cpp :: Set.Set OsPath - , preprocessor :: Maybe FilePath + , preprocessor :: Maybe PreprocessingNode } addImport :: ImportDep -> HomeUnitDep -> HomeUnitDep @@ -759,8 +756,8 @@ instance ToJson HomeUnitDep where , mkPair "imports" (importsObj imports) , omitIfNull "package-name" (maybe JSNull JSString packageName) , mkPair "source" (JSString . showOsPath $ normalise source) - , omitIfEmpty "includes" (strArray cpp showOsPath) - , omitIfNull "preprocessor" (maybe JSNull JSString preprocessor) + , omitIfEmpty "includes" (strArray (Set.toList cpp) showOsPath) + , omitIfNull "preprocessor" (maybe JSNull preprocessorObj preprocessor) ] where moduleKey :: Module -> String @@ -796,8 +793,16 @@ instance ToJson HomeUnitDep where SpliceLevel -> "splice" QuoteLevel -> "quote" + preprocessorObj :: PreprocessingNode -> JsonDoc + preprocessorObj pp = + JSObject $ + concat + [ mkPair "command" (JSString $ pn_preprocessor pp) + , omitIfEmpty "arguments" (strArray (pn_arguments pp) id) + ] + array values render = JSArray (fmap render (Set.toList values)) - strArray values render = fmap (JSString . render) (Set.toList values) + strArray values render = fmap (JSString . render) values omitIfDefault :: String -> a -> (a -> Bool) -> (a -> JsonDoc) -> [(String, JsonDoc)] omitIfDefault k v p toJson @@ -836,8 +841,8 @@ cacheExternalDepsJson extUnits (DepJson e0) = Set.union e0 extUnits } -writeHomeUnitDeps :: JsonOutput -> DepModuleNode -> [Dep] -> IO () -writeHomeUnitDeps deps_json DepModuleNode {..} deps = do +writeHomeUnitDeps :: JsonOutput -> HomeModuleNode -> [Dep] -> IO () +writeHomeUnitDeps deps_json HomeModuleNode {..} deps = do extUnits <- readJson deps_json let newExtUnits = Set.difference extUnitsDeps (externalDeps extUnits) -- Write new external unit deps before the module that uses them @@ -851,11 +856,11 @@ writeHomeUnitDeps deps_json DepModuleNode {..} deps = do initial_node_data = HomeUnitDep - { unitId = dn_unitId - , packageName = dn_packageName - , modWithIsBoot = dn_mod - , source = dn_src - , preprocessor = pn_preprocessor dn_preprocessing + { unitId = hmn_unitId + , packageName = hmn_packageName + , modWithIsBoot = hmn_mod + , source = hmn_src + , preprocessor = hmn_preprocessing , cpp = Set.empty , imports = ImportDeps Map.empty } @@ -865,7 +870,7 @@ writeHomeUnitDeps deps_json DepModuleNode {..} deps = do | dep_local -> (extDeps, addImport (mkImportDep dep_mod dep_level dep_boot) node_data) - | dn_includePkgDeps + | hmn_includePkgDeps , Just unit <- dep_unit , let PackageName nameFS = unitPackageName unit name = unpackFS nameFS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38017955703d53d3abb2e4676d8539c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38017955703d53d3abb2e4676d8539c... 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