Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 53eead15 by Wolfgang Jeltsch at 2026-09-24T20:12:03-04:00 Correct the documentation of `explicitUnits` Resolves #27787. - - - - - 35bf6f4b by Simon Jakobi at 2026-09-24T20:12:49-04:00 Remove stale specHeader bullet from Note [Don't make fillers for constraint types] The Note said that Specialise.specHeader also calls mkAbsentFiller. abfc224a27c removed that call: the specialiser no longer drops dead arguments at all, see Note [Do not drop dead args from specialisations] in GHC.Core.Opt.Specialise. Assisted-by: Claude Fable 5.1 - - - - - 514d28cc by Wolfgang Jeltsch at 2026-09-25T13:11:36-04:00 Improve the `mhu-closure` makefile - - - - - 49e5112e by Wolfgang Jeltsch at 2026-09-25T13:11:36-04:00 Make `ghci-multi` hide all unneeded packages - - - - - 69e4d73f by Wolfgang Jeltsch at 2026-09-25T13:11:36-04:00 Improve the definition of the home unit closure property - - - - - ec357a2d by Wolfgang Jeltsch at 2026-09-25T13:11:36-04:00 Re-implement the home unit closure check Compared to the previous implementation, the new one has the following advantages: * It is correct. - It distinguishes between units that have the same unit ID but different ABI hashes. - When `-hide-all-packages` is not used, it considers as home unit dependencies also units that are made implicitly available because they are in the package database. * It seems to be faster in usual settings. - In particular, it does not have a preparation phase in which it merges the dependency information from all home units, so that its running time does not grow linearly with the size of the package database in normal Cabal scenarios. * It is (hopefully) clearer. * It is better documented. - - - - - f57edc3e by Wolfgang Jeltsch at 2026-09-25T13:11:36-04:00 Remove erroneous GHC flag in `hadrian-multi` The flag was `-Werror=-Wno-error=incomplete-record-selectors`. Its purpose was to permit incomplete record selectors, but because of the illegal combination of `-Werror=` and `-Wno-error` it was ignored, without any negative consequences. - - - - - ce087204 by Alan Zimmerman at 2026-09-25T13:11:37-04:00 EPA: Add specific layout field to AnnList Up to now AnnList has effectively served to represent lists of things having layout, regardless of whether they do or not. In Haskell, layout is optional in many places, as there is also an alternative syntax using braces and semi-colons, which is free-form. This commit introduces AnnListLayout, a data structure capturing this distinction. It is deliberately set up similarly to EpLayout, so that these two can be merged in time. The transition is done mechanically, where AnnListBraces is not used yet, the original Nothing case maps to AnnListNoLayout, and the Just case to AnnListLayout. Later commits will fine tune these against the actual parser layout. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/State.hs - hadrian/ghci-multi-cabal.in - testsuite/tests/driver/multipleHomeUnits/mhu-closure/Makefile - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stderr - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stdout - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T15279.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -497,12 +497,7 @@ hadrian-multi: # workaround for docker permissions - sudo chown ghc:ghc -R . variables: - GHC_FLAGS: "-Werror=-Wno-error=incomplete-record-selectors -Wwarn=deprecations -Wwarn=unused-imports" - # -Wno-error=incomplete-record-selectors is present because -Wall now - # includes -Wincomplete-record-selectors, and hadrian-multi has many, many - # warnings about incomplete record selectors. A better fix would be to - # remove the use of incomplete record selectors, since each of them represents - # a potential crash. + GHC_FLAGS: "-Wwarn=deprecations -Wwarn=unused-imports" CONFIGURE_ARGS: --enable-bootstrap-with-devel-snapshot tags: - x86_64-linux ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1367,13 +1367,8 @@ It's surprisingly subtle. application; see test `T27627f`. TL;DR: we play safe: we never make an absent filler for any /constraint-kinded/ type, -using `isPredTy` to decide. - - * `mkAbsentFiller` returns `Nothing` for any constraint type, so worker/wrapper - keeps the real argument. - - * `Specialise.specHeader` calls `mkAbsentFiller` too, so it likewise keeps the - dead dictionary argument rather than dropping it for a filler. +using `isPredTy` to decide: `mkAbsentFiller` returns `Nothing` for any constraint +type, so worker/wrapper keeps the real argument. Prior failed approaches ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -6,6 +6,8 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-invalid-haddock #-} + -- | See Note [The ModuleGraph] module GHC.Driver.Downsweep ( downsweep @@ -54,8 +56,6 @@ import GHC.Runtime.Context import Language.Haskell.Syntax.ImpExp import GHC.Types.UnresolvedImport -import GHC.Data.Graph.Directed -import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.Maybe as M import GHC.Data.OsPath ( OsPath, unsafeEncodeUtf ) @@ -71,12 +71,15 @@ import GHC.Utils.Logger import GHC.Utils.Fingerprint import GHC.Utils.TmpFs import GHC.Utils.Constants +import GHC.Utils.Monad (concatMapM) +import GHC.Utils.Monad.State.Strict import GHC.Types.Error import GHC.Types.Target import GHC.Types.SourceFile import GHC.Types.SourceError import GHC.Types.SrcLoc +import GHC.Types.Unique.Set import GHC.Types.Unique.Map import GHC.Types.PkgQual import GHC.Types.Basic @@ -91,9 +94,12 @@ import GHC.Unit.Module.Graph import GHC.Unit.Module.Deps import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.Module.Stage +import GHC.Unit.External.Index (UnitAbiHash) import Data.Either ( partitionEithers, lefts ) +import Data.Map (Map) import qualified Data.Map as Map +import Data.Set (Set) import qualified Data.Set as Set import Control.Concurrent.MVar @@ -101,7 +107,7 @@ import Control.Monad import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) import qualified Control.Monad.Catch as MC import Data.Maybe -import Data.List (partition) +import Data.List (sort, partition) import Data.Time import Data.List (unfoldr) import Data.Bifunctor (first, bimap) @@ -864,7 +870,7 @@ getRootSummary excl_mods summ_cache imports_cache hsc_env target mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file) | TargetModule modl <- targetId = do - let root_imp = (generatedImport FromTarget (L rootLoc modl)) + let root_imp = (generatedImport FromTarget (L noSrcSpan modl)) { ui_pkg_qual = ThisPkg (homeUnitId home_unit) } maybe_summary <- summariseModule hsc_env home_unit summ_cache imports_cache root_imp maybe_buf excl_mods @@ -875,7 +881,6 @@ getRootSummary excl_mods summ_cache imports_cache hsc_env target where Target {targetId, targetContents = maybe_buf, targetUnitId = uid} = target home_unit = ue_unitHomeUnit uid (hsc_unit_env hsc_env) - rootLoc = mkGeneralSrcSpan (fsLit "<command line>") dflags = homeUnitEnv_dflags (ue_findHomeUnitEnv uid (hsc_unit_env hsc_env)) -- | Execute 'getRootSummary' for the 'Target's using the parallelism pipeline @@ -933,52 +938,171 @@ rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do -- * Check/validate properties and error out -------------------------------------------------------------------------------- --- | This function checks then important property that if both p and q are home units --- then any dependency of p, which transitively depends on q is also a home unit. +-- | Checks whether the given 'UnitEnv' has the closure property. -- --- See Note [Multiple Home Units], section 'Closure Property'. -checkHomeUnitsClosed :: UnitEnv -> [DriverMessages] -checkHomeUnitsClosed ue - | Set.null bad_unit_ids = [] - | otherwise = [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)] +-- See the section “Closure Property” in @Note [Multiple Home Units]@ for the +-- definition of the closure property and +-- @Note [Home unit closure property check]@ below for a discussion of the +-- algorithm used for this check, its justification, and a potential +-- alternative. +checkHomeUnitsClosed :: UnitEnv -> [DriverMessages] +checkHomeUnitsClosed unit_env + | null offenders = [] + | otherwise = [ + singleMessage $ + mkPlainErrorMsgEnvelope noSrcSpan $ + DriverHomePackagesNotClosed (sort offenders) + ] where - home_id_set = HUG.allUnits $ ue_home_unit_graph ue - bad_unit_ids = upwards_closure Set.\\ home_id_set {- Remove all home units reached, keep only bad nodes -} - rootLoc = mkGeneralSrcSpan (fsLit "<command line>") - downwards_closure :: Graph (Node UnitId UnitId) - downwards_closure = graphFromEdgedVerticesUniq graphNodes + -- | The 'UnitId' and 'HomeUnitEnv' of each home unit. + home_unit_data :: [(UnitId, HomeUnitEnv)] + home_unit_data = HUG.unitEnv_assocs (ue_home_unit_graph unit_env) + + -- | The 'UnitId's of all home units. + home_units :: UniqSet UnitId + home_units = mkUniqSet (map fst home_unit_data) + + -- | All offending dependencies. A dependency of a unit /u/ on a unit /v/ is + -- offending exactly if /u/ is an external unit reachable from a home unit + -- and /v/ is a home unit. Each such dependency is represented in this list + -- by the pair of the 'UnitId' of /u/ and the 'UnitId' of /v/. + offenders :: [(UnitId, UnitId)] + offenders + = evalState (collect (map (homeUnitEnv_units . snd) home_unit_data)) + emptyUniqMap + where - inverse_closure = graphReachability $ transposeG downwards_closure + -- | Collects offending dependencies. + collect :: [UnitState] + -- ^ The 'UnitState's of the home units from which to traverse + -- the dependency graph. + -> State (UniqMap UnitId (Set UnitAbiHash)) [(UnitId, UnitId)] + -- ^ A stateful computation that collects offending dependencies + -- that have not yet been found. It uses its state, which is an + -- efficent representation of a set of 'GlobalUnitKey's, to + -- keep track of which units have already been considered as + -- sources of offending dependencies. + collect = concatMapM $ \ unit_state -> + collect_for_home_unit + (unitInfoMap unit_state) + (map (toUnitId . fst) $ explicitUnits $ unit_state) + where - upwards_closure = Set.fromList $ map node_key $ allReachableMany inverse_closure [DigraphNode uid uid [] | uid <- Set.toList home_id_set] + -- | Collects offending dependencies that are reachable from a particular + -- home unit. + collect_for_home_unit + :: UnitInfoMap + -- ^ The 'UnitInfoMap' of the home unit. + -> [UnitId] + -- ^ The 'UnitId's of the units from which to traverse the dependency + -- graph. + -> State (UniqMap UnitId (Set UnitAbiHash)) [(UnitId, UnitId)] + -- ^ A stateful computation that collects offending dependencies that + -- have not yet been found. It uses its state, which is an efficent + -- representation of a set of 'GlobalUnitKey's, to keep track of + -- which units have already been considered as sources of offending + -- dependencies. + collect_for_home_unit _ [] + = return [] + collect_for_home_unit unit_info_map (current_unit : remaining_units) = do + let + + -- | The 'UnitInfo' of the current unit. + unit_info :: UnitInfo + unit_info + = fromMaybe (pprPanic unit_not_found_msg (ppr current_unit)) $ + lookupUniqMap unit_info_map current_unit + where + + -- | The message that says that a unit was not found. + unit_not_found_msg :: String + unit_not_found_msg = "Unit not found during closure property check" + + -- | The ABI hash of the current unit. + unit_abi_hash :: UnitAbiHash + unit_abi_hash = unitAbiHash unit_info + + has_been_processed <- gets $ maybe False (Set.member unit_abi_hash) . + (`lookupUniqMap` current_unit) + if has_been_processed + then collect_for_home_unit unit_info_map remaining_units + else do + modify $ \ processed -> addToUniqMap_C Set.union + processed + current_unit + (Set.singleton unit_abi_hash) + let + + -- | The 'UnitId's of the units that the current unit depends on. + needed_units :: [UnitId] + needed_units = unitDepends unit_info + + -- | The offending dependencies of the current unit. + current_offenders :: [(UnitId, UnitId)] + current_offenders + | current_unit `elementOfUniqSet` home_units + = [] + | otherwise + = map ((,) current_unit) $ + nonDetEltsUniqSet $ + mkUniqSet needed_units `intersectUniqSets` home_units + + remaining_offenders <- collect_for_home_unit unit_info_map $ + needed_units ++ remaining_units + return $ current_offenders ++ remaining_offenders - all_unit_direct_deps :: UniqMap UnitId (Set.Set UnitId) - all_unit_direct_deps - = HUG.unitEnv_foldWithKey go emptyUniqMap $ ue_home_unit_graph ue - where - go rest this this_uis = - plusUniqMap_C Set.union - (addToUniqMap_C Set.union external_depends this (Set.fromList $ this_deps)) - rest - where - external_depends = mapUniqMap (Set.fromList . unitDepends) (unitInfoMap this_units) - this_units = homeUnitEnv_units this_uis - this_deps = [ toUnitId unit | (unit,Just _) <- explicitUnits this_units] - - graphNodes :: [Node UnitId UnitId] - graphNodes = go Set.empty home_id_set - where - go done todo - = case Set.minView todo of - Nothing -> [] - Just (uid, todo') - | Set.member uid done -> go done todo' - | otherwise -> case lookupUniqMap all_unit_direct_deps uid of - Nothing -> pprPanic "uid not found" (ppr (uid, all_unit_direct_deps)) - Just depends -> - let todo'' = (depends Set.\\ done) `Set.union` todo' - in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) todo'' +{- + +Note [Home unit closure property check] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Per the definition in Note [Multiple Home Units], a unit environment has the +closure property exactly if there are no paths /h/₁ →* /e/ →* /h/₂ in the +dependency graph, where /h/₁ and /h/₂ are home units and /e/ is an external +unit. However, the algorithm used by 'checkHomeUnitsClosed' searches for +so-called offending dependencies, which are dependencies /e/ → /h/₂ that are +part of a path /h/₁ →* /e/ → /h/₂ in the dependency graph. To see that this is a +viable approach, consider the following: + + * A path /h/₁ →* /e/ → /h/₂ is also a path /h/₁ →* /e/ →* /h/₂. + + * For each path /h/₁ →* /e/ →* /h/₂, there exists a path /h/₁ →* /e/′ → /h/₂′, + where /e/′ is an external unit and /h/₂′ is a home unit. Such a path can be + constructed by taking as /h/₂′ the first home unit on the path /e/ →* /h/₂ + and as /e/′ the, necessarily external, unit preceding it. + +Concretely, the algorithm picks one home unit after the other, determines what +units it directly depends on, and, starting from them, follows unit dependencies +to search for offending dependencies. It does not follow dependencies that have +been followed before, possibly when processing another home unit. To achieve +this, the algorithm tracks, across home units, from which units it has already +followed dependencies. For this tracking, it identifies each unit by a 'UnitId' +and an ABI hash. Using only a 'UnitId' would not work, because 'UnitId's are not +always globally unique. Also using only an ABI hash is not an option, because an +ABI hash is not necessarily an ABI hash: it can also be the string @"inline"@. + +The correctness of this algorithm rests on the, likely correct, assumption that, +among the units mentioned in the 'UnitState' of a particular home unit, any unit +can be uniquely identified by its 'UnitId' and thus 'UnitId' clashes can only +occur across the 'UnitState's of different home units. + +An alternative approach to finding offending dependencies would be to follow +dependencies starting from all units that /any/ home unit directly depends on +instead of considering the different home units separately. A corresponding +algorithm could in principle find the dependencies of a particular unit +independently of any home unit by fetching the 'UnitInfo' of that unit from the +'GlobalUnitInfoMap'. However, for such a lookup the algorithm would need not +only the 'UnitId' but also the ABI hash of the unit in question. Therefore, +whenever following a dependency of a unit /u/ on a unit /v/, it would have to +determine the ABI hash of /v/, so that it could later look up /v/’s +dependencies. The ABI hashes of all units that /u/ depends on should be +available in the 'unitAbiDepends' field of /u/’s 'UnitInfo'. However, at the +time of writing, 'unitAbiDepends' never contained anything other than the empty +list during GHC test runs, which indicated that this alternative solution was +impossible to realize. + +-} -------------------------------------------------------------------------------- -- * Enable Code Gen for Template Haskell @@ -1763,7 +1887,7 @@ data NodeRes v -- -- See also Note [Downsweep Control Flow and Caching] dfsBuild :: (Ord k, Monad m) - => Maybe (Map.Map k (NodeRes v)) + => Maybe (Map k (NodeRes v)) -- ^ Base map, existing results. We won't re-expand any of the nodes -- already present in this map. -> [n] @@ -1773,7 +1897,7 @@ dfsBuild :: (Ord k, Monad m) -> (n -> m (NodeRes (v,[n]))) -- ^ Expand this node into its payload result and into the list of -- children nodes to visit next. - -> m (Map.Map k (NodeRes v)) + -> m (Map k (NodeRes v)) -- ^ The result accumulates the payload of expanding the root nodes -- and all nodes transitively reachable from those roots. dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map) ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -235,10 +235,17 @@ instance Diagnostic DriverMessage where "but no output will be generated.") $$ (text "There is no module named" <+> quotes (ppr mod_name) <> text ".")) - DriverHomePackagesNotClosed needed_unit_ids - -> mkSimpleDecorated $ vcat ([text "Home units are not closed." - , text "It is necessary to also load the following units:" ] - ++ map (\uid -> text "-" <+> ppr uid) needed_unit_ids) + DriverHomePackagesNotClosed offending_dependencies + -> mkSimpleDecorated $ + hang (text "Some units are not loaded but depend on loaded units.") + 4 + (vcat (map pprDependency offending_dependencies)) + where + + pprDependency :: (UnitId, UnitId) -> SDoc + pprDependency (external_unit, home_unit) + = ppr external_unit <+> arrow <+> ppr home_unit + DriverInterfaceError reason -> diagnosticMessage (ifaceDiagnosticOpts opts) reason DriverInconsistentDynFlags msg ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -369,7 +369,7 @@ data DriverMessage where DriverRedirectedNoMain :: !ModuleName -> DriverMessage - DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage + DriverHomePackagesNotClosed :: ![(UnitId, UnitId)] -> DriverMessage DriverInterfaceError :: !IfaceMessage -> DriverMessage ===================================== compiler/GHC/Parser.y ===================================== @@ -1796,10 +1796,10 @@ cvars1 :: { [RecordPatSynField GhcPs] } where_decls :: { LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList) } : 'where' '{' decls '}' {% amsA' (sLL $1 $> (thdOf3 $ unLoc $3, epTok $1, - AnnList (Just (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3))) } + AnnList (AnnListLayout (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3))) } | 'where' vocurly decls close {% amsA' (sLL $1 $3 (thdOf3 $ unLoc $3, epTok $1, - AnnList (Just (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3))) } + AnnList (AnnListLayout (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3))) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype @@ -1935,9 +1935,9 @@ decls :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) } | {- empty -} { noLoc (noAnn, [],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } - : '{' decls '}' { sLL $1 $> (AnnList (Just (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) + : '{' decls '}' { sLL $1 $> (AnnList (AnnListLayout (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) ,sL1 $2 $ thdOf3 $ unLoc $2) } - | vocurly decls close { sL1 $2 (AnnList (Just (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) + | vocurly decls close { sL1 $2 (AnnList (AnnListLayout (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) ,sL1 $2 $ thdOf3 $ unLoc $2) } -- Binding groups other than those of class and instance declarations @@ -1945,16 +1945,16 @@ decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } binds :: { Located (HsLocalBinds GhcPs) } -- May have implicit parameters -- No type declarations - : decllist {% do { let { (AnnList anc p s, decls) = unLoc $1 } + : decllist {% do { let { (AnnList la p s, decls) = unLoc $1 } ; val_binds <- cvBindGroup (unLoc $ decls) ; !cs <- getCommentsFor (gl $1) - ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList anc p s) cs, noEpTok) val_binds)} } + ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList la p s) cs, noEpTok) val_binds)} } | '{' dbinds '}' {% acs (comb3 $1 $2 $3) (\loc cs -> (L loc - $ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (Just$ glR $2) (ListBraces (epTok $1) (epTok $3)) []) cs, noEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) } + $ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (AnnListLayout$ glR $2) (ListBraces (epTok $1) (epTok $3)) []) cs, noEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) } | vocurly dbinds close {% acs (gl $2) (\loc cs -> (L loc - $ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) ListNone []) cs, noEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) } + $ HsIPBinds (EpAnn (glR $1) (AnnList (AnnListLayout $ glR $2) ListNone []) cs, noEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) } wherebinds :: { Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments )) } @@ -3542,11 +3542,11 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } altslist(PATS) :: { forall b. DisambECP b => PV (LocatedA ([LMatch GhcPs (LocatedA b)], AnnList)) } : '{' alts(PATS) '}' { $2 >>= \ $2 -> amsA' (sLL $1 $> (reverse (snd $ unLoc $2), - (AnnList (Just $ glR $2) (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2)))) } + (AnnList (AnnListLayout $ glR $2) (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2)))) } | vocurly alts(PATS) close { $2 >>= \ $2 -> amsA' (L (getLoc $2) (reverse (snd $ unLoc $2), - (AnnList (Just $ glR $2) ListNone (fst $ unLoc $2)))) } - | '{' '}' { amsA' (sLL $1 $> ([], (AnnList Nothing (ListBraces (epTok $1) (epTok $2)) []))) } + (AnnList (AnnListLayout $ glR $2) ListNone (fst $ unLoc $2)))) } + | '{' '}' { amsA' (sLL $1 $> ([], (AnnList AnnListNoLayout (ListBraces (epTok $1) (epTok $2)) []))) } | vocurly close { return $ noLocA ([], noAnn) } alts(PATS) :: { forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)])) } @@ -3656,10 +3656,10 @@ apat : aexp {% (checkPattern <=< runPV) (unECP $1) } stmtlist :: { forall b. DisambECP b => PV (LocatedA (AnnList, Located [LocatedA (Stmt GhcPs (LocatedA b))])) } : '{' stmts '}' { $2 >>= \ $2 -> - amsA' (sLL $1 $> (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) (ListBraces (epTok $1) (epTok $3)) (fromOL $ fst $ unLoc $2) + amsA' (sLL $1 $> (AnnList (AnnListLayout (spanAsAnchor $ stmtsLoc $2)) (ListBraces (epTok $1) (epTok $3)) (fromOL $ fst $ unLoc $2) , sL1 $2 $ reverse $ snd $ unLoc $2))} | vocurly stmts close { $2 >>= \ $2 -> - amsA' (L (stmtsLoc $2) (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) ListNone (fromOL $ fst $ unLoc $2) + amsA' (L (stmtsLoc $2) (AnnList (AnnListLayout (spanAsAnchor $ stmtsLoc $2)) ListNone (fromOL $ fst $ unLoc $2) , sL1 $2 $ reverse $ snd $ unLoc $2))} -- do { ;; s ; s ; ; s ;; } @@ -4630,9 +4630,6 @@ glEEz !x !y = if isZeroWidthSpan (getHasLoc y) then spanAsAnchor (getHasLoc x) else spanAsAnchor $ comb2 x y -glRM :: Located a -> Maybe EpaLocation -glRM (L !l _) = Just $ spanAsAnchor l - n2l :: LocatedN a -> LocatedA a n2l (L !la !a) = L (l2l la) a ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -31,10 +31,6 @@ module GHC.Parser.Annotation ( SrcSpanAnnA, SrcSpanAnnN, -- ** Annotation data types used in 'GenLocated' - - AnnList(..), AnnListBrackets(..), - AnnParen(..), - AnnCType(..),AnnWarningTxt(..),AnnOverlap(..),AnnAnnDecl(..),AnnPragSCC(..), NameAnn(..), NameAdornment(..), NoEpAnns(..), @@ -43,6 +39,12 @@ module GHC.Parser.Annotation ( addTrailingAnnToA, addTrailingCommaToN, noTrailingN, + -- ** Annotation data types used in TTG extension points + + AnnList(..), AnnListBrackets(..), AnnListLayout(..), + AnnParen(..), + AnnCType(..),AnnWarningTxt(..),AnnOverlap(..),AnnAnnDecl(..),AnnPragSCC(..), + -- ** Utilities for converting between different 'GenLocated' when -- ** we do not care about the annotations. l2l, la2la, @@ -513,7 +515,7 @@ instance Outputable TrailingAnn where -- AZ: goal: only used when there is layout, so vertical alignment matters data AnnList = AnnList { - al_anchor :: !(Maybe EpaLocation), -- ^ start point of a list having layout + al_layout :: !AnnListLayout, al_brackets :: !AnnListBrackets, al_semis :: [EpToken ";"] -- decls } deriving (Data,Eq) @@ -523,6 +525,18 @@ data AnnListBrackets | ListNone deriving (Data,Eq) +-- | How the extent of a list was delimited in the source. +data AnnListLayout + = AnnListBraces -- ^ Explicit @{ ; }@ written by the user. The tokens + -- live in 'al_brackets' and 'al_semis'. + | AnnListLayout !EpaLocation + -- ^ The lexer opened an implicit layout context. + -- The 'EpaLocation' is the @vocurly@ token (or, for + -- MultiWayIf, the leading @|@), whose start column is + -- the layout column chosen by 'new_layout_context'. + | AnnListNoLayout -- ^ Neither: an Empty or compiler-generated list. + deriving (Data, Eq) + -- --------------------------------------------------------------------- -- Annotations for parenthesised elements, such as tuples, lists -- --------------------------------------------------------------------- @@ -993,7 +1007,10 @@ instance NoAnn NoEpAnns where noAnn = NoEpAnns instance NoAnn AnnList where - noAnn = AnnList Nothing ListNone noAnn + noAnn = AnnList noAnn ListNone noAnn + +instance NoAnn AnnListLayout where + noAnn = AnnListNoLayout instance NoAnn NameAnn where noAnn = NameAnnTrailing [] @@ -1094,6 +1111,11 @@ instance Outputable AnnListBrackets where ppr (ListBraces o c) = text "ListBraces" <+> ppr o <+> ppr c ppr ListNone = text "ListNone" +instance Outputable AnnListLayout where + ppr AnnListBraces = text "AnnListBraces" + ppr (AnnListLayout l) = text "AnnListLayout" <+> ppr l + ppr AnnListNoLayout = text "AnnListNoLayout" + instance Outputable AnnCType where ppr (AnnCType o c l ca) = text "AnnCType" <+> ppr o <+> ppr c <+> ppr l ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -466,7 +466,7 @@ add_where w@(EpTok (EpaSpan (RealSrcSpan rs _))) (EpAnn a al cs) cs2 = (EpAnn (widenAnchorT a w) al (cs Semi.<> cs2), w) | otherwise = (EpAnn (patch_anchor rs a) - (al { al_anchor = (fmap (patch_anchor rs) (al_anchor al))}) + (al { al_layout = patch_layout (al_layout al)}) (cs Semi.<> cs2), w) add_where _ _ _ = panic "add_where" -- EpaDelta should only be used for transformations @@ -484,6 +484,12 @@ patch_anchor r1 (EpaSpan (RealSrcSpan r0 mb)) = EpaSpan (RealSrcSpan r mb) r = if srcSpanStartLine r0 < 0 then r1 else r0 patch_anchor _ (EpaSpan ss) = EpaSpan ss +-- If the decl list for where binds is empty, the anchor ends up +-- invalid. Explicitly mark it as not having layout +patch_layout :: AnnListLayout -> AnnListLayout +patch_layout (AnnListLayout _) = AnnListNoLayout +patch_layout lo = lo + -- | The anchor for a stmtlist is based on either the location or -- the first semicolon annotion. stmtsAnchor :: Located (OrdList (EpToken tok),a) -> Maybe EpaLocation ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -443,13 +443,14 @@ The flow: Closure Property ---------------- -You must perform a clean cut of the dependency graph. +A unit environment must have the closure property: -> Any dependency which is not a home unit must not (transitively) depend on a home unit. + No used external unit depends on a home unit. -For example, if you have three packages p, q and r, then if p depends on q which -depends on r then it is illegal to load both p and r as home units but not q, -because q is a dependency of the home unit p which depends on another home unit r. +More concretely, a unit environment has the closure property exactly if no home +unit directly or indirectly depends on an external unit that directly or +indirectly depends on a home unit. 'GHC.Driver.Downsweep.checkHomeUnitsClosed' +checks whether a given unit environment indeed has this property. Offsetting Paths ---------------- ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -369,10 +369,15 @@ data UnitState = UnitState { -- is always mentioned before the units it depends on. preloadUnits :: [UnitId], - -- | Units which we explicitly depend on (from a command line flag). - -- We'll use this to generate version macros and the unused packages warning. The - -- original flag which was used to bring the unit into scope is recorded for the - -- -Wunused-packages warning. + -- | The units that can be used by the respective home unit. Despite the + -- identifier, this does not just cover units that are enabled explicitly + -- using flags but also units from the package database that are enabled + -- implicitly in case @-hide-all-packages@ is absent. The former are paired + -- with 'Just' applied to the respective flags, the latter are paired with + -- 'Nothing'. + -- + -- This field is used for generating version macros and “unused packages” + -- warnings. explicitUnits :: [(Unit, Maybe PackageArg)], homeUnitDepends :: Set UnitId, @@ -907,7 +912,7 @@ mkUnitState logger unit_index cfg = do let pkgname_map = listToUFM [ (unitPackageName p, unitInstanceOf p) | p <- pkgs2 ] - -- The explicitUnits accurately reflects the set of units we have turned + -- The explicitUnits accurately reflects the set of units that are turned -- on; as such, it also is the only way one can come up with requirements. -- The requirement context is directly based off of this: we simply -- look for nested unit IDs that are directly fed holes: the requirements ===================================== hadrian/ghci-multi-cabal.in ===================================== @@ -10,4 +10,4 @@ export TOOL_OUTPUT=.hadrian_ghci_multi/ghci_args # Replace newlines with spaces, as these otherwise break the ghci invocation on windows. CABFLAGS=-v0 "hadrian/build-cabal" multi --build-root=.hadrian_ghci_multi --flavour=ghc-in-ghci $HADRIAN_ARGS GHC_FLAGS="$GHC_FLAGS $(cat $TOOL_OUTPUT | tr '\n\r' ' ')" -$RUN_GHC --interactive $GHC_FLAGS $@ -fno-code -fwrite-interface -O0 +RTS -A128m +$RUN_GHC --interactive $GHC_FLAGS $@ -hide-all-packages -fno-code -fwrite-interface -O0 +RTS -A128m ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-closure/Makefile ===================================== @@ -3,39 +3,47 @@ include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk SETUP=../Setup -v0 +CONFIGURE=configure \ + $(CABAL_MINIMAL_BUILD) \ + --with-ghc='$(TEST_HC)' \ + --with-hc-pkg='$(GHC_PKG)' \ + --ghc-options='$(TEST_HC_OPTS)' \ + --package-db=../tmp.d +TEST_BUILD='$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -fforce-recomp +ONLY_BASE=-hide-all-packages -package base -mhu-closure: clean - $(MAKE) -s --no-print-directory clean +mhu-closure: clean pkg-database + ! $(TEST_BUILD) -unit @unitP + ! $(TEST_BUILD) -unit @unitP -unit @unitQ + ! $(TEST_BUILD) -unit @unitP -unit @unitR + ! $(TEST_BUILD) -unit @unitP -unit @unitR1 + $(TEST_BUILD) -unit @unitP -unit @unitQ -unit @unitR + ! $(TEST_BUILD) -unit @unitP -unit @unitQ -unit @unitR1 + $(TEST_BUILD) $(ONLY_BASE) -unit @unitP + $(TEST_BUILD) $(ONLY_BASE) -unit @unitP -unit @unitQ + ! $(TEST_BUILD) $(ONLY_BASE) -unit @unitP -unit @unitR + ! $(TEST_BUILD) $(ONLY_BASE) -unit @unitP -unit @unitR1 + $(TEST_BUILD) $(ONLY_BASE) -unit @unitP -unit @unitQ -unit @unitR + $(TEST_BUILD) $(ONLY_BASE) -unit @unitP -unit @unitQ -unit @unitR1 + +.PHONY: pkg-database +pkg-database: '$(GHC_PKG)' init tmp.d '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup - cd p && $(SETUP) clean - cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --ipid=p-0.1.0.0 --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d + cd p && $(SETUP) $(CONFIGURE) --ipid=p-0.1.0.0 cd p && $(SETUP) build cd p && $(SETUP) register --inplace - cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --ipid=q-0.1.0.0 --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d + cd q && $(SETUP) $(CONFIGURE) --ipid=q-0.1.0.0 cd q && $(SETUP) build cd q && $(SETUP) register --inplace - cd r && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --ipid=r-0.1.0.0 --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d + cd r && $(SETUP) $(CONFIGURE) --ipid=r-0.1.0.0 cd r && $(SETUP) build cd r && $(SETUP) register --inplace - # This should work - '$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -fforce-recomp -unit @unitP - # So should this - '$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -fforce-recomp -unit @unitP -unit @unitQ - # So should this - '$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -fforce-recomp -unit @unitP -unit @unitQ -unit @unitR - # This should error with a closure message - ! '$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -fforce-recomp -unit @unitP -unit @unitR - # This should work, even though r1 is not in the package db - '$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -fforce-recomp -unit @unitP -unit @unitQ -unit @unitR1 - # This should fail, even though r1 is not in the package db - ! '$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -fforce-recomp -unit @unitP -unit @unitR1 +.PHONY: clean +clean: + $(RM) -r tmp.d Setup$(exeext) */dist* *.hi *.o */*.hi */*.o ifeq "$(CLEANUP)" "1" $(MAKE) -s --no-print-directory clean endif - -clean : - $(RM) -r tmp*.d inst-* *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext) - ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stderr ===================================== @@ -1,10 +1,28 @@ -<command line>: error: [GHC-03271] - Home units are not closed. - It is necessary to also load the following units: - - q-0.1.0.0 - -<command line>: error: [GHC-03271] - Home units are not closed. - It is necessary to also load the following units: - - q-0.1.0.0 +<no location info>: error: [GHC-03271] + Some units are not loaded but depend on loaded units. + q-0.1.0.0 -> p-0.1.0.0 + +<no location info>: error: [GHC-03271] + Some units are not loaded but depend on loaded units. + r-0.1.0.0 -> q-0.1.0.0 + +<no location info>: error: [GHC-03271] + Some units are not loaded but depend on loaded units. + q-0.1.0.0 -> p-0.1.0.0 + +<no location info>: error: [GHC-03271] + Some units are not loaded but depend on loaded units. + q-0.1.0.0 -> p-0.1.0.0 + +<no location info>: error: [GHC-03271] + Some units are not loaded but depend on loaded units. + r-0.1.0.0 -> q-0.1.0.0 + +<no location info>: error: [GHC-03271] + Some units are not loaded but depend on loaded units. + q-0.1.0.0 -> p-0.1.0.0 + +<no location info>: error: [GHC-03271] + Some units are not loaded but depend on loaded units. + q-0.1.0.0 -> p-0.1.0.0 ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stdout ===================================== @@ -1,3 +1,6 @@ +[1 of 3] Compiling P[p-0.1.0.0] +[2 of 3] Compiling Q[q-0.1.0.0] +[3 of 3] Compiling R[r-0.1.0.0] [1 of 1] Compiling P [1 of 2] Compiling P[p-0.1.0.0] [2 of 2] Compiling Q[q-0.1.0.0] ===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -70,7 +70,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -82,7 +82,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -97,7 +97,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -2223,7 +2223,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -90,7 +90,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -213,7 +213,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -291,7 +291,7 @@ ((,) (Right (AnnList - (Just + (AnnListLayout (EpaSpan { DumpParsedAstComments.hs:16:3 })) (ListNone) [])) @@ -361,7 +361,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -30,7 +30,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -261,7 +261,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -333,7 +333,7 @@ ((,) (Right (AnnList - (Just + (AnnListLayout (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) (ListNone) [])) @@ -364,7 +364,7 @@ ((,) (Right (AnnList - (Just + (AnnListLayout (EpaSpan { DumpSemis.hs:11:8-13 })) (ListBraces (EpTok (EpaSpan { DumpSemis.hs:11:6 })) @@ -555,7 +555,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -627,7 +627,7 @@ ((,) (Right (AnnList - (Just + (AnnListLayout (EpaSpan { DumpSemis.hs:(16,5)-(18,5) })) (ListBraces (EpTok (EpaSpan { DumpSemis.hs:16:3 })) @@ -808,7 +808,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -880,7 +880,7 @@ ((,) (Right (AnnList - (Just + (AnnListLayout (EpaSpan { DumpSemis.hs:22:12-28 })) (ListBraces (EpTok (EpaSpan { DumpSemis.hs:22:10 })) @@ -1017,7 +1017,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -1122,7 +1122,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -1229,7 +1229,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -1731,7 +1731,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -1857,7 +1857,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -1936,7 +1936,7 @@ (EpAnn (EpaSpan { DumpSemis.hs:34:13-31 }) (AnnList - (Just + (AnnListLayout (EpaSpan { DumpSemis.hs:34:18-30 })) (ListBraces (EpTok (EpaSpan { DumpSemis.hs:34:13 })) @@ -1984,7 +1984,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -2097,7 +2097,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -2222,7 +2222,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -2333,7 +2333,7 @@ ((,) (FromSource) (AnnList - (Just + (AnnListLayout (EpaSpan { DumpSemis.hs:(38,6)-(43,13) })) (ListBraces (EpTok (EpaSpan { DumpSemis.hs:38:4 })) ===================================== testsuite/tests/parser/should_compile/KindSigs.stderr ===================================== @@ -1000,7 +1000,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -1719,7 +1719,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/parser/should_compile/T15279.stderr ===================================== @@ -8,14 +8,15 @@ (EpAnn (EpaSpan { T15279.hs:1:1 }) (AnnsModule - (NoEpTok) + (EpTok + (EpaSpan { <no location info> })) (EpTok (EpaSpan { T15279.hs:3:1-6 })) (EpTok (EpaSpan { T15279.hs:3:15-19 })) ((,,) - (NoEpTok) - (NoEpTok) + (EpTok (EpaSpan { <no location info> })) + (EpTok (EpaSpan { <no location info> })) []) [] [] @@ -100,7 +101,8 @@ (EpaComments [])) (HsTyVar - (NoEpTok) + (EpTok + (EpaSpan { <no location info> })) (NotPromoted) (L (EpAnn @@ -118,7 +120,8 @@ (EpaComments [])) (HsTyVar - (NoEpTok) + (EpTok + (EpaSpan { <no location info> })) (NotPromoted) (L (EpAnn @@ -152,7 +155,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -182,7 +185,8 @@ (Prefix) (NoSrcStrict) (AnnFunRhs - (NoEpTok) + (EpTok + (EpaSpan { <no location info> })) [] [])) (L @@ -258,7 +262,8 @@ (Prefix) (NoSrcStrict) (AnnFunRhs - (NoEpTok) + (EpTok + (EpaSpan { <no location info> })) [] [])) (L @@ -334,7 +339,8 @@ (Prefix) (NoSrcStrict) (AnnFunRhs - (NoEpTok) + (EpTok + (EpaSpan { <no location info> })) [] [])) (L ===================================== testsuite/tests/parser/should_compile/T20718.stderr ===================================== @@ -104,7 +104,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/parser/should_compile/T20846.stderr ===================================== @@ -94,7 +94,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== testsuite/tests/printer/Test20297.stdout ===================================== @@ -70,7 +70,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -161,8 +161,7 @@ (EpAnn (EpaSpan { <no location info> }) (AnnList - (Just - (EpaSpan { Test20297.hs:7:3-7 })) + (AnnListNoLayout) (ListNone) []) (EpaComments @@ -201,7 +200,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -286,7 +285,7 @@ (EpAnn (EpaSpan { Test20297.hs:(10,3)-(11,26) }) (AnnList - (Just + (AnnListLayout (EpaSpan { Test20297.hs:11:9-26 })) (ListNone) []) @@ -324,7 +323,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -396,7 +395,7 @@ ((,) (Right (AnnList - (Just + (AnnListLayout (EpaSpan { Test20297.hs:11:22-26 })) (ListNone) [])) @@ -513,7 +512,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -598,8 +597,7 @@ (EpAnn (EpaSpan { <no location info> }) (AnnList - (Just - (EpaSpan { Test20297.ppr.hs:5:3-7 })) + (AnnListNoLayout) (ListNone) []) (EpaComments @@ -632,7 +630,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -717,7 +715,7 @@ (EpAnn (EpaSpan { Test20297.ppr.hs:(8,3)-(9,24) }) (AnnList - (Just + (AnnListLayout (EpaSpan { Test20297.ppr.hs:9:7-24 })) (ListNone) []) @@ -749,7 +747,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -821,7 +819,7 @@ ((,) (Right (AnnList - (Just + (AnnListLayout (EpaSpan { Test20297.ppr.hs:9:20-24 })) (ListNone) [])) ===================================== testsuite/tests/printer/Test24533.stdout ===================================== @@ -534,7 +534,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L @@ -1121,7 +1121,7 @@ ((,) (FromSource) (AnnList - (Nothing) + (AnnListNoLayout) (ListNone) [])) (L ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -231,7 +231,7 @@ setAnchorAn (L (EpAnn _ an _) a) anc ts cs = (L (EpAnn anc (setTrailing an ts) c -- `debug` ("setAnchorAn: anc=" ++ showAst anc) setAnchorEpaL :: EpAnn AnnList -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList -setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = Nothing}) ts) cs +setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_layout = AnnListNoLayout}) ts) cs -- --------------------------------------------------------------------- @@ -2672,8 +2672,8 @@ instance ExactPrint (HsLocalBinds GhcPs) where exact (HsValBinds (an0, w) valbinds) = do w' <- markEpToken w -- 'where' - case al_anchor $ anns an0 of - Just anc -> do + case al_layout $ anns an0 of + AnnListLayout anc -> do when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc) _ -> return () @@ -2684,7 +2684,7 @@ instance ExactPrint (HsLocalBinds GhcPs) where Nothing -> return an1 Just (ss,dp) -> do setExtraDPReturn Nothing - return $ an1 { anns = (anns an1) { al_anchor = Just (EpaDelta ss dp []) }} + return $ an1 { anns = (anns an1) { al_layout = AnnListLayout (EpaDelta ss dp []) }} return (HsValBinds (an2, w') valbinds') exact (HsIPBinds (an,w) bs) = do ===================================== utils/check-exact/Main.hs ===================================== @@ -521,8 +521,8 @@ changeLocalDecls libdir (L l p) = do let oldDecls' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) - let (EpAnn anc (AnnList (Just _) a b) cs) = van - let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b) cs) + let (EpAnn anc (AnnList (AnnListLayout _) a b) cs) = van + let van' = (EpAnn anc (AnnList (AnnListLayout (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b) cs) let binds' = (HsValBinds (van',w) (ValBinds noExtField (VbSig sig':VbBind decl':VbSig o':oldBinds))) return (L lm (Match an mln pats (GRHSs emptyComments rhs binds'))) @@ -548,7 +548,7 @@ changeLocalDecls2 libdir (L l p) = do let anc = (EpaDelta noSrcSpan (DifferentLine 1 2) []) let anc2 = (EpaDelta noSrcSpan (DifferentLine 1 4) []) let an = (EpAnn anc - (AnnList (Just anc2) ListNone + (AnnList (AnnListLayout anc2) ListNone []) emptyComments, EpTok (EpaDelta noSrcSpan (SameLine 0) [])) let decls = [VbSig sig', VbBind decl'] ===================================== utils/check-exact/Transform.hs ===================================== @@ -1046,7 +1046,7 @@ newWhereAnnotation ww = (an, w) WithWhere -> EpTok (EpaDelta noSrcSpan (SameLine 0) []) WithoutWhere -> noEpTok an = EpAnn anc - (AnnList (Just anc2) ListNone []) + (AnnList (AnnListLayout anc2) ListNone []) emptyComments -- --------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6b642b69933d2f038764114a9021fb... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6b642b69933d2f038764114a9021fb... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help