Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC

Commits:

23 changed files:

Changes:

  • compiler/GHC/Driver/DynFlags.hs
    ... ... @@ -351,6 +351,7 @@ data DynFlags = DynFlags {
    351 351
    352 352 
       --  For ghc -M
    353 353 
       depMakefile           :: FilePath,
    354 
    +  depJson               :: Maybe FilePath,
    354 355 
       depIncludePkgDeps     :: Bool,
    355 356 
       depIncludeCppDeps     :: Bool,
    356 357 
       depExcludeMods        :: [ModuleName],
    ... ... @@ -694,6 +695,7 @@ defaultDynFlags mySettings =
    694 695
    695 696 
             -- ghc -M values
    696 697 
             depMakefile       = "Makefile",
    698 
    +        depJson           = Nothing,
    697 699 
             depIncludePkgDeps = False,
    698 700 
             depIncludeCppDeps = False,
    699 701 
             depExcludeMods    = [],

  • compiler/GHC/Driver/MakeFile.hs
    ... ... @@ -7,6 +7,8 @@
    7 7 
     -- (c) The University of Glasgow 2005
    8 8 
     --
    9 9 
     -----------------------------------------------------------------------------
    10 
    +{-# LANGUAGE DerivingVia #-}
    11 
    +{-# LANGUAGE RecordWildCards #-}
    10 12
    11 13 
     module GHC.Driver.MakeFile
    12 14 
        ( doMkDependHS
    ... ... @@ -16,47 +18,67 @@ where
    16 18
    17 19 
     import GHC.Prelude
    18 20
    19 
    -import qualified GHC
    20 
    -import GHC.Driver.Make
    21 
    -import GHC.Driver.Monad
    21 
    +import GHC qualified
    22 
    +
    23 
    +import GHC.Data.Bag (listToBag)
    24 
    +import GHC.Data.FastString (lexicalCompareFS, unpackFS)
    25 
    +import GHC.Data.Graph.Directed (SCC (..))
    26 
    +import GHC.Data.OsPath
    27 
    +
    22 28 
     import GHC.Driver.DynFlags
    23 
    -import GHC.Utils.Misc
    24 29 
     import GHC.Driver.Env
    25 30 
     import GHC.Driver.Errors.Types
    26 
    -import GHC.Types.UnresolvedImport
    27 
    -import qualified GHC.SysTools as SysTools
    28 
    -import GHC.Data.Graph.Directed ( SCC(..) )
    29 
    -import GHC.Data.OsPath (unsafeDecodeUtf)
    30 
    -import GHC.Utils.Outputable
    31 
    -import GHC.Utils.Panic
    32 
    -import GHC.Types.SourceError
    33 
    -import GHC.Types.SrcLoc
    34 
    -import GHC.Types.PkgQual
    35 
    -import Data.List (partition)
    36 
    -import GHC.Utils.TmpFs
    31 
    +import GHC.Driver.Make
    32 
    +import GHC.Driver.Monad
    33 
    +import GHC.Driver.Phases
    34 
    +import GHC.Driver.Pipeline
    35 
    +import GHC.Driver.Pipeline.Monad
    36 
    +import GHC.Driver.Session
    37 37
    38 
    +import GHC.Iface.Errors.Types
    38 39 
     import GHC.Iface.Load (cannotFindModule)
    39 40
    41 
    +import GHC.SysTools qualified as SysTools
    42 
    +import GHC.Types.PkgQual
    43 
    +import GHC.Types.SourceError
    44 
    +import GHC.Types.SrcLoc
    45 
    +import GHC.Types.Unique.Set (UniqSet)
    46 
    +import GHC.Types.Unique.Set qualified as UniqSet
    47 
    +import GHC.Types.UnresolvedImport
    48 
    +
    49 
    +import GHC.Unit.Finder
    50 
    +import GHC.Unit.Info
    40 51 
     import GHC.Unit.Module
    41 
    -import GHC.Unit.Module.ModSummary
    42 52 
     import GHC.Unit.Module.Graph
    43 
    -import GHC.Unit.Finder
    53 
    +import GHC.Unit.Module.ModSummary
    54 
    +import GHC.Unit.State (lookupUnitId)
    44 55
    45 
    -import GHC.Utils.Exception
    46 56 
     import GHC.Utils.Error
    57 
    +import GHC.Utils.Exception
    58 
    +import GHC.Utils.Json
    47 59 
     import GHC.Utils.Logger
    60 
    +import GHC.Utils.Misc
    61 
    +import GHC.Utils.Outputable
    62 
    +import GHC.Utils.Panic
    63 
    +import GHC.Utils.TmpFs
    48 64
    65 
    +import Control.Monad (when)
    66 
    +import Data.Either
    67 
    +import Data.Foldable (traverse_)
    68 
    +import Data.IORef
    69 
    +import Data.List (partition)
    70 
    +import Data.Map.Strict qualified as Map
    71 
    +import Data.Maybe (isJust, isNothing)
    72 
    +import Data.Semigroup qualified as Semigroup
    73 
    +import Data.Set qualified as Set
    74 
    +import GHC.Generics (Generic, Generically (..))
    49 75 
     import System.Directory
    50 
    -import System.FilePath
    76 
    +import qualified System.Directory as Directory
    77 
    +import System.OsPath as OsPath
    51 78 
     import System.IO
    52 
    -import System.IO.Error  ( isEOFError )
    53 
    -import Control.Monad    ( when, forM_ )
    54 
    -import Data.Maybe       ( isJust )
    55 
    -import Data.IORef
    56 
    -import qualified Data.Set as Set
    57 
    -import GHC.Iface.Errors.Types
    58 
    -import Data.Either
    59 
    -import GHC.Data.Bag (listToBag)
    79 
    +import System.IO.Error (isEOFError)
    80 
    +import qualified System.OsString as OsString
    81 
    +import qualified Data.Monoid as Monoid
    60 82
    61 83 
     -----------------------------------------------------------------
    62 84 
     --
    ... ... @@ -98,27 +120,47 @@ doMkDependHS srcs = do
    98 120
    99 121 
     doMkDependModuleGraph :: GhcMonad m =>  DynFlags -> ModuleGraph -> m ()
    100 122 
     doMkDependModuleGraph dflags module_graph = do
    123 
    +    hsc_env <- getSession
    101 124 
         logger <- getLogger
    102 
    -    tmpfs <- hsc_tmpfs <$> getSession
    103 
    -    let excl_mods = depExcludeMods dflags
    125 
    +    let
    126 
    +      tmpfs = hsc_tmpfs hsc_env
    127 
    +      excl_mods = depExcludeMods dflags
    104 128
    105 
    -    files <- liftIO $ beginMkDependHS logger tmpfs dflags
    106 
    -    let sorted = GHC.topSortModuleGraph False module_graph Nothing
    129 
    +    root_ <- liftIO getCurrentDirectory
    130 
    +    root <- encodeUtf root_
    107 131
    132 
    +    let
    133 
    +      backends = concat
    134 
    +        [ [ initFileDepWriter logger root tmpfs dflags
    135 
    +          ]
    136 
    +        , [ initJsonDepWriter json_output dflags
    137 
    +          | Just json_output <- [depJson dflags]
    138 
    +          ]
    139 
    +        ]
    140 
    +
    141 
    +
    142 
    +    let sorted = GHC.topSortModuleGraph False module_graph Nothing
    108 143 
         -- Print out the dependencies if wanted
    109 144 
         liftIO $ debugTraceMsg logger 2 (text "Module dependencies" $$ ppr sorted)
    110 145
    111 
    -    -- Process them one by one, dumping results into makefile
    112 
    -    -- and complaining about cycles
    113 
    -    hsc_env <- getSession
    114 
    -    root <- liftIO getCurrentDirectory
    115 
    -    mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
    146 
    +    liftIO $ do
    147 
    +
    148 
    +      -- Setup the writers
    149 
    +      writers <- sequenceA backends
    150 
    +      sinks <- traverse dw_beginWriter writers
    116 151
    117 
    -    -- If -ddump-mod-cycles, show cycles in the module graph
    118 
    -    liftIO $ dumpModCycles logger module_graph
    152 
    +      -- Do the actual work
    153 
    +      do
    154 
    +        -- Process them one by one, dumping results and complaining about cycles
    155 
    +        mapM_ (processDeps dflags hsc_env (UniqSet.mkUniqSet excl_mods) sinks) sorted
    156 
    +
    157 
    +        -- If -ddump-mod-cycles, show cycles in the module graph
    158 
    +        liftIO $ dumpModCycles logger module_graph
    159 
    +
    160 
    +      -- Tidy up
    161 
    +      do
    162 
    +        traverse_ dw_endWriter writers
    119 163
    120 
    -    -- Tidy up
    121 
    -    liftIO $ endMkDependHS logger files
    122 164
    123 165 
         -- Unconditional exiting is a bad idea.  If an error occurs we'll get an
    124 166 
         --exception; if that is not caught it's fine, but at least we have a
    ... ... @@ -127,6 +169,201 @@ doMkDependModuleGraph dflags module_graph = do
    127 169
    128 170 
         --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)
    129 171
    172 
    +--------------------------------------------------------------------------------
    173 
    +-- Types abstracting over the output
    174 
    +--------------------------------------------------------------------------------
    175 
    +
    176 
    +data DepNode =
    177 
    +  DepNode
    178 
    +    { dn_mod :: Module
    179 
    +    , dn_src :: OsPath
    180 
    +    , dn_obj :: OsPath
    181 
    +    , dn_hi :: OsPath
    182 
    +    , dn_boot :: IsBootInterface
    183 
    +    , dn_preprocessing :: PreprocessingNode
    184 
    +    }
    185 
    +
    186 
    +data PreprocessingNode = PreprocessingNode
    187 
    +  { pn_preprocessor :: Maybe String
    188 
    +  , pn_options :: [String]
    189 
    +  }
    190 
    +
    191 
    +data Dep
    192 
    +  = DepHi
    193 
    +    { dep_mod :: Module
    194 
    +    , dep_path :: OsPath
    195 
    +    , dep_unit :: Maybe UnitInfo
    196 
    +    , dep_local :: Bool
    197 
    +    , dep_boot :: IsBootInterface
    198 
    +    }
    199 
    +  | DepCpp
    200 
    +    { dep_path :: OsPath
    201 
    +    }
    202 
    +
    203 
    +data DependencyWriter = DependencyWriter
    204 
    +  { dw_beginWriter :: IO DepSink
    205 
    +  , dw_endWriter :: IO ()
    206 
    +  }
    207 
    +
    208 
    +data DepSink = DepSink
    209 
    +  { ds_writeDependency :: DepNode -> [Dep] -> IO ()
    210 
    +  }
    211 
    +
    212 
    +-----------------------------------------------------------------
    213 
    +--
    214 
    +--              processDeps
    215 
    +--
    216 
    +-----------------------------------------------------------------
    217 
    +
    218 
    +processDeps :: DynFlags
    219 
    +            -> HscEnv
    220 
    +            -> UniqSet ModuleName -- ^ Excludes
    221 
    +            -> [DepSink]
    222 
    +            -> SCC ModuleGraphNode
    223 
    +            -> IO ()
    224 
    +-- Write suitable dependencies to handle
    225 
    +-- Always:
    226 
    +--                      this.o : this.hs
    227 
    +--
    228 
    +-- If the dependency is on something other than a .hi file:
    229 
    +--                      this.o this.p_o ... : dep
    230 
    +-- otherwise
    231 
    +--                      this.o ...   : dep.hi
    232 
    +--                      this.p_o ... : dep.p_hi
    233 
    +--                      ...
    234 
    +-- (where .o is $osuf, and the other suffixes come from
    235 
    +-- the cmdline -s options).
    236 
    +--
    237 
    +-- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
    238 
    +
    239 
    +processDeps _ hsc_env _ _ (CyclicSCC nodes)
    240 
    +  =     -- There shouldn't be any cycles; report them
    241 
    +    throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $ cyclicModuleErr nodes
    242 
    +
    243 
    +processDeps _ hsc_env _ _ (AcyclicSCC (InstantiationNode _uid node))
    244 
    +  =     -- There shouldn't be any backpack instantiations; report them as well
    245 
    +    throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $
    246 
    +      mkPlainErrorMsgEnvelope noSrcSpan $
    247 
    +      GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node
    248 
    +
    249 
    +processDeps _dflags _ _ _ (AcyclicSCC (LinkNode {})) = return ()
    250 
    +processDeps _dflags _ _ _ (AcyclicSCC (UnitNode {})) = return ()
    251 
    +processDeps _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {})))
    252 
    +  -- No dependencies needed for fixed modules (already compiled)
    253 
    +  = return ()
    254 
    +
    255 
    +processDeps dflags hsc_env excl_mods sinks (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) = do
    256 
    +  pp <- preprocessor
    257 
    +  let
    258 
    +    dep_node = mkDepNode pp
    259 
    +    find_deps imps = do
    260 
    +      cpp_deps <- find_cpp_deps
    261 
    +      import_deps <- find_import_deps imps
    262 
    +      pure $ map Right cpp_deps ++ import_deps
    263 
    +  (missing_dep_errs, deps) <- partitionEithers <$> find_deps (ms_imps node)
    264 
    +
    265 
    +  if null missing_dep_errs
    266 
    +    then do
    267 
    +      traverse_ (\ sink -> ds_writeDependency sink dep_node deps) sinks
    268 
    +    else do
    269 
    +      let sec = initSourceErrorContext (hsc_dflags hsc_env)
    270 
    +      throwErrors sec (mkMessages (listToBag missing_dep_errs))
    271 
    +  where
    272 
    +    src_file = msHsFileOsPath node
    273 
    +    mkDepNode preproc =
    274 
    +      DepNode
    275 
    +        { dn_mod = ms_mod node
    276 
    +        , dn_src = src_file
    277 
    +        , dn_obj = msObjFileOsPath node
    278 
    +        , dn_hi = msHiFileOsPath node
    279 
    +        , dn_boot = isBootSummary node
    280 
    +        , dn_preprocessing = preproc
    281 
    +        }
    282 
    +
    283 
    +    preprocessor :: IO PreprocessingNode
    284 
    +    preprocessor
    285 
    +      | Just src <- ml_hs_file_ospath (ms_location node)
    286 
    +      = runPipeline (hsc_hooks hsc_env) $ do
    287 
    +        let
    288 
    +          (_, suffix) = OsPath.splitExtension src
    289 
    +          srcFn = unsafeDecodeUtf src
    290 
    +          lit | Unlit _ <- startPhase (unsafeDecodeUtf suffix) = True
    291 
    +              | otherwise = False
    292 
    +          pipe_env = mkPipeEnv StopPreprocess srcFn Nothing NoOutputFile
    293 
    +        unlit_fn <- if lit then use (T_Unlit pipe_env hsc_env srcFn) else pure srcFn
    294 
    +        (dflags1, opts, _, _) <- use (T_FileArgs (hsc_logger hsc_env) (hsc_dflags hsc_env) unlit_fn)
    295 
    +        let pp = pgm_F dflags1
    296 
    +        pure PreprocessingNode
    297 
    +          { pn_preprocessor = if null pp then global_preprocessor else Just pp
    298 
    +          , pn_options = opts
    299 
    +          }
    300 
    +      | otherwise
    301 
    +      = pure PreprocessingNode
    302 
    +          { pn_preprocessor = global_preprocessor
    303 
    +          , pn_options = []
    304 
    +          }
    305 
    +
    306 
    +    global_preprocessor :: Maybe String
    307 
    +    global_preprocessor
    308 
    +      | let pp = pgm_F dflags
    309 
    +      , not (null pp)
    310 
    +      = Just pp
    311 
    +      | otherwise
    312 
    +      = Nothing
    313 
    +
    314 
    +    -- Emit a dependency for each CPP import
    315 
    +    -- CPP deps are discovered in the module parsing phase by parsing
    316 
    +    -- comment lines left by the preprocessor.
    317 
    +    -- Note that GHC.parseModule may throw an exception if the module
    318 
    +    -- fails to parse, which may not be desirable (see #16616).
    319 
    +    find_cpp_deps :: IO [Dep]
    320 
    +    find_cpp_deps =
    321 
    +      if depIncludeCppDeps dflags
    322 
    +        then do
    323 
    +          session <- Session <$> newIORef hsc_env
    324 
    +          parsedMod <- reflectGhc (GHC.parseModule node) session
    325 
    +          pure (DepCpp . unsafeEncodeUtf <$> GHC.pm_extra_src_files parsedMod)
    326 
    +        else
    327 
    +          pure []
    328 
    +
    329 
    +    -- Emit a dependency for each import
    330 
    +    find_import_deps :: [UnresolvedImport PkgQual] -> IO [Either (MsgEnvelope GhcMessage) Dep]
    331 
    +    find_import_deps idecls =
    332 
    +      sequence
    333 
    +        [ findDependency hsc_env decl
    334 
    +        | decl <- idecls
    335 
    +        , let L _loc mod = ui_mod_name decl
    336 
    +        , not $ mod `UniqSet.elementOfUniqSet` excl_mods
    337 
    +        ]
    338 
    +
    339 
    +findDependency  :: HscEnv
    340 
    +                -> UnresolvedImport PkgQual   -- The import to find
    341 
    +                -> IO (Either (MsgEnvelope GhcMessage) Dep)  -- Interface file
    342 
    +findDependency hsc_env imp = do
    343 
    +  -- Find the module; this will be fast because
    344 
    +  -- we've done it once during downsweep.
    345 
    +  r <- resolveImport hsc_env imp
    346 
    +  case r of
    347 
    +    Found loc dep_mod ->
    348 
    +      pure $ Right
    349 
    +        DepHi
    350 
    +          { dep_mod = dep_mod
    351 
    +          , dep_path = ml_hi_file_ospath loc
    352 
    +          , dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod)
    353 
    +          , dep_local = isJust (ml_hs_file loc)
    354 
    +          , dep_boot = is_boot
    355 
    +          }
    356 
    +
    357 
    +    fail ->
    358 
    +      return $
    359 
    +        Left $
    360 
    +          mkPlainErrorMsgEnvelope srcloc $
    361 
    +          GhcDriverMessage $ DriverInterfaceError $
    362 
    +             (Can'tFindInterface (cannotFindModule hsc_env mod_name fail) (LookingForModule mod_name is_boot))
    363 
    +  where
    364 
    +    L srcloc mod_name = ui_mod_name imp
    365 
    +    is_boot           = ui_boot imp
    366 
    +
    130 367 
     -----------------------------------------------------------------
    131 368 
     --
    132 369 
     --              beginMkDependHs
    ... ... @@ -136,6 +373,18 @@ doMkDependModuleGraph dflags module_graph = do
    136 373 
     --
    137 374 
     -----------------------------------------------------------------
    138 375
    376 
    +initFileDepWriter :: Logger -> OsPath -> TmpFs -> DynFlags -> IO DependencyWriter
    377 
    +initFileDepWriter logger root tmpfs dflags = do
    378 
    +  files <- beginMkDependHS logger tmpfs dflags
    379 
    +  pure DependencyWriter
    380 
    +    { dw_beginWriter = do
    381 
    +        pure $ DepSink $ \ node deps -> do
    382 
    +          writeDependencies (depIncludePkgDeps dflags) root (mkd_tmp_hdl files) suffixes node deps
    383 
    +    , dw_endWriter = endMkDependHS logger files
    384 
    +    }
    385 
    +  where
    386 
    +    suffixes = map unsafeEncodeUtf (depSuffixes dflags)
    387 
    +
    139 388 
     data MkDepFiles
    140 389 
       = MkDep { mkd_make_file :: FilePath,          -- Name of the makefile
    141 390 
                 mkd_make_hdl  :: Maybe Handle,      -- Handle for the open makefile
    ... ... @@ -151,7 +400,7 @@ beginMkDependHS logger tmpfs dflags = do
    151 400
    152 401 
             -- open the makefile
    153 402 
       let makefile = depMakefile dflags
    154 
    -  exists <- doesFileExist makefile
    403 
    +  exists <- Directory.doesFileExist makefile
    155 404 
       mb_make_hdl <-
    156 405 
             if not exists
    157 406 
             then return Nothing
    ... ... @@ -188,175 +437,86 @@ beginMkDependHS logger tmpfs dflags = do
    188 437 
       return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
    189 438 
                       mkd_tmp_file  = tmp_file, mkd_tmp_hdl  = tmp_hdl})
    190 439
    440 
    +writeDependencies ::
    441 
    +  Bool ->
    442 
    +  OsPath ->
    443 
    +  Handle ->
    444 
    +  [OsString] ->
    445 
    +  -- ^ Suffixes
    446 
    +  DepNode ->
    447 
    +  [Dep] ->
    448 
    +  IO ()
    449 
    +writeDependencies include_pkgs root hdl suffixes node deps =
    450 
    +  traverse_ write tasks
    451 
    +  where
    452 
    +    tasks = source_dep : boot_dep ++ concatMap import_dep deps
    453 
    +
    454 
    +    -- Emit std dependency of the object(s) on the source file
    455 
    +    -- Something like       A.o : A.hs
    456 
    +    source_dep = (obj_files, dn_src)
    457 
    +
    458 
    +    -- add dependency between objects and their corresponding .hi-boot
    459 
    +    -- files if the module has a corresponding .hs-boot file (#14482)
    460 
    +    boot_dep
    461 
    +      | IsBoot <- dn_boot
    462 
    +      = [([obj], hi) | (obj, hi) <- zip (suffixed (removeBootSuffix dn_obj)) (suffixed dn_hi)]
    463 
    +      | otherwise
    464 
    +      = []
    465 
    +
    466 
    +    -- Add one dependency for each suffix;
    467 
    +    -- e.g.         A.o   : B.hi
    468 
    +    --              A.x_o : B.x_hi
    469 
    +    import_dep = \case
    470 
    +      DepHi {dep_path, dep_unit}
    471 
    +        | isNothing dep_unit || include_pkgs
    472 
    +        -> [([obj], hi) | (obj, hi) <- zip obj_files (suffixed dep_path)]
    191 473
    192 
    ------------------------------------------------------------------
    193 
    ---
    194 
    ---              processDeps
    195 
    ---
    196 
    ------------------------------------------------------------------
    197 
    -
    198 
    -processDeps :: DynFlags
    199 
    -            -> HscEnv
    200 
    -            -> [ModuleName]
    201 
    -            -> FilePath
    202 
    -            -> Handle           -- Write dependencies to here
    203 
    -            -> SCC ModuleGraphNode
    204 
    -            -> IO ()
    205 
    --- Write suitable dependencies to handle
    206 
    --- Always:
    207 
    ---                      this.o : this.hs
    208 
    ---
    209 
    --- If the dependency is on something other than a .hi file:
    210 
    ---                      this.o this.p_o ... : dep
    211 
    --- otherwise
    212 
    ---                      this.o ...   : dep.hi
    213 
    ---                      this.p_o ... : dep.p_hi
    214 
    ---                      ...
    215 
    --- (where .o is $osuf, and the other suffixes come from
    216 
    --- the cmdline -s options).
    217 
    ---
    218 
    --- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
    219 
    -
    220 
    -processDeps _ hsc_env _ _ _ (CyclicSCC nodes)
    221 
    -  =     -- There shouldn't be any cycles; report them
    222 
    -    throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $ cyclicModuleErr nodes
    223 
    -
    224 
    -processDeps _ hsc_env _ _ _ (AcyclicSCC (InstantiationNode _uid node))
    225 
    -  =     -- There shouldn't be any backpack instantiations; report them as well
    226 
    -    throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $
    227 
    -      mkPlainErrorMsgEnvelope noSrcSpan $
    228 
    -      GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node
    229 
    -
    230 
    -processDeps _dflags _ _ _ _ (AcyclicSCC (LinkNode {})) = return ()
    231 
    -processDeps _dflags _ _ _ _ (AcyclicSCC (UnitNode {})) = return ()
    232 
    -processDeps _ _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {})))
    233 
    -  -- No dependencies needed for fixed modules (already compiled)
    234 
    -  = return ()
    235 
    -processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node)))
    236 
    -  = do  { let extra_suffixes = depSuffixes dflags
    237 
    -              include_pkg_deps = depIncludePkgDeps dflags
    238 
    -              src_file  = msHsFilePath node
    239 
    -              obj_file  = msObjFilePath node
    240 
    -              obj_files = insertSuffixes obj_file extra_suffixes
    241 
    -
    242 
    -
    243 
    -
    244 
    -                -- Emit std dependency of the object(s) on the source file
    245 
    -                -- Something like       A.o : A.hs
    246 
    -        ; writeDependency root hdl obj_files src_file
    247 
    -
    248 
    -          -- add dependency between objects and their corresponding .hi-boot
    249 
    -          -- files if the module has a corresponding .hs-boot file (#14482)
    250 
    -        ; when (isBootSummary node == IsBoot) $ do
    251 
    -            let hi_boot = msHiFilePath node
    252 
    -            let obj     = unsafeDecodeUtf $ removeBootSuffix (msObjFileOsPath node)
    253 
    -            forM_ extra_suffixes $ \suff -> do
    254 
    -               let way_obj     = insertSuffixes obj     [suff]
    255 
    -               let way_hi_boot = insertSuffixes hi_boot [suff]
    256 
    -               mapM_ (writeDependency root hdl way_obj) way_hi_boot
    257 
    -
    258 
    -                -- Emit a dependency for each CPP import
    259 
    -        ; when (depIncludeCppDeps dflags) $ do
    260 
    -            -- CPP deps are discovered in the module parsing phase by parsing
    261 
    -            -- comment lines left by the preprocessor.
    262 
    -            -- Note that GHC.parseModule may throw an exception if the module
    263 
    -            -- fails to parse, which may not be desirable (see #16616).
    264 
    -          { session <- Session <$> newIORef hsc_env
    265 
    -          ; parsedMod <- reflectGhc (GHC.parseModule node) session
    266 
    -          ; mapM_ (writeDependency root hdl obj_files)
    267 
    -                  (GHC.pm_extra_src_files parsedMod)
    268 
    -          }
    269 
    -
    270 
    -                -- Emit a dependency for each import
    271 
    -
    272 
    -        ; let find_deps imps = sequence
    273 
    -                    [ findDependency hsc_env imp include_pkg_deps
    274 
    -                    | imp <- imps
    275 
    -                    , unLoc (ui_mod_name imp) `notElem` excl_mods
    276 
    -                    ]
    277 
    -
    278 
    -              do_imp hi_file = do
    279 
    -                let hi_files = insertSuffixes hi_file extra_suffixes
    280 
    -                    write_dep (obj,hi) = writeDependency root hdl [obj] hi
    281 
    -
    282 
    -                 -- Add one dependency for each suffix;
    283 
    -                 -- e.g.         A.o   : B.hi
    284 
    -                 --              A.x_o : B.x_hi
    285 
    -                mapM_ write_dep (obj_files `zip` hi_files)
    474 
    +        | otherwise
    475 
    +        -> []
    286 476
    287 
    -        ; (missing_dep_errs, deps) <- partitionEithers <$> find_deps (ms_imps node)
    477 
    +      DepCpp {dep_path} -> [(obj_files, dep_path)]
    288 478
    289 
    -        ; if null missing_dep_errs
    290 
    -            then mapM_ (mapM_ do_imp) deps
    291 
    -            else do
    292 
    -              let sec = initSourceErrorContext (hsc_dflags hsc_env)
    293 
    -              throwErrors sec (mkMessages (listToBag missing_dep_errs))
    294 
    -        }
    479 
    +    write (from, to) = writeDependency root hdl from to
    295 480
    296 
    -findDependency  :: HscEnv
    297 
    -                -> UnresolvedImport PkgQual   -- The import to find
    298 
    -                -> Bool                 -- Record dependency on package modules
    299 
    -                -> IO (Either (MsgEnvelope GhcMessage) (Maybe FilePath))  -- Interface file
    300 
    -findDependency hsc_env imp include_pkg_deps = do
    301 
    -  -- Find the module; this will be fast because
    302 
    -  -- we've done it once during downsweep.
    303 
    -  r <- resolveImport hsc_env imp
    304 
    -  case r of
    305 
    -    Found loc _
    306 
    -        -- Home package: just depend on the .hi or hi-boot file
    307 
    -        | isJust (ml_hs_file loc) || include_pkg_deps
    308 
    -        -> return (Right (Just (ml_hi_file loc)))
    481 
    +    obj_files = suffixed dn_obj
    309 482
    310 
    -        -- Not in this package: we don't need a dependency
    311 
    -        | otherwise
    312 
    -        -> return (Right Nothing)
    483 
    +    suffixed f = insertSuffixes f suffixes
    313 484
    314 
    -    fail ->
    315 
    -      return $
    316 
    -        Left $
    317 
    -          mkPlainErrorMsgEnvelope srcloc $
    318 
    -          GhcDriverMessage $ DriverInterfaceError $
    319 
    -             (Can'tFindInterface (cannotFindModule hsc_env mod_name fail) (LookingForModule mod_name is_boot))
    320 
    -  where
    321 
    -    L srcloc mod_name = ui_mod_name imp
    322 
    -    is_boot           = ui_boot imp
    485 
    +    DepNode {dn_src, dn_obj, dn_hi, dn_boot} = node
    323 486
    324 487 
     -----------------------------
    325 
    -writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
    488 
    +writeDependency :: OsPath -> Handle -> [OsPath] -> OsPath -> IO ()
    326 489 
     -- (writeDependency r h [t1,t2] dep) writes to handle h the dependency
    327 490 
     --      t1 t2 : dep
    328 491 
     writeDependency root hdl targets dep
    329 492 
       = do let -- We need to avoid making deps on
    330 493 
                --     c:/foo/...
    331 
    -           -- on Windows as make gets confused by the :
    494 
    +           -- on cygwin as make gets confused by the :
    332 495 
                -- Making relative deps avoids some instances of this.
    333 
    -           dep' = makeRelative root dep
    334 
    -           forOutput = escapeSpaces . reslash Forwards . normalise
    496 
    +           dep' = OsPath.makeRelative root dep
    497 
    +           forOutput = escapeSpaces . reslash Forwards . unsafeDecodeUtf . OsPath.normalise
    335 498 
                output = unwords (map forOutput targets) ++ " : " ++ forOutput dep'
    336 499 
            hPutStrLn hdl output
    337 500
    338 501 
     -----------------------------
    339 502 
     insertSuffixes
    340 
    -        :: FilePath     -- Original filename;   e.g. "foo.o"
    341 
    -        -> [String]     -- Suffix prefixes      e.g. ["x_", "y_"]
    342 
    -        -> [FilePath]   -- Zapped filenames     e.g. ["foo.x_o", "foo.y_o"]
    503 
    +        :: OsPath     -- Original filename;   e.g. "foo.o"
    504 
    +        -> [OsString]     -- Suffix prefixes      e.g. ["x_", "y_"]
    505 
    +        -> [OsPath]   -- Zapped filenames     e.g. ["foo.x_o", "foo.y_o"]
    343 506 
             -- Note that the extra bit gets inserted *before* the old suffix
    344 507 
             -- We assume the old suffix contains no dots, so we know where to
    345 508 
             -- split it
    346 509 
     insertSuffixes file_name extras
    347 
    -  = [ basename <.> (extra ++ suffix) | extra <- extras ]
    510 
    +  = [ basename <.> (extra Monoid.<> suffix) | extra <- extras ]
    348 511 
       where
    349 
    -    (basename, suffix) = case splitExtension file_name of
    512 
    +    (basename, suffix) = case OsPath.splitExtension file_name of
    350 513 
                              -- Drop the "." from the extension
    351 
    -                         (b, s) -> (b, drop 1 s)
    514 
    +                         (b, s) -> (b, OsString.drop 1 s)
    352 515
    353 516
    354 517 
     -----------------------------------------------------------------
    355 
    ---
    356 
    ---              endMkDependHs
    357 
    ---      Complete the makefile, close the tmp file etc
    358 
    ---
    359 
    ------------------------------------------------------------------
    518 
    +-- endMkDependHs
    519 
    +-- Complete the makefile, close the tmp file etc
    360 520
    361 521 
     endMkDependHS :: Logger -> MkDepFiles -> IO ()
    362 522
    ... ... @@ -385,6 +545,186 @@ endMkDependHS logger
    385 545 
       showPass logger "Installing new makefile"
    386 546 
       SysTools.copyFile tmp_file makefile
    387 547
    548 
    +-----------------------------------------------------------------
    549 
    +--
    550 
    +--              JSON MkDepends output
    551 
    +--
    552 
    +-----------------------------------------------------------------
    553 
    +
    554 
    +initJsonDepWriter :: FilePath -> DynFlags -> IO DependencyWriter
    555 
    +initJsonDepWriter output dflags = do
    556 
    +  json_var <- mkJsonOutput output initDepJson
    557 
    +  pure DependencyWriter
    558 
    +    { dw_beginWriter =
    559 
    +        pure $ DepSink $ \ node deps ->
    560 
    +          updateJson json_var (updateDepJson (depIncludePkgDeps dflags) node deps)
    561 
    +    , dw_endWriter =
    562 
    +        writeJsonOutput json_var
    563 
    +    }
    564 
    +
    565 
    +--------------------------------------------------------------------------------
    566 
    +-- Output interface for json dumps
    567 
    +
    568 
    +-- | Resources for a json dump option, used in "GHC.Driver.MakeFile".
    569 
    +-- The flag @-dep-json@ add an additional output target for dependency
    570 
    +-- diagnostics.
    571 
    +data JsonOutput a =
    572 
    +  JsonOutput {
    573 
    +    -- | This ref is updated in @processDeps@ incrementally, using a
    574 
    +    -- flag-specific type.
    575 
    +    json_ref :: IORef a,
    576 
    +
    577 
    +    -- | The output file path specified as argument to the flag.
    578 
    +    json_path :: FilePath
    579 
    +  }
    580 
    +
    581 
    +-- | TODO: @fendor
    582 
    +mkJsonOutput ::
    583 
    +  FilePath ->
    584 
    +  IO (IORef a) ->
    585 
    +  IO (JsonOutput a)
    586 
    +mkJsonOutput json_path mk_ref = do
    587 
    +  json_ref <- mk_ref
    588 
    +  pure JsonOutput {json_ref, json_path}
    589 
    +
    590 
    +-- | Update the dump data in 'json_ref' if the output target is present.
    591 
    +updateJson :: JsonOutput a -> (a -> a) -> IO ()
    592 
    +updateJson JsonOutput {json_ref} f = modifyIORef' json_ref f
    593 
    +
    594 
    +-- | Write a json object to the flag-dependent file if the output target is
    595 
    +-- present.
    596 
    +writeJsonOutput ::
    597 
    +  ToJson a =>
    598 
    +  JsonOutput a ->
    599 
    +  IO ()
    600 
    +writeJsonOutput JsonOutput {json_ref, json_path} = do
    601 
    +  payload <- readIORef json_ref
    602 
    +  writeJsonFile payload json_path
    603 
    +
    604 
    +--------------------------------------------------------------------------------
    605 
    +-- Output helpers
    606 
    +
    607 
    +writeJsonFile :: ToJson a => a -> FilePath -> IO ()
    608 
    +writeJsonFile doc p = do
    609 
    +  withAtomicRename p
    610 
    +    $ \tmp -> writeFile tmp $ showSDocUnsafe $ renderJSON $ json doc
    611 
    +
    612 
    +--------------------------------------------------------------------------------
    613 
    +-- Payload for -dep-json
    614 
    +
    615 
    +newtype PackageDeps
    616 
    +  = PackageDeps (Map.Map (String, UnitId, DPackageId) (Set.Set ModuleName))
    617 
    +  deriving newtype (Monoid)
    618 
    +
    619 
    +newtype DPackageId = DPackageId PackageId
    620 
    +  deriving newtype (Eq)
    621 
    +
    622 
    +instance Ord DPackageId where
    623 
    +  DPackageId (PackageId d1) `compare` DPackageId (PackageId d2) = d1 `lexicalCompareFS` d2
    624 
    +
    625 
    +instance Semigroup PackageDeps where
    626 
    +  PackageDeps l <> PackageDeps r = PackageDeps (Map.unionWith (Semigroup.<>) l r)
    627 
    +
    628 
    +data Deps
    629 
    +  = Deps
    630 
    +  { sources :: Set.Set OsPath
    631 
    +  , modules :: (Set.Set ModuleName, Set.Set ModuleName)
    632 
    +  , packages :: PackageDeps
    633 
    +  , cpp :: Set.Set OsPath
    634 
    +  , options :: [String]
    635 
    +  , preprocessor :: Maybe FilePath
    636 
    +  }
    637 
    +  deriving stock (Generic)
    638 
    +  deriving (Semigroup, Monoid) via (Generically Deps)
    639 
    +
    640 
    +newtype DepJson = DepJson (Map.Map ModuleName Deps)
    641 
    +
    642 
    +instance ToJson DepJson where
    643 
    +  json (DepJson m) =
    644 
    +    JSObject [
    645 
    +      (moduleNameString target, JSObject [
    646 
    +        ("sources", array sources (showOsPath . normalise)),
    647 
    +        ("modules", array (fst modules) moduleNameString),
    648 
    +        ("modules-boot", array (snd modules) moduleNameString),
    649 
    +        ("packages",
    650 
    +          JSArray
    651 
    +            [ package name unit_id package_id mods
    652 
    +            | ((name, unit_id, dpkd_id), mods) <- Map.toList packages
    653 
    +            , let DPackageId package_id = dpkd_id
    654 
    +            ]
    655 
    +        ),
    656 
    +        ("cpp", array cpp showOsPath),
    657 
    +        ("options", JSArray $ map JSString options),
    658 
    +        ("preprocessor", maybe JSNull JSString preprocessor)
    659 
    +      ])
    660 
    +      | (target, Deps {packages = PackageDeps packages, ..}) <- Map.toList m
    661 
    +    ]
    662 
    +    where
    663 
    +      package name unit_id (PackageId package_id) mods =
    664 
    +        JSObject [
    665 
    +          ("id", JSString (unitIdString unit_id)),
    666 
    +          ("name", JSString name),
    667 
    +          ("package-id", JSString (unpackFS package_id)),
    668 
    +          ("modules", array mods moduleNameString)
    669 
    +        ]
    670 
    +
    671 
    +      array values render = JSArray (fmap (JSString . render) (Set.toList values))
    672 
    +
    673 
    +      showOsPath = unsafeDecodeUtf
    674 
    +
    675 
    +initDepJson :: IO (IORef DepJson)
    676 
    +initDepJson = newIORef $ DepJson Map.empty
    677 
    +
    678 
    +insertDepJson :: [ModuleName] -> Deps -> DepJson -> DepJson
    679 
    +insertDepJson targets dep (DepJson m0) =
    680 
    +  DepJson
    681 
    +    $ foldl'
    682 
    +      ( \acc target ->
    683 
    +          Map.insertWith
    684 
    +            (Semigroup.<>)
    685 
    +            target
    686 
    +            dep
    687 
    +            acc
    688 
    +      )
    689 
    +      m0
    690 
    +      targets
    691 
    +
    692 
    +updateDepJson :: Bool -> DepNode -> [Dep] -> DepJson -> DepJson
    693 
    +updateDepJson include_pkgs DepNode {..} deps =
    694 
    +  insertDepJson [moduleName dn_mod] payload
    695 
    +  where
    696 
    +    payload = node_data Semigroup.<> foldMap dep deps
    697 
    +
    698 
    +    node_data =
    699 
    +      mempty {
    700 
    +        sources = Set.singleton dn_src,
    701 
    +        preprocessor = pn_preprocessor dn_preprocessing,
    702 
    +        options = pn_options dn_preprocessing
    703 
    +      }
    704 
    +
    705 
    +    dep = \case
    706 
    +      DepHi {dep_mod, dep_local, dep_unit, dep_boot}
    707 
    +        | dep_local
    708 
    +        , let set = Set.singleton $ moduleName dep_mod
    709 
    +              value | IsBoot <- dep_boot = (Set.empty, set)
    710 
    +                    | otherwise = (set, Set.empty)
    711 
    +        -> mempty {modules = value}
    712 
    +
    713 
    +        | include_pkgs
    714 
    +        , Just unit <- dep_unit
    715 
    +        , let PackageName nameFS = unitPackageName unit
    716 
    +              name = unpackFS nameFS
    717 
    +              withLibName (PackageName c) = name ++ ":" ++ unpackFS c
    718 
    +              lname = maybe name withLibName (unitComponentName unit)
    719 
    +              key = (lname, unitId unit, DPackageId $ unitPackageId unit)
    720 
    +        -> mempty {packages = PackageDeps (Map.singleton key (Set.singleton $ moduleName dep_mod))}
    721 
    +
    722 
    +        | otherwise
    723 
    +        -> mempty
    724 
    +
    725 
    +      DepCpp {dep_path} ->
    726 
    +        mempty {cpp = Set.singleton dep_path}
    727 
    +
    388 728
    389 729 
     -----------------------------------------------------------------
    390 730 
     --              Module cycles

  • compiler/GHC/Driver/Pipeline.hs
    ... ... @@ -820,13 +820,13 @@ preprocessPipeline pipe_env hsc_env input_fn = do
    820 820 
           use (T_Unlit pipe_env hsc_env input_fn)
    821 821
    822 822
    823 
    -  (dflags1, p_warns1, warns1) <- use (T_FileArgs hsc_env unlit_fn)
    823 
    +  (dflags1, _, p_warns1, warns1) <- use (fileArgsPhase hsc_env unlit_fn)
    824 824 
       let hsc_env1 = hscSetFlags dflags1 hsc_env
    825 825
    826 826 
       (cpp_fn, hsc_env2)
    827 827 
         <- runAfterFlag hsc_env1 (Cpp HsSrcFile) (xopt LangExt.Cpp) (unlit_fn, hsc_env1) $ do
    828 828 
               cpp_fn <- use (T_Cpp pipe_env hsc_env1 unlit_fn)
    829 
    -          (dflags2, _, _) <- use (T_FileArgs hsc_env1 cpp_fn)
    829 
    +          (dflags2, _, _, _) <- use (fileArgsPhase hsc_env1 cpp_fn)
    830 830 
               let hsc_env2 = hscSetFlags dflags2 hsc_env1
    831 831 
               return (cpp_fn, hsc_env2)
    832 832
    ... ... @@ -841,7 +841,8 @@ preprocessPipeline pipe_env hsc_env input_fn = do
    841 841 
               then return (dflags1, p_warns1, warns1)
    842 842 
               else do
    843 843 
                 -- Reparse with original hsc_env so that we don't get duplicated options
    844 
    -            use (T_FileArgs hsc_env pp_fn)
    844 
    +            (dflagsPP, _, p_warns3, warns3) <- use (fileArgsPhase hsc_env pp_fn)
    845 
    +            pure (dflagsPP, p_warns3, warns3)
    845 846
    846 847 
       let print_config = initPrintConfig dflags3
    847 848 
       liftIO (printOrThrowDiagnostics (hsc_logger hsc_env) print_config (initDiagOpts dflags3) (GhcPsMessage <$> p_warns3))
    ... ... @@ -865,6 +866,9 @@ preprocessPipeline pipe_env hsc_env input_fn = do
    865 866 
               runAfter phase def
    866 867 
                $ phaseIfFlag hsc_env flag def action
    867 868
    869 
    +        fileArgsPhase env fn =
    870 
    +          T_FileArgs (hsc_logger env) (hsc_dflags env) fn
    871 
    +
    868 872 
     -- | The complete compilation pipeline, from start to finish
    869 873 
     fullPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> m (ModIface, RecompLinkables)
    870 874 
     fullPipeline pipe_env hsc_env pp_fn src_flavour = do

  • compiler/GHC/Driver/Pipeline/Execute.hs
    ... ... @@ -104,7 +104,7 @@ runPhase :: TPhase out -> IO out
    104 104 
     runPhase (T_Unlit pipe_env hsc_env inp_path) = do
    105 105 
       out_path <- phaseOutputFilenameNew (Cpp HsSrcFile) pipe_env hsc_env Nothing
    106 106 
       runUnlitPhase hsc_env inp_path out_path
    107 
    -runPhase (T_FileArgs hsc_env inp_path) = getFileArgs hsc_env inp_path
    107 
    +runPhase (T_FileArgs logger dflags inp_path) = getFileArgsNoHsc logger dflags inp_path
    108 108 
     runPhase (T_Cpp pipe_env hsc_env inp_path) = do
    109 109 
       out_path <- phaseOutputFilenameNew (HsPp HsSrcFile) pipe_env hsc_env Nothing
    110 110 
       runCppPhase hsc_env inp_path out_path
    ... ... @@ -620,17 +620,21 @@ runUnlitPhase hsc_env input_fn output_fn = do
    620 620
    621 621 
         return output_fn
    622 622
    623 
    -getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, Messages PsMessage, Messages DriverMessage))
    623 
    +getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, [String], Messages PsMessage, Messages DriverMessage))
    624 624 
     getFileArgs hsc_env input_fn = do
    625 625 
       let dflags0 = hsc_dflags hsc_env
    626 626 
           logger  = hsc_logger hsc_env
    627 
    -      parser_opts = initParserOpts dflags0
    627 
    +  getFileArgsNoHsc logger dflags0 input_fn
    628 
    +
    629 
    +getFileArgsNoHsc :: Logger -> DynFlags -> FilePath -> IO ((DynFlags, [String], Messages PsMessage, Messages DriverMessage))
    630 
    +getFileArgsNoHsc logger dflags0 input_fn = do
    631 
    +  let parser_opts = initParserOpts dflags0
    628 632 
           sec = initSourceErrorContext dflags0
    629 633 
       (warns0, src_opts) <- getOptionsFromFile parser_opts sec (supportedLanguagePragmas dflags0) input_fn
    630 634 
       (dflags1, unhandled_flags, warns)
    631 635 
         <- parseDynamicFilePragma logger dflags0 src_opts
    632 636 
       checkProcessArgsResult dflags0 unhandled_flags
    633 
    -  return (dflags1, warns0, warns)
    637 
    +  return (dflags1, map unLoc src_opts, warns0, warns)
    634 638
    635 639 
     runCppPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath
    636 640 
     runCppPhase hsc_env input_fn output_fn = do

  • compiler/GHC/Driver/Pipeline/Phases.hs
    ... ... @@ -13,6 +13,7 @@ import GHC.Driver.Errors.Types
    13 13 
     import GHC.Fingerprint.Type
    14 14 
     import GHC.Unit.Module.Location ( ModLocation )
    15 15 
     import GHC.Unit.Module.ModIface
    16 
    +import GHC.Utils.Logger
    16 17 
     import GHC.Driver.Phases
    17 18
    18 19 
     import Language.Haskell.Syntax.Module.Name ( ModuleName )
    ... ... @@ -25,7 +26,7 @@ import GHC.Unit.Home.ModInfo
    25 26 
     -- phase if the inputs have been modified.
    26 27 
     data TPhase res where
    27 28 
       T_Unlit :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
    28 
    -  T_FileArgs :: HscEnv -> FilePath -> TPhase (DynFlags, Messages PsMessage, Messages DriverMessage)
    29 
    +  T_FileArgs :: Logger -> DynFlags -> FilePath -> TPhase ((DynFlags, [String], Messages PsMessage, Messages DriverMessage))
    29 30 
       T_Cpp   :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
    30 31 
       T_HsPp  :: PipeEnv -> HscEnv -> FilePath -> FilePath -> TPhase FilePath
    31 32 
       T_HscRecomp :: PipeEnv -> HscEnv -> FilePath -> HscSource -> TPhase (HscEnv, ModSummary, HscRecompStatus)

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -760,6 +760,12 @@ addOptCmmP f = alterToolSettings $ \s -> s
    760 760 
     setDepMakefile :: FilePath -> DynFlags -> DynFlags
    761 761 
     setDepMakefile f d = d { depMakefile = f }
    762 762
    763 
    +setDepJson :: FilePath -> DynFlags -> DynFlags
    764 
    +setDepJson f d = d { depJson = Just f }
    765 
    +
    766 
    +unsetDepJson :: DynFlags -> DynFlags
    767 
    +unsetDepJson d = d { depJson = Nothing }
    768 
    +
    763 769 
     setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags
    764 770 
     setDepIncludeCppDeps b d = d { depIncludeCppDeps = b }
    765 771
    ... ... @@ -1245,6 +1251,8 @@ dynamic_flags_deps = [
    1245 1251 
             -------- ghc -M -----------------------------------------------------
    1246 1252 
       , make_ord_flag defGhcFlag "dep-suffix"              (hasArg addDepSuffix)
    1247 1253 
       , make_ord_flag defGhcFlag "dep-makefile"            (hasArg setDepMakefile)
    1254 
    +  , make_ord_flag defGhcFlag "dep-json"                (hasArg setDepJson)
    1255 
    +  , make_ord_flag defGhcFlag "no-dep-json"             (noArg unsetDepJson)
    1248 1256 
       , make_ord_flag defGhcFlag "include-cpp-deps"
    1249 1257 
             (noArg (setDepIncludeCppDeps True))
    1250 1258 
       , make_ord_flag defGhcFlag "include-pkg-deps"

  • docs/users_guide/separate_compilation.rst
    ... ... @@ -1503,6 +1503,23 @@ generation are:
    1503 1503 
         ``.depend`` and then ``include`` the file ``.depend`` into
    1504 1504 
         ``Makefile``.
    1505 1505
    1506 
    +.. ghc-flag:: -dep-json ⟨file⟩
    1507 
    +    :shortdesc: Also emit ⟨file⟩ as a JSON file containing dependencies
    1508 
    +    :type: dynamic
    1509 
    +    :reverse: -no-dep-json
    1510 
    +    :category: redirect-output
    1511 
    +
    1512 
    +    In addition to the makefile, also emit ⟨file⟩ as a JSON file
    1513 
    +    containing the same dependencies info, so it can be parsed by
    1514 
    +    external build systems. The JSON file contains a single object,
    1515 
    +    mapping each target to a list of dependencies.
    1516 
    +    In addition to the makefile, each module's payload will contain the
    1517 
    +    values of ``OPTIONS`` and ``LANGUAGE`` pragmas of the source
    1518 
    +    file, so it can be parsed by external build systems. Each ``LANGUAGE``
    1519 
    +    pragma is represented as an option as well, e.g.
    1520 
    +    ``{-# LANGUAGE TemplateHaskell #-}`` is represented as
    1521 
    +    ``"-XTemplateHaskell"``.
    1522 
    +
    1506 1523 
     .. ghc-flag:: -dep-suffix ⟨suffix⟩
    1507 1524 
         :shortdesc: Make dependencies that declare that files with suffix
    1508 1525 
             ``.⟨suf⟩⟨osuf⟩`` depend on interface files with suffix ``.⟨suf⟩hi``

  • testsuite/tests/driver/T24384/A.hs
    1 
    +{-# language Strict #-}
    2 
    +{-# options_ghc -fexpose-all-unfoldings #-}
    3 
    +module A where
    4 
    +
    5 
    +import {-# source #-} C

  • testsuite/tests/driver/T24384/C.hs
    1 
    +module C where
    2 
    +
    3 
    +import A
    4 
    +import Data.Set
    5 
    +
    6 
    +data C = C

  • testsuite/tests/driver/T24384/C.hs-boot
    1 
    +module C where
    2 
    +
    3 
    +import E
    4 
    +
    5 
    +data C

  • testsuite/tests/driver/T24384/D.hs
    1 
    +module D where
    2 
    +
    3 
    +import B
    4 
    +import C

  • testsuite/tests/driver/T24384/E.hs
    1 
    +module E where
    2 
    +
    3 
    +import Language.Haskell.TH.Syntax
    4 
    +import Dep
    5 
    +import DepPublic
    6 
    +
    7 
    +e :: Q Exp
    8 
    +e = lift (5 :: Integer)
    9 
    +
    10 
    +edep :: ()
    11 
    +edep = dep
    12 
    +
    13 
    +edepPub :: ()
    14 
    +edepPub = depPub

  • testsuite/tests/driver/T24384/Makefile
    1 
    +TOP=../../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +
    6 
    +PKGCONF_LOCAL=./db.package.conf
    7 
    +GHC_PKG_LOCAL='$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_LOCAL)
    8 
    +
    9 
    +T24384_prep:
    10 
    +	rm -r $(PKGCONF_LOCAL) || true
    11 
    +	$(GHC_PKG_LOCAL) init $(PKGCONF_LOCAL) 2>&1 >/dev/null
    12 
    +
    13 
    +	cd dep-internal && \
    14 
    +		'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
    15 
    +			-v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-internal-1-XXX  \
    16 
    +			-package base \
    17 
    +			-i. DepInternal
    18 
    +	$(GHC_PKG_LOCAL) register --force dep-internal/dep-internal.pkg 2>&1 >/dev/null
    19 
    +
    20 
    +	cd dep-public && \
    21 
    +		'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
    22 
    +			-v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-public-1-XXX  \
    23 
    +			-package base \
    24 
    +			-i. DepPublic
    25 
    +	$(GHC_PKG_LOCAL) register --force dep-public/dep-public.pkg 2>&1 >/dev/null
    26 
    +
    27 
    +	cd dep && \
    28 
    +		'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
    29 
    +			-v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-1-XXX \
    30 
    +			-package-db ../$(PKGCONF_LOCAL) -package-id dep-internal-1-XXX \
    31 
    +			-i. Dep
    32 
    +	$(GHC_PKG_LOCAL) register --force dep/dep.pkg 2>&1 >/dev/null
    33 
    +
    34 
    +T24384a: T24384_prep
    35 
    +	'$(TEST_HC)' -M -dep-makefile T24384a.Makefile -include-pkg-deps -include-cpp-deps \
    36 
    +		-hide-all-packages -package base -package containers -package template-haskell \
    37 
    +		-package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \
    38 
    +		A.hs lib/B.hs C.hs D.hs E.hs
    39 
    +
    40 
    +	cat T24384a.Makefile
    41 
    +
    42 
    +T24384b: T24384_prep
    43 
    +	'$(TEST_HC)' -M -dep-json dep.json -include-pkg-deps -include-cpp-deps \
    44 
    +		-hide-all-packages -package base -package containers -package template-haskell \
    45 
    +		-package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \
    46 
    +		A.hs lib/B.hs C.hs D.hs E.hs
    47 
    +
    48 
    +	cat dep.json | jq --sort-keys

  • testsuite/tests/driver/T24384/T24384a.stdout
    1 
    +# DO NOT DELETE: Beginning of Haskell dependencies
    2 
    +E.o : E.hs
    3 
    +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
    4 
    +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
    5 
    +E.o : dep-public/outdir/DepPublic.hi
    6 
    +E.o : dep/outdir/Dep.hi
    7 
    +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
    8 
    +C.o-boot : C.hs-boot
    9 
    +C.o : C.hi-boot
    10 
    +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
    11 
    +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
    12 
    +C.o-boot : E.hi
    13 
    +A.o : A.hs
    14 
    +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
    15 
    +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
    16 
    +A.o : C.hi-boot
    17 
    +C.o : C.hs
    18 
    +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
    19 
    +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
    20 
    +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
    21 
    +C.o : A.hi
    22 
    +lib/B.o : lib/B.hs
    23 
    +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
    24 
    +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
    25 
    +lib/B.o : A.hi
    26 
    +D.o : D.hs
    27 
    +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
    28 
    +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
    29 
    +D.o : C.hi
    30 
    +D.o : lib/B.hi
    31 
    +# DO NOT DELETE: End of Haskell dependencies

  • testsuite/tests/driver/T24384/all.T
    1 
    +test_extras =  extra_files(
    2 
    +  ['A.hs', 'lib/', 'C.hs', 'C.hs-boot', 'D.hs', 'E.hs',
    3 
    +  'dep', 'dep-internal', 'dep-public',
    4 
    +  'preproc.sh'
    5 
    +  ])
    6 
    +
    7 
    +test('T24384a', [ test_extras, pre_cmd('$MAKE -s --no-print-directory T24384_prep') ], makefile_test, [])
    8 
    +test('T24384b', [ test_extras, pre_cmd('$MAKE -s --no-print-directory T24384_prep') ], makefile_test, [])

  • testsuite/tests/driver/T24384/dep-internal/DepInternal.hs
    1 
    +module DepInternal where
    2 
    +depInt :: ()
    3 
    +depInt = ()

  • testsuite/tests/driver/T24384/dep-internal/dep-internal.pkg
    1 
    +name: dep-internal
    2 
    +version: 1
    3 
    +id: dep-internal-1-XXX
    4 
    +key: dep-internal-1-XXX
    5 
    +visibility:           public
    6 
    +abi: inplace
    7 
    +exposed-modules:      DepInternal
    8 
    +depends:
    9 
    +import-dirs: ${pkgroot}/dep-internal/outdir
    10 
    +library-dirs: ${pkgroot}/dep-internal/outdir
    11 
    +include-dirs:

  • testsuite/tests/driver/T24384/dep-public/DepPublic.hs
    1 
    +module DepPublic where
    2 
    +depPub :: ()
    3 
    +depPub = ()

  • testsuite/tests/driver/T24384/dep-public/dep-public.pkg
    1 
    +name: dep-public
    2 
    +version: 1
    3 
    +id: dep-public-1-XXX
    4 
    +key: dep-public-1-XXX
    5 
    +visibility:           public
    6 
    +abi: inplace
    7 
    +exposed-modules:      DepPublic
    8 
    +depends:
    9 
    +import-dirs: ${pkgroot}/dep-public/outdir
    10 
    +library-dirs: ${pkgroot}/dep-public/outdir
    11 
    +include-dirs:

  • testsuite/tests/driver/T24384/dep/Dep.hs
    1 
    +module Dep where
    2 
    +import DepInternal
    3 
    +dep :: ()
    4 
    +dep = depInt

  • testsuite/tests/driver/T24384/dep/dep.pkg
    1 
    +name: dep
    2 
    +version: 1
    3 
    +id: dep-1-XXX
    4 
    +key: dep-1-XXX
    5 
    +visibility:           public
    6 
    +abi: inplace
    7 
    +exposed-modules:      Dep
    8 
    +depends:              dep-internal-1-XXX
    9 
    +import-dirs: ${pkgroot}/dep/outdir
    10 
    +library-dirs: ${pkgroot}/dep/outdir
    11 
    +include-dirs:

  • testsuite/tests/driver/T24384/lib/B.hs
    1 
    +{-# options_ghc -F -pgmF ./preproc.sh #-}
    2 
    +module B where

  • testsuite/tests/driver/T24384/preproc.sh
    1 
    +#!/usr/bin/env bash
    2 
    +
    3 
    +sed '/preproc/d' $2 > $3
    4 
    +echo 'import A' >> $3

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/compare/51dc8da5c57b99d1f1badd271e2fd33983c86c3b...13dd8d668f93306b61a9ec4806686635db139fe7 at 1790251557