GitLab

Torsten Schmits pushed to branch wip/torsten.schmits/mercury-fixed at Glasgow Haskell Compiler / GHC

Commits:

7e8c1a07

by Cheng Shao at 2025-10-22T15:25:13+02:00

driver: add -dep-json -opt-json flags to ghc -M

docs: document -dep-json -opt-json flags

Rework protocol

merge opt-json into dep-json

normalize source filenames

include more canonical variant of the package id

choose the main library when -package matches multiple units with the same version

allow specifying library deps with -package pkg:lib

Backported to GHC 9.10

0695c6d4
by Torsten Schmits at 2025-10-22T15:25:13+02:00
```
release
```

25 changed files:

compiler/GHC/Driver/Backpack.hs
compiler/GHC/Driver/Downsweep.hs
compiler/GHC/Driver/DynFlags.hs
compiler/GHC/Driver/MakeFile.hs
+ compiler/GHC/Driver/MakeFile/JSON.hs
compiler/GHC/Driver/Pipeline/Execute.hs
compiler/GHC/Driver/Session.hs
compiler/GHC/Unit/Info.hs
compiler/GHC/Unit/Module/ModSummary.hs
compiler/GHC/Unit/State.hs
compiler/ghc.cabal.in
configure.ac
docs/users_guide/separate_compilation.rst
docs/users_guide/using.rst
+ testsuite/tests/driver/T24384/A.hs
+ testsuite/tests/driver/T24384/B.hs
+ testsuite/tests/driver/T24384/C.hs
+ testsuite/tests/driver/T24384/C.hs-boot
+ testsuite/tests/driver/T24384/D.hs
+ testsuite/tests/driver/T24384/E.hs
+ testsuite/tests/driver/T24384/Makefile
+ testsuite/tests/driver/T24384/T24384.stdout
+ testsuite/tests/driver/T24384/all.T
+ testsuite/tests/driver/T24384/preproc.sh
+ testsuite/tests/driver/T24384/setup-dep.sh

Changes:

compiler/GHC/Driver/Backpack.hs

@@ -804,6 +804,7 @@ summariseRequirement pn mod_name = do
          ms_hie_date = hie_timestamp,
          ms_srcimps = [],
          ms_textual_imps = ((,) NoPkgQual . noLoc) <$> extra_sig_imports,
 +        ms_opts = [],
          ms_parsed_mod = Just (HsParsedModule {
                  hpm_module = L loc (HsModule {
                          hsmodExt = XModulePs {
@@ -909,6 +910,7 @@ hsModuleToModSummary home_keys pn hsc_src modname
                             -- extra imports
                             ++ ((,) NoPkgQual . noLoc <$> extra_sig_imports)
                             ++ ((,) NoPkgQual . noLoc <$> implicit_sigs),
 +            ms_opts = [],
              -- This is our hack to get the parse tree to the right spot
              ms_parsed_mod = Just (HsParsedModule {
                      hpm_module = hsmod,

compiler/GHC/Driver/Downsweep.hs

@@ -27,7 +27,7 @@ import GHC.Tc.Utils.Backpack
  import GHC.Platform.Ways
  import GHC.Driver.Config.Finder (initFinderOpts)
 -import GHC.Driver.Config.Parser (initParserOpts)
 +import GHC.Driver.Config.Parser (initParserOpts, supportedLanguagePragmas)
  import GHC.Driver.Phases
  import GHC.Driver.Pipeline
  import GHC.Driver.Session
@@ -819,6 +819,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
              , nms_location = location
              , nms_mod = mod
              , nms_preimps = preimps
 +            , nms_opts = pi_mod_opts
+             }
  checkSummaryHash
@@ -981,6 +982,7 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
              , nms_location = location
              , nms_mod = mod
              , nms_preimps = preimps
 +            , nms_opts = pi_mod_opts
+             }
  -- | Convenience named arguments for 'makeNewModSummary' only used to make
@@ -993,6 +995,7 @@ data MakeNewModSummary
        , nms_location :: ModLocation
        , nms_mod :: Module
        , nms_preimps :: PreprocessedImports
 +      , nms_opts :: ![String]
+       }
  makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary
@@ -1020,6 +1023,7 @@ makeNewModSummary hsc_env MakeNewModSummary{..} = do
              ((,) NoPkgQual . noLoc <$> extra_sig_imports) ++
              ((,) NoPkgQual . noLoc <$> implicit_sigs) ++
              pi_theimps
 +        , ms_opts = nms_opts
          , ms_hs_hash = nms_src_hash
          , ms_iface_date = hi_timestamp
          , ms_hie_date = hie_timestamp
@@ -1036,6 +1040,7 @@ data PreprocessedImports
        , pi_hspp_buf :: StringBuffer
        , pi_mod_name_loc :: SrcSpan
        , pi_mod_name :: ModuleName
 +      , pi_mod_opts :: ![String]
+       }
  -- Preprocess the source file and get its imports
@@ -1051,14 +1056,15 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
    (pi_local_dflags, pi_hspp_fn)
        <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase
    pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn
 -  (pi_srcimps', pi_theimps', L pi_mod_name_loc pi_mod_name)
 +  ((pi_srcimps', pi_theimps', L pi_mod_name_loc pi_mod_name), pi_mod_opts)
        <- ExceptT $ do
            let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags
                popts = initParserOpts pi_local_dflags
            mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn
 -          return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps)
 +          let mopts = map unLoc $ snd $ getOptions popts (supportedLanguagePragmas pi_local_dflags) pi_hspp_buf src_fn
 +          pure $ ((, mopts) <$>) $ first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps
    let rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env)
    let rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn))
    let pi_srcimps = rn_imps pi_srcimps'
    let pi_theimps = rn_imps pi_theimps'
 -  return PreprocessedImports {..}
 \ No newline at end of file
 +  return PreprocessedImports {..}

compiler/GHC/Driver/DynFlags.hs

@@ -338,6 +338,7 @@ data DynFlags = DynFlags {
    depIncludeCppDeps     :: Bool,
    depExcludeMods        :: [ModuleName],
    depSuffixes           :: [String],
 +  depJSON               :: !(Maybe FilePath),
    --  Package flags
    packageDBFlags        :: [PackageDBFlag],
@@ -667,6 +668,7 @@ defaultDynFlags mySettings =
          depIncludeCppDeps = False,
          depExcludeMods    = [],
          depSuffixes       = [],
 +        depJSON           = Nothing,
          -- end of ghc -M values
          ghcVersionFile = Nothing,
          haddockOptions = Nothing,

compiler/GHC/Driver/MakeFile.hs

+-
 +{-# LANGUAGE LambdaCase #-}
 +{-# LANGUAGE NamedFieldPuns #-}
  -----------------------------------------------------------------------------
  --
@@ -17,12 +18,19 @@ where
  import GHC.Prelude
  import qualified GHC
 +import GHC.Data.Maybe
  import GHC.Driver.Make
  import GHC.Driver.Monad
  import GHC.Driver.DynFlags
 +import GHC.Driver.Ppr
 +import GHC.Driver.MakeFile.JSON
  import GHC.Utils.Misc
  import GHC.Driver.Env
  import GHC.Driver.Errors.Types
 +import GHC.Driver.Pipeline (runPipeline, TPhase (T_Unlit, T_FileArgs), use, mkPipeEnv)
 +import GHC.Driver.Phases (StopPhase (StopPreprocess), startPhase, Phase (Unlit))
 +import GHC.Driver.Pipeline.Monad (PipelineOutput (NoOutputFile))
 +import GHC.Driver.Session (pgm_F)
  import qualified GHC.SysTools as SysTools
  import GHC.Data.Graph.Directed ( SCC(..) )
  import GHC.Data.OsPath (unsafeDecodeUtf)
@@ -35,11 +43,13 @@ import Data.List (partition)
  import GHC.Utils.TmpFs
  import GHC.Iface.Load (cannotFindModule)
 +import GHC.Iface.Errors.Types
  import GHC.Unit.Module
  import GHC.Unit.Module.ModSummary
  import GHC.Unit.Module.Graph
  import GHC.Unit.Finder
 +import GHC.Unit.State (lookupUnitId)
  import GHC.Utils.Exception
  import GHC.Utils.Error
@@ -49,8 +59,8 @@ import System.Directory
  import System.FilePath
  import System.IO
  import System.IO.Error  ( isEOFError )
 -import Control.Monad    ( when, forM_ )
 -import Data.Maybe       ( isJust )
 +import Control.Monad    ( when )
 +import Data.Foldable (traverse_)
  import Data.IORef
  import qualified Data.Set as Set
  import GHC.Iface.Errors.Types
@@ -110,7 +120,7 @@ doMkDependModuleGraph dflags module_graph = do
      -- and complaining about cycles
      hsc_env <- getSession
      root <- liftIO getCurrentDirectory
 -    mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
 +    mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files) (mkd_dep_json files)) sorted
      -- If -ddump-mod-cycles, show cycles in the module graph
      liftIO $ dumpModCycles logger module_graph
@@ -118,13 +128,6 @@ doMkDependModuleGraph dflags module_graph = do
      -- Tidy up
      liftIO $ endMkDependHS logger files
 -    -- Unconditional exiting is a bad idea.  If an error occurs we'll get an
 -    --exception; if that is not caught it's fine, but at least we have a
 -    --chance to find out exactly what went wrong.  Uncomment the following
 -    --line if you disagree.
+-
 -    --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)
+-
  -----------------------------------------------------------------
  --
  --              beginMkDependHs
@@ -137,6 +140,8 @@ doMkDependModuleGraph dflags module_graph = do
  data MkDepFiles
    = MkDep { mkd_make_file :: FilePath,          -- Name of the makefile
              mkd_make_hdl  :: Maybe Handle,      -- Handle for the open makefile
 +             -- | Output interface for the -dep-json file
 +            mkd_dep_json  :: !(Maybe (JsonOutput DepJSON)),
              mkd_tmp_file  :: FilePath,          -- Name of the temporary file
              mkd_tmp_hdl   :: Handle }           -- Handle of the open temporary file
@@ -179,14 +184,15 @@ beginMkDependHS logger tmpfs dflags = do
             return (Just makefile_hdl)
 +  dep_json_ref <- mkJsonOutput initDepJSON (depJSON dflags)
          -- write the magic marker into the tmp file
    hPutStrLn tmp_hdl depStartMarker
    return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
 +                  mkd_dep_json = dep_json_ref,
                    mkd_tmp_file  = tmp_file, mkd_tmp_hdl  = tmp_hdl})
+-
  -----------------------------------------------------------------
  --
  --              processDeps
@@ -198,6 +204,7 @@ processDeps :: DynFlags
              -> [ModuleName]
              -> FilePath
              -> Handle           -- Write dependencies to here
 +            -> Maybe (JsonOutput DepJSON)
              -> SCC ModuleGraphNode
              -> IO ()
  -- Write suitable dependencies to handle
@@ -230,64 +237,68 @@ processDeps _dflags _ _ _ _ (AcyclicSCC (UnitNode {})) = return ()
  processDeps _ _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {})))
    -- No dependencies needed for fixed modules (already compiled)
    = return ()
 -processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node)))
 -  = do  { let extra_suffixes = depSuffixes dflags
 -              include_pkg_deps = depIncludePkgDeps dflags
 -              src_file  = msHsFilePath node
 -              obj_file  = msObjFilePath node
 -              obj_files = insertSuffixes obj_file extra_suffixes
+-
 -              do_imp loc is_boot pkg_qual imp_mod
 -                = do { mb_hi <- findDependency hsc_env loc pkg_qual imp_mod
 -                                               is_boot include_pkg_deps
 -                     ; case mb_hi of {
 -                           Nothing      -> return () ;
 -                           Just hi_file -> do
 -                     { let hi_files = insertSuffixes hi_file extra_suffixes
 -                           write_dep (obj,hi) = writeDependency root hdl [obj] hi
+-
 -                        -- Add one dependency for each suffix;
 -                        -- e.g.         A.o   : B.hi
 -                        --              A.x_o : B.x_hi
 -                     ; mapM_ write_dep (obj_files `zip` hi_files) }}}
+-
+-
 -                -- Emit std dependency of the object(s) on the source file
 -                -- Something like       A.o : A.hs
 -        ; writeDependency root hdl obj_files src_file
+-
 -          -- add dependency between objects and their corresponding .hi-boot
 -          -- files if the module has a corresponding .hs-boot file (#14482)
 -        ; when (isBootSummary node == IsBoot) $ do
 -            let hi_boot = msHiFilePath node
 -            let obj     = unsafeDecodeUtf $ removeBootSuffix (msObjFileOsPath node)
 -            forM_ extra_suffixes $ \suff -> do
 -               let way_obj     = insertSuffixes obj     [suff]
 -               let way_hi_boot = insertSuffixes hi_boot [suff]
 -               mapM_ (writeDependency root hdl way_obj) way_hi_boot
+-
 -                -- Emit a dependency for each CPP import
 -        ; when (depIncludeCppDeps dflags) $ do
 -            -- CPP deps are discovered in the module parsing phase by parsing
 -            -- comment lines left by the preprocessor.
 -            -- Note that GHC.parseModule may throw an exception if the module
 -            -- fails to parse, which may not be desirable (see #16616).
 -          { session <- Session <$> newIORef hsc_env
 -          ; parsedMod <- reflectGhc (GHC.parseModule node) session
 -          ; mapM_ (writeDependency root hdl obj_files)
 -                  (GHC.pm_extra_src_files parsedMod)
 -          }
+-
 -                -- Emit a dependency for each import
+-
 -        ; let do_imps is_boot idecls = sequence_
 -                    [ do_imp loc is_boot mb_pkg mod
 -                    | (mb_pkg, L loc mod) <- idecls,
 -                      mod `notElem` excl_mods ]
+-
 -        ; do_imps IsBoot (ms_srcimps node)
 -        ; do_imps NotBoot (ms_imps node)
 -        }
++
 +processDeps dflags hsc_env excl_mods root hdl m_dep_json (AcyclicSCC (ModuleNode _ (ModuleNodeCompile _ node))) = do
 +  pp <- preprocessor
 +  deps <- fmap concat $ sequence $
 +    [cpp_deps | depIncludeCppDeps dflags] ++ [
 +      import_deps IsBoot (ms_srcimps node),
 +      import_deps NotBoot (ms_imps node)
 +    ]
 +  updateJson m_dep_json (updateDepJSON include_pkg_deps pp dep_node deps)
 +  writeDependencies include_pkg_deps root hdl extra_suffixes dep_node deps
 +  where
 +    extra_suffixes = depSuffixes dflags
 +    include_pkg_deps = depIncludePkgDeps dflags
 +    src_file = msHsFilePath node
 +    dep_node =
 +      DepNode {
 +        dn_mod = ms_mod node,
 +        dn_src = src_file,
 +        dn_obj = msObjFilePath node,
 +        dn_hi = msHiFilePath node,
 +        dn_boot = isBootSummary node,
 +        dn_options = Set.fromList (ms_opts node)
 +      }
++
 +    preprocessor
 +      | Just src <- ml_hs_file (ms_location node)
 +      = runPipeline (hsc_hooks hsc_env) $ do
 +        let (_, suffix) = splitExtension src
 +            lit | Unlit _ <- startPhase suffix = True
 +                | otherwise = False
 +            pipe_env = mkPipeEnv StopPreprocess src Nothing NoOutputFile
 +        unlit_fn <- if lit then use (T_Unlit pipe_env hsc_env src) else pure src
 +        (dflags1, _, _) <- use (T_FileArgs hsc_env unlit_fn)
 +        let pp = pgm_F dflags1
 +        pure (if null pp then global_preprocessor else Just pp)
 +      | otherwise
 +      = pure global_preprocessor
++
 +    global_preprocessor
 +      | let pp = pgm_F dflags
 +      , not (null pp)
 +      = Just pp
 +      | otherwise
 +      = Nothing
++
 +    -- Emit a dependency for each CPP import
 +    -- CPP deps are discovered in the module parsing phase by parsing
 +    -- comment lines left by the preprocessor.
 +    -- Note that GHC.parseModule may throw an exception if the module
 +    -- fails to parse, which may not be desirable (see #16616).
 +    cpp_deps = do
 +      session <- Session <$> newIORef hsc_env
 +      parsedMod <- reflectGhc (GHC.parseModule node) session
 +      pure (DepCpp <$> GHC.pm_extra_src_files parsedMod)
++
 +    -- Emit a dependency for each import
 +    import_deps is_boot idecls =
 +      sequence [
 +        findDependency hsc_env loc mb_pkg mod is_boot
 +        | (mb_pkg, L loc mod) <- idecls
 +        , mod `notElem` excl_mods
 +        ]
  findDependency  :: HscEnv
@@ -295,27 +306,76 @@ findDependency  :: HscEnv
                  -> PkgQual              -- package qualifier, if any
                  -> ModuleName           -- Imported module
                  -> IsBootInterface      -- Source import
 -                -> Bool                 -- Record dependency on package modules
 -                -> IO (Maybe FilePath)  -- Interface file
 -findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
 +                -> IO Dep
 +findDependency hsc_env srcloc pkg imp dep_boot = do
    -- Find the module; this will be fast because
    -- we've done it once during downsweep
 -  r <- findImportedModuleWithIsBoot hsc_env imp is_boot pkg
 -  case r of
 -    Found loc _
 -        -- Home package: just depend on the .hi or hi-boot file
 -        | isJust (ml_hs_file loc) || include_pkg_deps
 -        -> return (Just (ml_hi_file loc))
+-
 -        -- Not in this package: we don't need a dependency
 -        | otherwise
 -        -> return Nothing
 +  findImportedModule hsc_env imp pkg >>= \case
 +    Found loc dep_mod ->
 +      pure DepHi {
 +        dep_mod,
 +        dep_path = ml_hi_file loc,
 +        dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod),
 +        dep_local,
 +        dep_boot
 +      }
 +      where
 +        dep_local = isJust (ml_hs_file loc)
      fail ->
 -        throwOneError $
 -          mkPlainErrorMsgEnvelope srcloc $
 -          GhcDriverMessage $ DriverInterfaceError $
 -             (Can'tFindInterface (cannotFindModule hsc_env imp fail) (LookingForModule imp is_boot))
 +      throwOneError $
 +      mkPlainErrorMsgEnvelope srcloc $
 +      GhcDriverMessage $
 +      DriverInterfaceError $
 +      Can'tFindInterface (cannotFindModule hsc_env imp fail) $
 +      LookingForModule imp dep_boot
++
 +writeDependencies ::
 +  Bool ->
 +  FilePath ->
 +  Handle ->
 +  [FilePath] ->
 +  DepNode ->
 +  [Dep] ->
 +  IO ()
 +writeDependencies include_pkgs root hdl suffixes node deps =
 +  traverse_ write tasks
 +  where
 +    tasks = source_dep : boot_dep ++ concatMap import_dep deps
++
 +    -- Emit std dependency of the object(s) on the source file
 +    -- Something like       A.o : A.hs
 +    source_dep = (obj_files, dn_src)
++
 +    -- add dependency between objects and their corresponding .hi-boot
 +    -- files if the module has a corresponding .hs-boot file (#14482)
 +    boot_dep
 +      | IsBoot <- dn_boot
 +      = [([obj], hi) | (obj, hi) <- zip (suffixed (removeBootSuffix dn_obj)) (suffixed dn_hi)]
 +      | otherwise
 +      = []
++
 +    -- Add one dependency for each suffix;
 +    -- e.g.         A.o   : B.hi
 +    --              A.x_o : B.x_hi
 +    import_dep = \case
 +      DepHi {dep_path, dep_boot, dep_unit}
 +        | isNothing dep_unit || include_pkgs
 +        , let path = addBootSuffix_maybe dep_boot dep_path
 +        -> [([obj], hi) | (obj, hi) <- zip obj_files (suffixed path)]
++
 +        | otherwise
 +        -> []
++
 +      DepCpp {dep_path} -> [(obj_files, dep_path)]
++
 +    write (from, to) = writeDependency root hdl from to
++
 +    obj_files = suffixed dn_obj
++
 +    suffixed f = insertSuffixes f suffixes
++
 +    DepNode {dn_src, dn_obj, dn_hi, dn_boot} = node
  -----------------------------
  writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
@@ -357,8 +417,9 @@ insertSuffixes file_name extras
  endMkDependHS :: Logger -> MkDepFiles -> IO ()
  endMkDependHS logger
 -   (MkDep { mkd_make_file = makefile, mkd_make_hdl =  makefile_hdl,
 -            mkd_tmp_file  = tmp_file, mkd_tmp_hdl  =  tmp_hdl })
 +   (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl,
 +            mkd_dep_json,
 +            mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
    = do
    -- write the magic marker into the tmp file
    hPutStrLn tmp_hdl depEndMarker
@@ -381,6 +442,10 @@ endMkDependHS logger
    showPass logger "Installing new makefile"
    SysTools.copyFile tmp_file makefile
 +  -- Write the dependency and option data to a json file if the corresponding
 +  -- flags were specified.
 +  writeJsonOutput mkd_dep_json
++
  -----------------------------------------------------------------
  --              Module cycles

compiler/GHC/Driver/MakeFile/JSON.hs

 +{-# LANGUAGE DeriveGeneric #-}
 +{-# LANGUAGE DerivingVia #-}
 +{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 +{-# LANGUAGE LambdaCase #-}
 +{-# LANGUAGE NamedFieldPuns #-}
 +{-# LANGUAGE NoFieldSelectors #-}
 +{-# LANGUAGE RecordWildCards #-}
 +module GHC.Driver.MakeFile.JSON
 +  ( writeJSONFile,
 +    JsonOutput (..),
 +    mkJsonOutput,
 +    updateJson,
 +    writeJsonOutput,
 +    DepJSON,
 +    DepNode (..),
 +    Dep (..),
 +    initDepJSON,
 +    updateDepJSON,
 +  )
 +where
++
 +import Data.Foldable (traverse_)
 +import Data.IORef
 +import qualified Data.Map.Strict as Map
 +import qualified Data.Semigroup as Semigroup
 +import qualified Data.Set as Set
 +import GHC.Data.FastString (unpackFS)
 +import GHC.Generics (Generic, Generically (Generically))
 +import GHC.Prelude
 +import GHC.Unit
 +import GHC.Utils.Json
 +import GHC.Utils.Misc
 +import GHC.Utils.Outputable
 +import System.FilePath (normalise)
++
 +--------------------------------------------------------------------------------
 +-- Output helpers
 +--------------------------------------------------------------------------------
++
 +writeJSONFile :: ToJson a => a -> FilePath -> IO ()
 +writeJSONFile doc p = do
 +  withAtomicRename p
 +    $ \tmp -> writeFile tmp $ showSDocUnsafe $ renderJSON $ json doc
++
 +--------------------------------------------------------------------------------
 +-- Output interface for json dumps
 +--------------------------------------------------------------------------------
++
 +-- | Resources for a json dump option, used in "GHC.Driver.MakeFile".
 +-- The flag @-dep-json@ add an additional output target for dependency
 +-- diagnostics.
 +data JsonOutput a =
 +  JsonOutput {
 +    -- | This ref is updated in @processDeps@ incrementally, using a
 +    -- flag-specific type.
 +    json_ref :: IORef a,
++
 +    -- | The output file path specified as argument to the flag.
 +    json_path :: FilePath
 +  }
++
 +-- | Allocate an 'IORef' with the given function if the 'FilePath' is 'Just',
 +-- indicating that the userspecified @-*-json@.
 +mkJsonOutput ::
 +  IO (IORef a) ->
 +  Maybe FilePath ->
 +  IO (Maybe (JsonOutput a))
 +mkJsonOutput mk_ref =
 +  traverse $ \ json_path -> do
 +    json_ref <- mk_ref
 +    pure JsonOutput {json_ref, json_path}
++
 +-- | Update the dump data in 'json_ref' if the output target is present.
 +updateJson :: Maybe (JsonOutput a) -> (a -> a) -> IO ()
 +updateJson out f = traverse_ (\ JsonOutput {json_ref} -> modifyIORef' json_ref f) out
++
 +-- | Write a json object to the flag-dependent file if the output target is
 +-- present.
 +writeJsonOutput ::
 +  ToJson a =>
 +  Maybe (JsonOutput a) ->
 +  IO ()
 +writeJsonOutput =
 +  traverse_ $ \ JsonOutput {json_ref, json_path} -> do
 +    payload <- readIORef json_ref
 +    writeJSONFile payload json_path
++
 +--------------------------------------------------------------------------------
 +-- Types abstracting over json and Makefile
 +--------------------------------------------------------------------------------
++
 +data DepNode =
 +  DepNode {
 +    dn_mod :: Module,
 +    dn_src :: FilePath,
 +    dn_obj :: FilePath,
 +    dn_hi :: FilePath,
 +    dn_boot :: IsBootInterface,
 +    dn_options :: Set.Set String
 +  }
++
 +data Dep =
 +  DepHi {
 +    dep_mod :: Module,
 +    dep_path :: FilePath,
 +    dep_unit :: Maybe UnitInfo,
 +    dep_local :: Bool,
 +    dep_boot :: IsBootInterface
 +  }
 +  |
 +  DepCpp {
 +    dep_path :: FilePath
 +  }
++
 +--------------------------------------------------------------------------------
 +-- Payload for -dep-json
 +--------------------------------------------------------------------------------
++
 +newtype PackageDeps =
 +  PackageDeps (Map.Map (String, UnitId, PackageId) (Set.Set ModuleName))
 +  deriving newtype (Monoid)
++
 +instance Semigroup PackageDeps where
 +  PackageDeps l <> PackageDeps r = PackageDeps (Map.unionWith (Semigroup.<>) l r)
++
 +data Deps =
 +  Deps {
 +    sources :: Set.Set FilePath,
 +    modules :: (Set.Set ModuleName, Set.Set ModuleName),
 +    packages :: PackageDeps,
 +    cpp :: Set.Set FilePath,
 +    options :: Set.Set String,
 +    preprocessor :: Maybe FilePath
 +  }
 +  deriving stock (Generic)
 +  deriving (Semigroup, Monoid) via (Generically Deps)
++
 +newtype DepJSON = DepJSON (Map.Map ModuleName Deps)
++
 +instance ToJson DepJSON where
 +  json (DepJSON m) =
 +    JSObject [
 +      (moduleNameString target, JSObject [
 +        ("sources", array sources normalise),
 +        ("modules", array (fst modules) moduleNameString),
 +        ("modules-boot", array (snd modules) moduleNameString),
 +        ("packages",
 +          JSArray [
 +            package name unit_id package_id mods |
 +            ((name, unit_id, package_id), mods) <- Map.toList packages
 +          ]
 +        ),
 +        ("cpp", array cpp id),
 +        ("options", array options id),
 +        ("preprocessor", maybe JSNull JSString preprocessor)
 +      ])
 +      | (target, Deps {packages = PackageDeps packages, ..}) <- Map.toList m
 +    ]
 +    where
 +      package name unit_id (PackageId package_id) mods =
 +        JSObject [
 +          ("id", JSString (unitIdString unit_id)),
 +          ("name", JSString name),
 +          ("package-id", JSString (unpackFS package_id)),
 +          ("modules", array mods moduleNameString)
 +        ]
++
 +      array values render = JSArray (fmap (JSString . render) (Set.toList values))
++
 +initDepJSON :: IO (IORef DepJSON)
 +initDepJSON = newIORef $ DepJSON Map.empty
++
 +insertDepJSON :: [ModuleName] -> Deps -> DepJSON -> DepJSON
 +insertDepJSON targets dep (DepJSON m0) =
 +  DepJSON
 +    $ foldl'
 +      ( \acc target ->
 +          Map.insertWith
 +            (Semigroup.<>)
 +            target
 +            dep
 +            acc
 +      )
 +      m0
 +      targets
++
 +updateDepJSON :: Bool -> Maybe FilePath -> DepNode -> [Dep] -> DepJSON -> DepJSON
 +updateDepJSON include_pkgs preprocessor DepNode {..} deps =
 +  insertDepJSON [moduleName dn_mod] payload
 +  where
 +    payload = node_data Semigroup.<> foldMap dep deps
++
 +    node_data =
 +      mempty {
 +        sources = Set.singleton dn_src,
 +        preprocessor,
 +        options = dn_options
 +      }
++
 +    dep = \case
 +      DepHi {dep_mod, dep_local, dep_unit, dep_boot}
 +        | dep_local
 +        , let set = Set.singleton (moduleName dep_mod)
 +              value | IsBoot <- dep_boot = (Set.empty, set)
 +                    | otherwise = (set, Set.empty)
 +        -> mempty {modules = value}
++
 +        | include_pkgs
 +        , Just unit <- dep_unit
 +        , let PackageName nameFS = unitPackageName unit
 +              name = unpackFS nameFS
 +              withLibName (PackageName c) = name ++ ":" ++ unpackFS c
 +              lname = maybe name withLibName (unitComponentName unit)
 +              key = (lname, unitId unit, unitPackageId unit)
 +        -> mempty {packages = PackageDeps (Map.singleton key (Set.singleton (moduleName dep_mod)))}
++
 +        | otherwise
 +        -> mempty
++
 +      DepCpp {dep_path} ->
 +        mempty {cpp = Set.singleton dep_path}

compiler/GHC/Driver/Pipeline/Execute.hs

@@ -753,6 +753,7 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
                                  ms_iface_date   = hi_date,
                                  ms_hie_date     = hie_date,
                                  ms_textual_imps = imps,
 +                                ms_opts         = [],
                                  ms_srcimps      = src_imps }

compiler/GHC/Driver/Session.hs

@@ -753,6 +753,9 @@ addDepExcludeMod m d
  addDepSuffix :: FilePath -> DynFlags -> DynFlags
  addDepSuffix s d = d { depSuffixes = s : depSuffixes d }
 +setDepJSON :: FilePath -> DynFlags -> DynFlags
 +setDepJSON f d = d { depJSON = Just f }
++
  addCmdlineFramework f d = d { cmdlineFrameworks = f : cmdlineFrameworks d}
  addGhcVersionFile :: FilePath -> DynFlags -> DynFlags
@@ -1218,6 +1221,7 @@ dynamic_flags_deps = [
    , make_ord_flag defGhcFlag "include-pkg-deps"
          (noArg (setDepIncludePkgDeps True))
    , make_ord_flag defGhcFlag "exclude-module"          (hasArg addDepExcludeMod)
 +  , make_ord_flag defGhcFlag "dep-json"                (hasArg setDepJSON)
          -------- Linking ----------------------------------------------------
    , make_ord_flag defGhcFlag "no-link"

compiler/GHC/Unit/Info.hs

@@ -117,6 +117,9 @@ instance Outputable PackageId where
  instance Outputable PackageName where
    ppr (PackageName str) = ftext str
 +instance Ord PackageId where
 +    PackageId p1 `compare` PackageId p2 = p1 `lexicalCompareFS` p2
++
  unitPackageIdString :: GenUnitInfo u -> String
  unitPackageIdString pkg = unpackFS str
    where

compiler/GHC/Unit/Module/ModSummary.hs

@@ -83,6 +83,8 @@ data ModSummary
            -- ^ Source imports of the module
          ms_textual_imps :: [(PkgQual, Located ModuleName)],
            -- ^ Non-source imports of the module from the module *text*
 +        ms_opts         :: ![String],
 +          -- ^ OPTIONS and LANGUAGE pragmas of the source file
          ms_parsed_mod   :: Maybe HsParsedModule,
            -- ^ The parsed, nonrenamed source, if we have it.  This is also
            -- used to support "inline module syntax" in Backpack files.

compiler/GHC/Unit/State.hs

@@ -71,6 +71,7 @@ module GHC.Unit.State (
          unwireUnit)
  where
 +import Data.Foldable (find)
  import GHC.Prelude
  import GHC.Driver.DynFlags
@@ -903,8 +904,18 @@ applyPackageFlag prec_map pkg_map closure unusable no_hide_others pkgs vm flag =
      ExposePackage _ arg (ModRenaming b rns) ->
         case findPackages prec_map pkg_map closure arg pkgs unusable of
           Left ps     -> Failed (PackageFlagErr flag ps)
 -         Right (p:_) -> Succeeded vm'
 +         Right ps@(p0:_) -> Succeeded vm'
            where
 +           p | PackageArg _ <- arg = fromMaybe p0 mainPackage
 +             | otherwise = p0
++
 +           mainPackage = find (\ u -> isNothing (unitComponentName u)) matchFirst
++
 +           matchFirst = filter (\ u -> unitPackageName u == firstName && unitPackageVersion u == firstVersion) ps
++
 +           firstName = unitPackageName p0
 +           firstVersion = unitPackageVersion p0
++
             n = fsPackageName p
             -- If a user says @-unit-id p[A=<A>]@, this imposes
@@ -1030,6 +1041,13 @@ matchingStr :: String -> UnitInfo -> Bool
  matchingStr str p
          =  str == unitPackageIdString p
          || str == unitPackageNameString p
 +        || matchSublibrary
 +  where
 +    matchSublibrary
 +      | Just (PackageName c) <- unitComponentName p
 +      = str == (unitPackageNameString p ++ ":" ++ unpackFS c)
 +      | otherwise
 +      = False
  matchingId :: UnitId -> UnitInfo -> Bool
  matchingId uid p = uid == unitId p

compiler/ghc.cabal.in

@@ -528,6 +528,7 @@ Library
          GHC.Driver.Make
          GHC.Driver.MakeAction
          GHC.Driver.MakeFile
 +        GHC.Driver.MakeFile.JSON
          GHC.Driver.Monad
          GHC.Driver.Phases
          GHC.Driver.Pipeline

configure.ac

@@ -13,7 +13,7 @@ dnl
  # see what flags are available. (Better yet, read the documentation!)
+ #
 -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.13], [glasgow-haskell-bugs@haskell.org], [ghc-AC_PACKAGE_VERSION])
 +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.12.1], [glasgow-haskell-bugs@haskell.org], [ghc-AC_PACKAGE_VERSION])
      # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable
      # to be useful (cf #19058). However, the version must have three components
      # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are
@@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.13], [glasgow-hask
  AC_CONFIG_MACRO_DIRS([m4])
  # Set this to YES for a released version, otherwise NO
 -: ${RELEASE=NO}
 +: ${RELEASE=YES}
  # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
  # above.  If this is not a released version, then we will append the

docs/users_guide/separate_compilation.rst

@@ -1520,6 +1520,22 @@ generation are:
      is only a temporary file that GHC will always generate, it is not output as
      a dependency.
 +.. ghc-flag:: -dep-json ⟨file⟩
 +    :shortdesc: Also emit ⟨file⟩ as a JSON file containing dependencies
 +    :type: dynamic
 +    :category: redirect-output
++
 +    In addition to the makefile, also emit ⟨file⟩ as a JSON file
 +    containing the same dependencies info, so it can be parsed by
 +    external build systems. The JSON file contains a single object,
 +    mapping each target to a list of dependencies.
 +    In addition to the makefile, each module's payload will contain the
 +    values of ``OPTIONS`` and ``LANGUAGE`` pragmas of the source
 +    file, so it can be parsed by external build systems. Each ``LANGUAGE``
 +    pragma is represented as an option as well, e.g.
 +    ``{-# LANGUAGE TemplateHaskell #-}`` is represented as
 +    ``"-XTemplateHaskell"``.
++
  .. _orphan-modules:
  Orphan modules and instance declarations

docs/users_guide/using.rst

@@ -366,7 +366,7 @@ The available mode flags are:
  .. ghc-flag:: -M
      :shortdesc: generate dependency information suitable for use in a
 -        ``Makefile``; see :ref:`makefile-dependencies` for details.
 +        ``Makefile`` or as JSON; see :ref:`makefile-dependencies` for details.
      :type: mode
      :category: modes

testsuite/tests/driver/T24384/A.hs

 +{-# language Strict #-}
 +{-# options_ghc -fexpose-all-unfoldings #-}
 +module A where
++
 +import {-# source #-} C

testsuite/tests/driver/T24384/B.hs

	1	+{-# options_ghc -F -pgmF ./preproc.sh #-}
	2	+module B where

testsuite/tests/driver/T24384/C.hs

 +module C where
++
 +import A
 +import Data.Set
++
 +data C = C

testsuite/tests/driver/T24384/C.hs-boot

 +module C where
++
 +import E
++
 +data C

testsuite/tests/driver/T24384/D.hs

 +module D where
++
 +import B
 +import C

testsuite/tests/driver/T24384/E.hs

 +module E where
++
 +import Language.Haskell.TH.Syntax
 +import Dep
 +import DepPub
++
 +e :: Q Exp
 +e = lift (5 :: Integer)
++
 +edep :: ()
 +edep = dep
++
 +edepPub :: ()
 +edepPub = depPub

testsuite/tests/driver/T24384/Makefile

 +TOP=../../..
 +include $(TOP)/mk/boilerplate.mk
 +include $(TOP)/mk/test.mk
++
 +T24384:
 +	./setup-dep.sh "$(TEST_HC)" "$(TEST_HC_OPTS)" "$(CABAL_MINIMAL_BUILD)" "$(GHC_PKG)"
 +	mkdir -p lib
 +	mv B.hs lib/
 +	'$(TEST_HC)' A.hs lib/B.hs C.hs D.hs E.hs -M -dep-json dep.json -include-pkg-deps -include-cpp-deps -package-db ./db -hide-all-packages -package base -package containers -package template-haskell -package dep -package dep:pub
 +	cat dep.json

testsuite/tests/driver/T24384/T24384.stdout

+{"A":{"sources":["A.hs"],"modules":[],"modules-boot":["C"],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]}],"cpp":[],"options":["-XStrict","-fexpose-all-unfoldings"],"preprocessor":null},"B":{"sources":["lib/B.hs"],"modules":["A"],"modules-boot":[],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]}],"cpp":[],"options":[],"preprocessor":"./preproc.sh"},"C":{"sources":["C.hs","C.hs-boot"],"modules":["A","E"],"modules-boot":[],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]},{"id":"containers-0.7-inplace","name":"containers","package-id":"containers-0.7","modules":["Data.Set"]}],"cpp":[],"options":[],"preprocessor":null},"D":{"sources":["D.hs"],"modules":["B","C"],"modules-boot":[],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]}],"cpp":[],"options":[],"preprocessor":null},"E":{"sources":["E.hs"],"modules":[],"modules-boot":[],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]},{"id":"dep-1-Acdff5K3xp09fO6uiTrnge","name":"dep","package-id":"dep-1","modules":["Dep"]},{"id":"dep-1-8mhA0yJkyEn42CuhdNx93G-pub","name":"dep:pub","package-id":"dep-1","modules":["DepPub"]},{"id":"template-haskell","name":"template-haskell","package-id":"template-haskell-2.22.0.0","modules":["Language.Haskell.TH.Syntax"]}],"cpp":[],"options":[],"preprocessor":null}}

\ No newline at end of file

testsuite/tests/driver/T24384/all.T

+test('T24384', [extra_files(['A.hs', 'B.hs', 'C.hs', 'C.hs-boot', 'D.hs', 'E.hs', 'preproc.sh', 'setup-dep.sh'])], makefile_test, [])

testsuite/tests/driver/T24384/preproc.sh

 +#!/usr/bin/env bash
++
 +sed '/preproc/d' $2 > $3
 +echo 'import A' >> $3

testsuite/tests/driver/T24384/setup-dep.sh

 +#!/usr/bin/env bash
++
 +set -eu
++
 +ghc="$1"
 +ghc_opts="$2"
 +config_options="$3"
 +ghc_pkg="$4"
 +base=$(cd $(dirname $0); pwd)
++
 +mkdir -p dep/{int,pub}
 +$ghc_pkg init ./db
++
 +cd dep/
++
 +cat > dep.cabal <<EOF
 +cabal-version: 3.4
 +name: dep
 +version: 1
 +build-type: Simple
 +library
 +  default-language: Haskell2010
 +  exposed-modules: Dep
 +  build-depends: base, dep:int
 +library int
 +  default-language: Haskell2010
 +  hs-source-dirs: int
 +  exposed-modules: DepInt
 +  build-depends: base
 +library pub
 +  default-language: Haskell2010
 +  hs-source-dirs: pub
 +  visibility: public
 +  exposed-modules: DepPub
 +  build-depends: base
 +EOF
++
 +cat > Dep.hs <<EOF
 +module Dep where
 +import DepInt
 +dep :: ()
 +dep = depInt
 +EOF
++
 +cat > int/DepInt.hs <<EOF
 +module DepInt where
 +depInt :: ()
 +depInt = ()
 +EOF
++
 +cat > pub/DepPub.hs <<EOF
 +module DepPub where
 +depPub :: ()
 +depPub = ()
 +EOF
++
 +cat > Setup.hs <<EOF
 +import Distribution.Simple
 +main = defaultMain
 +EOF
++
 +eval $ghc $ghc_opts -v0 --make Setup
 +eval ./Setup configure $config_options --with-ghc="'$ghc'" --with-hc-pkg="'$ghc_pkg'" --ghc-options="'$ghc_opts'" --package-db="'$base/db'" -v0
 +./Setup build -v0
 +./Setup register --inplace -v0