Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fed942ac by Andreas Klebinger at 2026-08-17T12:11:57-04:00 testsuite: Use sigkill in process009. SIGHUB might have been blocked by a (grand)*parent of the test. In such cases the test would fail as the python process would simply exist gracefully instead of committing to a premature end. By using SIGKILL we can rely on the signal not being blocked, fixing #27578 in the process. - - - - - 574c875f by Andreas Klebinger at 2026-08-17T12:12:39-04:00 Simplify comparison in DFM.hs Fixes #27669 - - - - - d8f1a2a3 by Alan Zimmerman at 2026-08-17T12:13:18-04:00 TTG: Add extension points to BooleanFormula They are currently unused, but will be used for exact print annotations next, allowing us to get rid of LocatedBF / SrcSpanAnnBF - - - - - c556ed58 by Andreas Klebinger at 2026-08-17T17:50:10-04:00 Fix a number of incorrect module references: Fix module reference in Note [DataCon wrappers are conlike]. Fix module reference in Note [Detailed InertCans Invariants]. Fix module reference in Note [GHC's data format representations]. Fix module reference in Note [Grand plan for static forms]. Fix module reference in Note [How tuples work]. Fix module reference in Note [Solved dictionaries]. Fix module reference in Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]. Fix module reference in Note [The VarBndr type and its uses]. Found the incorrect references with a llm. - - - - - bb344b5f by Simon Jakobi at 2026-08-17T17:50:11-04:00 ci: Run stack-hadrian-build only in full-ci pipelines The job exists to catch changes that break hadrian/build-stack (#18726), but nothing in the pipeline depends on it, and it can only break when hadrian's dependencies change. Restricting it to full-ci (like hadrian-multi) still covers marge-bot merge batches, so such breakage cannot reach master unnoticed, while ordinary validate pipelines skip the job. Assisted-by: Claude Fable 5 - - - - - 29 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/WiredIn/Types.hs - compiler/GHC/CmmToAsm/Format.hs - compiler/GHC/Core/Class.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs - compiler/GHC/Data/Word64Map/Strict.hs - compiler/GHC/Data/Word64Map/Strict/Internal.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Var.hs - compiler/Language/Haskell/Syntax/BooleanFormula.hs - compiler/Language/Haskell/Syntax/Extension.hs - testsuite/tests/process/process009.hs - testsuite/tests/process/process009.stdout - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -552,6 +552,8 @@ stack-hadrian-build: - . .gitlab/ci.sh setup - . .gitlab/ci.sh configure - hadrian/build-stack --version + rules: + - *full-ci #################################### # Testing reinstallable ghc codepath ===================================== compiler/GHC/Builtin/WiredIn/Types.hs ===================================== @@ -783,7 +783,7 @@ typeSymbolKind = mkTyConTy typeSymbolKindCon Note [How tuples work] ~~~~~~~~~~~~~~~~~~~~~~ * There are three families of tuple TyCons and corresponding - DataCons, expressed by the type BasicTypes.TupleSort: + DataCons, expressed by the type GHC.Types.Basic.TupleSort: data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple * All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon @@ -818,7 +818,7 @@ Note [How tuples work] stores them in the context field of types like HsQualTy. * In quite a lot of places things are restricted just to - BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish + BoxedTuple/UnboxedTuple, and then we used GHC.Types.Basic.Boxity to distinguish E.g. tupleTyCon has a Boxity argument * When looking up an OccName in the original-name cache ===================================== compiler/GHC/CmmToAsm/Format.hs ===================================== @@ -52,20 +52,20 @@ import GHC.Utils.Panic GHC has severals types that represent various aspects of data format. These include: - * 'CmmType.CmmType': The data classification used throughout the C-- + * 'GHC.Cmm.Type.CmmType': The data classification used throughout the C-- pipeline. This is a pair of a CmmCat and a Width. - * 'CmmType.CmmCat': What the bits in a C-- value mean (e.g. a pointer, integer, or floating-point value) + * 'GHC.Cmm.Type.CmmCat': What the bits in a C-- value mean (e.g. a pointer, integer, or floating-point value) - * 'CmmType.Width': The width of a C-- value. + * 'GHC.Cmm.Type.Width': The width of a C-- value. - * 'CmmType.Length': The width (measured in number of scalars) of a vector value. + * 'GHC.Cmm.Type.Length': The width (measured in number of scalars) of a vector value. * 'Format.Format': The data format representation used by much of the backend. - * 'Format.ScalarFormat': The format of a 'Format.VecFormat'\'s scalar. + * 'GHC.CmmToAsm.Format.ScalarFormat': The format of a 'GHC.CmmToAsm.Format.VecFormat'\'s scalar. - * 'RegClass.RegClass': Whether a register is an integer or a floating point/vector register. + * 'GHC.Platform.Reg.Class.RegClass': Whether a register is an integer or a floating point/vector register. -} -- It looks very like the old MachRep, but it's now of purely local ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -41,6 +41,7 @@ import GHC.Utils.Panic import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Utils.Outputable +import GHC.Data.BooleanFormula () -- for BooleanFormulaDefault instance import Language.Haskell.Syntax.BooleanFormula ( BooleanFormula, mkTrue ) import qualified Data.Data as Data ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -542,10 +542,11 @@ toIfGuidance src guidance toIfaceBooleanFormula :: BF.BooleanFormula GhcRn -> IfaceBooleanFormula toIfaceBooleanFormula = go where - go (BF.Var nm ) = IfVar $ mkIfLclName . getOccFS . unLoc $ nm - go (BF.And bfs ) = IfAnd $ map (go . unLoc) bfs - go (BF.Or bfs ) = IfOr $ map (go . unLoc) bfs - go (BF.Parens bf) = IfParens $ (go . unLoc) bf + go (BF.Var _ nm ) = IfVar $ mkIfLclName . getOccFS . unLoc $ nm + go (BF.And _ bfs ) = IfAnd $ map (go . unLoc) bfs + go (BF.Or _ bfs ) = IfOr $ map (go . unLoc) bfs + go (BF.Parens _ bf) = IfParens $ (go . unLoc) bf + go (BF.XBooleanFormula _) = panic "toIfaceBooleanFormula" {- ************************************************************************ ===================================== compiler/GHC/Data/BooleanFormula.hs ===================================== @@ -27,7 +27,10 @@ import GHC.Types.SrcLoc (unLoc) import GHC.Utils.Outputable import GHC.Parser.Annotation ( SrcSpanAnnBF ) import GHC.Hs.Extension (GhcPass (..), OutputableBndrId) -import Language.Haskell.Syntax.Extension (Anno, LIdP, IdP) +import Language.Haskell.Syntax.Extension (Anno, LIdP, IdP, + noExtField, NoExtField, DataConCantHappen, + XBFVar, XBFAnd, XBFOr, XBFParens, + XXBooleanFormula) import Language.Haskell.Syntax.BooleanFormula @@ -37,6 +40,17 @@ import Language.Haskell.Syntax.BooleanFormula type instance Anno (BooleanFormula (GhcPass p)) = SrcSpanAnnBF +type instance XBFVar (GhcPass _) = NoExtField +type instance XBFAnd (GhcPass _) = NoExtField +type instance XBFOr (GhcPass _) = NoExtField +type instance XBFParens (GhcPass _) = NoExtField +type instance XXBooleanFormula (GhcPass _) = DataConCantHappen + +instance BooleanFormulaDefault (GhcPass p) where + bfAnnAnd = noExtField + bfAnnOr = noExtField + + -- if we had Functor/Traversable (LbooleanFormula p) we could use that -- as a constraint and we wouldn't need to specialize to just GhcPass p, -- but becuase LBooleanFormula is a type synonym such a constraint is @@ -49,10 +63,10 @@ bfMap :: (LIdP (GhcPass p) -> LIdP (GhcPass p')) -> BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p') bfMap f = go where - go (Var a ) = Var $ f a - go (And bfs) = And $ map (fmap go) bfs - go (Or bfs) = Or $ map (fmap go) bfs - go (Parens bf ) = Parens $ fmap go bf + go (Var x a ) = Var x $ f a + go (And x bfs) = And x $ map (fmap go) bfs + go (Or x bfs) = Or x $ map (fmap go) bfs + go (Parens x bf ) = Parens x $ fmap go bf bfTraverse :: Applicative f => (LIdP (GhcPass p) -> f (LIdP (GhcPass p'))) @@ -60,10 +74,10 @@ bfTraverse :: Applicative f -> f (BooleanFormula (GhcPass p')) bfTraverse f = go where - go (Var a ) = Var <$> f a - go (And bfs) = And <$> traverse @[] (traverse go) bfs - go (Or bfs) = Or <$> traverse @[] (traverse go) bfs - go (Parens bf ) = Parens <$> traverse go bf + go (Var x a ) = Var x <$> f a + go (And x bfs) = And x <$> traverse @[] (traverse go) bfs + go (Or x bfs) = Or x <$> traverse @[] (traverse go) bfs + go (Parens x bf ) = Parens x <$> traverse go bf @@ -106,18 +120,18 @@ We don't show a ridiculous error message like ---------------------------------------------------------------------- isFalse :: BooleanFormula (GhcPass p) -> Bool -isFalse (Or []) = True +isFalse (Or _ []) = True isFalse _ = False isTrue :: BooleanFormula (GhcPass p) -> Bool -isTrue (And []) = True +isTrue (And _ []) = True isTrue _ = False eval :: (LIdP (GhcPass p) -> Bool) -> BooleanFormula (GhcPass p) -> Bool -eval f (Var x) = f x -eval f (And xs) = all (eval f . unLoc) xs -eval f (Or xs) = any (eval f . unLoc) xs -eval f (Parens x) = eval f (unLoc x) +eval f (Var _ x) = f x +eval f (And _ xs) = all (eval f . unLoc) xs +eval f (Or _ xs) = any (eval f . unLoc) xs +eval f (Parens _ x) = eval f (unLoc x) -- Simplify a boolean formula. -- The argument function should give the truth of the atoms, or Nothing if undecided. @@ -125,12 +139,12 @@ simplify :: forall p. Eq (LIdP (GhcPass p)) => (LIdP (GhcPass p) -> Maybe Bool) -> BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p) -simplify f (Var a) = case f a of - Nothing -> Var a +simplify f (Var x a) = case f a of + Nothing -> Var x a Just b -> mkBool b -simplify f (And xs) = mkAnd (map (fmap (simplify f)) xs) -simplify f (Or xs) = mkOr (map (fmap (simplify f)) xs) -simplify f (Parens x) = simplify f (unLoc x) +simplify f (And _ xs) = mkAnd (map (fmap (simplify f)) xs) +simplify f (Or _ xs) = mkOr (map (fmap (simplify f)) xs) +simplify f (Parens _ x) = simplify f (unLoc x) -- Test if a boolean formula is satisfied when the given values are assigned to the atoms -- if it is, returns Nothing @@ -152,11 +166,11 @@ isUnsatisfied f bf -- If the boolean formula holds, does that mean that the given atom is always true? impliesAtom :: Eq (IdP (GhcPass p)) => BooleanFormula (GhcPass p) -> LIdP (GhcPass p) -> Bool -Var x `impliesAtom` y = (unLoc x) == (unLoc y) -And xs `impliesAtom` y = any (\x -> unLoc x `impliesAtom` y) xs - -- we have all of xs, so one of them implying y is enough -Or xs `impliesAtom` y = all (\x -> unLoc x `impliesAtom` y) xs -Parens x `impliesAtom` y = unLoc x `impliesAtom` y +Var _ x `impliesAtom` y = (unLoc x) == (unLoc y) +And _ xs `impliesAtom` y = any (\x -> unLoc x `impliesAtom` y) xs + -- we have all of xs, so one of them implying y is enough +Or _ xs `impliesAtom` y = all (\x -> unLoc x `impliesAtom` y) xs +Parens _ x `impliesAtom` y = unLoc x `impliesAtom` y implies :: (Uniquable (IdP (GhcPass p))) => BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p) -> Bool implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2]) @@ -164,18 +178,18 @@ implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2]) go :: Uniquable (IdP (GhcPass p)) => Clause (GhcPass p) -> Clause (GhcPass p) -> Bool go l@Clause{ clauseExprs = hyp:hyps } r = case hyp of - Var x | memberClauseAtoms (unLoc x) r -> True - | otherwise -> go (extendClauseAtoms l (unLoc x)) { clauseExprs = hyps } r - Parens hyp' -> go l { clauseExprs = unLoc hyp':hyps } r - And hyps' -> go l { clauseExprs = map unLoc hyps' ++ hyps } r - Or hyps' -> all (\hyp' -> go l { clauseExprs = unLoc hyp':hyps } r) hyps' + Var _ x | memberClauseAtoms (unLoc x) r -> True + | otherwise -> go (extendClauseAtoms l (unLoc x)) { clauseExprs = hyps } r + Parens _ hyp' -> go l { clauseExprs = unLoc hyp':hyps } r + And _ hyps' -> go l { clauseExprs = map unLoc hyps' ++ hyps } r + Or _ hyps' -> all (\hyp' -> go l { clauseExprs = unLoc hyp':hyps } r) hyps' go l r@Clause{ clauseExprs = con:cons } = case con of - Var x | memberClauseAtoms (unLoc x) l -> True - | otherwise -> go l (extendClauseAtoms r (unLoc x)) { clauseExprs = cons } - Parens con' -> go l r { clauseExprs = unLoc con':cons } - And cons' -> all (\con' -> go l r { clauseExprs = unLoc con':cons }) cons' - Or cons' -> go l r { clauseExprs = map unLoc cons' ++ cons } + Var _ x | memberClauseAtoms (unLoc x) l -> True + | otherwise -> go l (extendClauseAtoms r (unLoc x)) { clauseExprs = cons } + Parens _ con' -> go l r { clauseExprs = unLoc con':cons } + And _ cons' -> all (\con' -> go l r { clauseExprs = unLoc con':cons }) cons' + Or _ cons' -> go l r { clauseExprs = map unLoc cons' ++ cons } go _ _ = False -- A small sequent calculus proof engine. @@ -201,12 +215,12 @@ pprBooleanFormula' :: (Rational -> LIdP (GhcPass p) -> SDoc) -> Rational -> BooleanFormula (GhcPass p) -> SDoc pprBooleanFormula' pprVar pprAnd pprOr = go where - go p (Var x) = pprVar p x - go p (And []) = cparen (p > 0) empty - go p (And xs) = pprAnd p (map (go 3 . unLoc) xs) - go _ (Or []) = keyword $ text "FALSE" - go p (Or xs) = pprOr p (map (go 2 . unLoc) xs) - go p (Parens x) = go p (unLoc x) + go p (Var _ x) = pprVar p x + go p (And _ []) = cparen (p > 0) empty + go p (And _ xs) = pprAnd p (map (go 3 . unLoc) xs) + go _ (Or _ []) = keyword $ text "FALSE" + go p (Or _ xs) = pprOr p (map (go 2 . unLoc) xs) + go p (Parens _ x) = go p (unLoc x) -- Pretty print in source syntax, "a | b | c,d,e" pprBooleanFormula :: (Rational -> LIdP (GhcPass p) -> SDoc) @@ -233,8 +247,9 @@ instance OutputableBndrId p => Outputable (BooleanFormula (GhcPass p)) where pprBooleanFormulaNormal :: OutputableBndrId p => BooleanFormula (GhcPass p) -> SDoc pprBooleanFormulaNormal = go where - go (Var x) = pprPrefixOcc (unLoc x) - go (And xs) = fsep $ punctuate comma (map (go . unLoc) xs) - go (Or []) = keyword $ text "FALSE" - go (Or xs) = fsep $ intersperse vbar (map (go . unLoc) xs) - go (Parens x) = parens (go $ unLoc x) + go (Var _ x) = pprPrefixOcc (unLoc x) + go (And _ xs) = fsep $ punctuate comma (map (go . unLoc) xs) + go (Or _ []) = keyword $ text "FALSE" + go (Or _ xs) = fsep $ intersperse vbar (map (go . unLoc) xs) + go (Parens _ x) = parens (go $ unLoc x) + go (XBooleanFormula _) = text "XBooleanFormula" ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -72,6 +72,7 @@ module GHC.Data.Word64Map.Internal ( -- * Query , null , size + , sizeAtMost , compareSize , member , notMember @@ -533,6 +534,10 @@ size = go 0 go acc (Tip _ _) = 1 + acc go acc Nil = acc +-- | Check if the map is <= n in O(min(|map|,n)) +sizeAtMost :: Word64Map a -> Int -> Bool +sizeAtMost map n = compareSize map n /= GT + -- | \(O(\min(n,c))\). Compare the number of entries in the map to an @Int@. -- -- @compareSize m c@ returns the same result as @compare ('size' m) c@ but is ===================================== compiler/GHC/Data/Word64Map/Lazy.hs ===================================== @@ -113,6 +113,7 @@ module GHC.Data.Word64Map.Lazy ( -- ** Size , WM.null , size + , sizeAtMost , compareSize -- * Combine ===================================== compiler/GHC/Data/Word64Map/Strict.hs ===================================== @@ -130,6 +130,7 @@ module GHC.Data.Word64Map.Strict ( -- ** Size , null , size + , sizeAtMost , compareSize -- * Combine ===================================== compiler/GHC/Data/Word64Map/Strict/Internal.hs ===================================== @@ -132,6 +132,7 @@ module GHC.Data.Word64Map.Strict.Internal ( -- ** Size , null , size + , sizeAtMost , compareSize -- * Combine @@ -324,6 +325,7 @@ import GHC.Data.Word64Map.Internal , spanAntitone , restrictKeys , size + , sizeAtMost , compareSize , split , splitLookup ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -62,7 +62,7 @@ looking up source locations for stack info tables in the map generated during th The rest of this note will document exactly how the first pass generates the map from labels to estimated source positions. The algorithms are different depending on whether tables-next-to-code -is on or off. Both algorithms have in common that we are looking for a `CmmNode.CmmTick` +is on or off. Both algorithms have in common that we are looking for a `GHC.Cmm.Node.CmmTick` (containing a `SourceNote`) that is near what we estimate to be the label of a return stack frame. With tables-next-to-code @@ -112,14 +112,14 @@ open or closed on exit (one can fallthrough from them to the next node). Please refer to the paper "Hoopl: A Modular, Reusable Library for Dataflow Analysis and Transformation" for a detailed explanation. -Here we use the fact, that calls (represented by `CmmNode.CmmCall`) are always closed on exit +Here we use the fact, that calls (represented by `GHC.Cmm.Node.CmmCall`) are always closed on exit (`CmmNode O C`, `O` means open, `C` closed). In other words, they are always at the end of a block. So, given a `CmmGraph`: - - Look at the end of every block: If it is a `CmmNode.CmmCall` returning to some label, lookup - the nearest `CmmNode.CmmTick` by traversing the middle part of the block backwards (from end to + - Look at the end of every block: If it is a `GHC.Cmm.Node.CmmCall` returning to some label, lookup + the nearest `GHC.Cmm.Node.CmmTick` by traversing the middle part of the block backwards (from end to beginning). - - Take the first `CmmNode.CmmTick` that contains a `Tickish.SourceNote` and map the label we + - Take the first `GHC.Cmm.Node.CmmTick` that contains a `Tickish.SourceNote` and map the label we found to it's payload as an `IpeSourceLocation`. (There are other `Tickish` constructors like `ProfNote` or `HpcTick`, these are ignored.) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2083,16 +2083,16 @@ instance ToHie PendingRnSplice where instance (HiePass p, Data (IdGhcP p)) => ToHie (GenLocated SrcSpanAnnBF (BooleanFormula (GhcPass p))) where toHie (L span form) = concatM $ makeNode form (locA span) : case form of - Var a -> + Var _ a -> [ toHie $ C Use a ] - And forms -> + And _ forms -> [ toHie forms ] - Or forms -> + Or _ forms -> [ toHie forms ] - Parens f -> + Parens _ f -> [ toHie f ] ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -103,6 +103,7 @@ import GHC.Data.FastString import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue) import Language.Haskell.Syntax.BooleanFormula(BooleanFormula(..)) +import Language.Haskell.Syntax.Extension (noExtField) import Language.Haskell.Syntax.Text import Control.Monad @@ -1326,10 +1327,10 @@ pprIfaceDecl ss decl@(IfaceClass { ifName = clas fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula GhcRn -- `mkUnboundName` here is fine because the Name generated is only used for pretty printing and nothing else. - fromIfaceBooleanFormula (IfVar nm ) = Var $ noLocA . mkUnboundName . mkVarOccFS . ifLclNameFS $ nm - fromIfaceBooleanFormula (IfAnd bfs ) = And $ map (noLocA . fromIfaceBooleanFormula) bfs - fromIfaceBooleanFormula (IfOr bfs ) = Or $ map (noLocA . fromIfaceBooleanFormula) bfs - fromIfaceBooleanFormula (IfParens bf) = Parens $ (noLocA . fromIfaceBooleanFormula) bf + fromIfaceBooleanFormula (IfVar nm ) = Var noExtField $ noLocA . mkUnboundName . mkVarOccFS . ifLclNameFS $ nm + fromIfaceBooleanFormula (IfAnd bfs ) = And noExtField $ map (noLocA . fromIfaceBooleanFormula) bfs + fromIfaceBooleanFormula (IfOr bfs ) = Or noExtField $ map (noLocA . fromIfaceBooleanFormula) bfs + fromIfaceBooleanFormula (IfParens bf) = Parens noExtField $ (noLocA . fromIfaceBooleanFormula) bf -- See Note [Suppressing binder signatures] in GHC.Iface.Type ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -82,7 +82,7 @@ Here is a running example: (SF4) The desugarer replaces a nested expression (static e) with a top-level binding for an application of the function 'makeStatic' (defined in module - GHC.StaticPtr.Internal of base). So we get + GHC.Internal.StaticPtr.Internal of base). So we get s = /\abc. makeStatic location e f x = ...(fromStaticPtr s)... ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -883,10 +883,10 @@ tc_iface_decl _parent ignore_prags return (ATI tc mb_def) tc_boolean_formula :: IfaceBooleanFormula -> IfL (BooleanFormula GhcRn) - tc_boolean_formula (IfAnd ibfs ) = BF.And . map noLocA <$> traverse tc_boolean_formula ibfs - tc_boolean_formula (IfOr ibfs ) = BF.Or . map noLocA <$> traverse tc_boolean_formula ibfs - tc_boolean_formula (IfParens ibf) = BF.Parens . noLocA <$> tc_boolean_formula ibf - tc_boolean_formula (IfVar nm ) = BF.Var . noLocA <$> (lookupIfaceTop . mkVarOccFS . ifLclNameFS $ nm) + tc_boolean_formula (IfAnd ibfs ) = BF.And NoExtField . map noLocA <$> traverse tc_boolean_formula ibfs + tc_boolean_formula (IfOr ibfs ) = BF.Or NoExtField . map noLocA <$> traverse tc_boolean_formula ibfs + tc_boolean_formula (IfParens ibf) = BF.Parens NoExtField . noLocA <$> tc_boolean_formula ibf + tc_boolean_formula (IfVar nm ) = BF.Var NoExtField . noLocA <$> (lookupIfaceTop . mkVarOccFS . ifLclNameFS $ nm) mk_sc_doc pred = text "Superclass" <+> ppr pred mk_at_doc tc = text "Associated type" <+> ppr tc ===================================== compiler/GHC/Parser.y ===================================== @@ -3821,11 +3821,11 @@ name_boolformula :: { LBooleanFormula GhcPs } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarBF $1 (epTok $2) - ; return (sLLa $1 $> (Or [h,$3])) } } + ; return (sLLa $1 $> (Or noExtField [h,$3])) } } name_boolformula_and :: { LBooleanFormula GhcPs } : name_boolformula_and_list - { sLLa (head $1) (last $1) (And (toList $1)) } + { sLLa (head $1) (last $1) (And noExtField (toList $1)) } name_boolformula_and_list :: { NonEmpty (LBooleanFormula GhcPs) } : name_boolformula_atom { NE.singleton $1 } @@ -3834,9 +3834,9 @@ name_boolformula_and_list :: { NonEmpty (LBooleanFormula GhcPs) } ; return (h NE.<| $3) } } name_boolformula_atom :: { LBooleanFormula GhcPs } - : '(' name_boolformula ')' {% amsr (sLL $1 $> (Parens $2)) + : '(' name_boolformula ')' {% amsr (sLL $1 $> (Parens noExtField $2)) (AnnBooleanFormula (epTok $1) (epTok $3) []) } - | name_var { sL1a $1 (Var $1) } + | name_var { sL1a $1 (Var noExtField $1) } namelist :: { Located [LocatedN RdrName] } namelist : name_var { sL1 $1 [$1] } ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -460,7 +460,7 @@ In implementation terms - It is only called when applying an instance decl, in GHC.Tc.Solver.Dict.tryInstances - - ClsInst.InstanceWhat says what kind of instance was + - GHC.Tc.Instance.Class.InstanceWhat says what kind of instance was used to solve the constraint. In particular * LocalInstance identifies quantified constraints * BuiltinEqInstance identifies the strange built-in @@ -800,7 +800,7 @@ The InertCans represents a collection of constraints with the following properti eg a wanted cannot rewrite a given) * CEqCan equalities: see Note [inert_eqs: the inert equalities] - Also see documentation in Constraint.Ct for a list of invariants + Also see documentation in GHC.Tc.Types.Constraint.Ct for a list of invariants Note [inert_eqs: the inert equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -345,7 +345,7 @@ tcClassMinimalDef _clas sigs op_info where -- By default require all methods without a default implementation defMindef :: ClassMinimalDef - defMindef = mkAnd [ noLocA (mkVar (noLocA name)) + defMindef = mkAnd [ noLocA (mkVar NoExtField (noLocA name)) | (name, _, Nothing) <- op_info ] instantiateMethod :: Class -> TcId -> [TcType] -> TcType ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -987,7 +987,7 @@ until the final simplifier phase; see Note [Activation for data constructor wrappers]. For further reading, see: - * (IA1) in Note [Interesting arguments] in GHC.Core.Op.Simplify.Utils + * (IA1) in Note [Interesting arguments] in GHC.Core.Opt.Simplify.Utils * Note [Lone variables] in GHC.Core.Unfold * Note [exprIsConApp_maybe on data constructors with wrappers] in GHC.Core.SimpleOpt ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -351,8 +351,8 @@ foldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldUDFM #-} -- Specialises k and z into M.foldr on the small-map path. foldUDFM k z (UDFM m ub) - | M.compareSize m 1 /= GT = M.foldr (k . taggedFst) z m - | otherwise = fold_udfm k z m ub + | M.sizeAtMost m 1 = M.foldr (k . taggedFst) z m + | otherwise = fold_udfm k z m ub fold_udfm :: (elt -> a -> a) -> a -> M.Word64Map (TaggedVal elt) -> Int -> a {-# NOINLINE fold_udfm #-} @@ -402,8 +402,8 @@ eltsUDFM :: UniqDFM key elt -> [elt] {-# INLINE eltsUDFM #-} -- so the small case is a good producer -- This matters for T13719. eltsUDFM (UDFM m ub) - | M.compareSize m 1 /= GT = build (\c n -> M.foldr (c . taggedFst) n m) - | otherwise = elts_udfm m ub + | M.sizeAtMost m 1 = build (\c n -> M.foldr (c . taggedFst) n m) + | otherwise = elts_udfm m ub elts_udfm :: M.Word64Map (TaggedVal elt) -> Int -> [elt] {-# NOINLINE elts_udfm #-} @@ -511,7 +511,7 @@ udfmToList :: UniqDFM key elt -> [(Unique, elt)] -- traverseUSDFM in the pattern-match checker, which doesn't fuse. Inlining -- the size dispatch into it regresses T17836. udfmToList (UDFM m ub) - | M.compareSize m 1 /= GT = + | M.sizeAtMost m 1 = M.foldrWithKey (\k tv r -> (mkUniqueGrimily k, taggedFst tv) : r) [] m | usePigeonholeSort m ub = pigeonholeSort ub (\k tv -> TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv)) m ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -621,27 +621,27 @@ Note [Types for coercions, predicates, and evidence] VarBndr is polymorphic in both var and visibility fields. Currently there are nine different uses of 'VarBndr': -* Var.ForAllTyBinder = VarBndr TyCoVar ForAllTyFlag +* GHC.Types.Var.ForAllTyBinder = VarBndr TyCoVar ForAllTyFlag Binder of a forall-type; see ForAllTy in GHC.Core.TyCo.Rep -* Var.TyVarBinder = VarBndr TyVar ForAllTyFlag +* GHC.Types.Var.TyVarBinder = VarBndr TyVar ForAllTyFlag Subset of ForAllTyBinder when we are sure the binder is a TyVar -* Var.InvisTVBinder = VarBndr TyVar Specificity +* GHC.Types.Var.InvisTVBinder = VarBndr TyVar Specificity Specialised form of TyVarBinder, when ForAllTyFlag = Invisible s See GHC.Core.Type.splitForAllInvisTVBinders -* Var.ReqTVBinder = VarBndr TyVar () +* GHC.Types.Var.ReqTVBinder = VarBndr TyVar () Specialised form of TyVarBinder, when ForAllTyFlag = Required See GHC.Core.Type.splitForAllReqTVBinders This one is barely used -* TyCon.TyConBinder = VarBndr TyVar TyConBndrVis +* GHC.Core.TyCon.TyConBinder = VarBndr TyVar TyConBndrVis Binders of a TyCon; see TyCon in GHC.Core.TyCon -* IfaceType.IfaceForAllBndr = VarBndr IfaceBndr ForAllTyFlag -* IfaceType.IfaceForAllSpecBndr = VarBndr IfaceBndr Specificity -* IfaceType.IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis +* GHC.Iface.Type.IfaceForAllBndr = VarBndr IfaceBndr ForAllTyFlag +* GHC.Iface.Type.IfaceForAllSpecBndr = VarBndr IfaceBndr Specificity +* GHC.Iface.Type.IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis -} data VarBndr var argf = Bndr var argf ===================================== compiler/Language/Haskell/Syntax/BooleanFormula.hs ===================================== @@ -4,59 +4,78 @@ module Language.Haskell.Syntax.BooleanFormula( BooleanFormula(..), LBooleanFormula, - mkVar, mkFalse, mkTrue, mkBool, mkAnd, mkOr + mkVar, mkFalse, mkTrue, mkBool, mkAnd, mkOr, + BooleanFormulaDefault(..) ) where import Prelude hiding ( init, last ) import Data.List ( nub ) -import Language.Haskell.Syntax.Extension (XRec, UnXRec (..), LIdP) +import Language.Haskell.Syntax.Extension (XRec, UnXRec (..), LIdP, + XBFVar, XBFAnd, XBFOr, XBFParens, + XXBooleanFormula) -- types type LBooleanFormula p = XRec p (BooleanFormula p) -data BooleanFormula p = Var (LIdP p) | And [LBooleanFormula p] | Or [LBooleanFormula p] - | Parens (LBooleanFormula p) +data BooleanFormula p + = Var (XBFVar p) (LIdP p) + | And (XBFAnd p) [LBooleanFormula p] + | Or (XBFOr p) [LBooleanFormula p] + | Parens (XBFParens p) (LBooleanFormula p) + | XBooleanFormula !(XXBooleanFormula p) + +class BooleanFormulaDefault p where + bfAnnAnd :: XBFAnd p + bfAnnOr :: XBFOr p -- instances -deriving instance (Eq (LIdP p), Eq (LBooleanFormula p)) => Eq (BooleanFormula p) +deriving instance (Eq (LIdP p), Eq (LBooleanFormula p), + Eq (XBFVar p), + Eq (XBFAnd p), + Eq (XBFOr p), + Eq (XBFParens p), + Eq (XXBooleanFormula p) + ) => Eq (BooleanFormula p) -- smart constructors -- see note [Simplification of BooleanFormulas] -mkVar :: LIdP p -> BooleanFormula p +mkVar :: XBFVar p -> LIdP p -> BooleanFormula p mkVar = Var -mkFalse, mkTrue :: BooleanFormula p -mkFalse = Or [] -mkTrue = And [] +mkFalse, mkTrue :: forall p. BooleanFormulaDefault p => BooleanFormula p +mkFalse = Or (bfAnnOr @p) [] +mkTrue = And (bfAnnAnd @p) [] -- Convert a Bool to a BooleanFormula -mkBool :: Bool -> BooleanFormula p +mkBool :: BooleanFormulaDefault p => Bool -> BooleanFormula p mkBool False = mkFalse mkBool True = mkTrue -- Make a conjunction, and try to simplify -mkAnd :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p)) => [LBooleanFormula p] -> BooleanFormula p +mkAnd :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p), BooleanFormulaDefault p) + => [LBooleanFormula p] -> BooleanFormula p mkAnd = maybe mkFalse (mkAnd' . nub . concat) . mapM fromAnd where -- See Note [Simplification of BooleanFormulas] fromAnd :: LBooleanFormula p -> Maybe [LBooleanFormula p] fromAnd bf = case unXRec @p bf of - (And xs) -> Just xs + (And _ xs) -> Just xs -- assume that xs are already simplified -- otherwise we would need: fromAnd (And xs) = concat <$> traverse fromAnd xs - (Or []) -> Nothing + (Or _ []) -> Nothing -- in case of False we bail out, And [..,mkFalse,..] == mkFalse _ -> Just [bf] mkAnd' [x] = unXRec @p x - mkAnd' xs = And xs + mkAnd' xs = And (bfAnnAnd @p) xs -mkOr :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p)) => [LBooleanFormula p] -> BooleanFormula p +mkOr :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p), BooleanFormulaDefault p) + => [LBooleanFormula p] -> BooleanFormula p mkOr = maybe mkTrue (mkOr' . nub . concat) . mapM fromOr where -- See Note [Simplification of BooleanFormulas] fromOr bf = case unXRec @p bf of - (Or xs) -> Just xs - (And []) -> Nothing - _ -> Just [bf] + (Or _ xs) -> Just xs + (And _ []) -> Nothing + _ -> Just [bf] mkOr' [x] = unXRec @p x - mkOr' xs = Or xs + mkOr' xs = Or (bfAnnOr @p) xs ===================================== compiler/Language/Haskell/Syntax/Extension.hs ===================================== @@ -841,6 +841,14 @@ type family XXIntegralLit x type family XStringLit x type family XXStringLit x +-- ===================================================================== +-- BooleanFormula type families + +type family XBFVar p +type family XBFAnd p +type family XBFOr p +type family XBFParens p +type family XXBooleanFormula p -- ===================================================================== -- Misc ===================================== testsuite/tests/process/process009.hs ===================================== @@ -11,7 +11,7 @@ main = do let script = intercalate " " [ "exec python3 2>/dev/null" , "-c" - , "'import os; os.kill(os.getpid(), 1)'" + , "'import os; os.kill(os.getpid(), 9)'" -- SIGKILL ] (_,_,_,p) <- createProcess (shell script) waitForProcess p >>= print ===================================== testsuite/tests/process/process009.stdout ===================================== @@ -1,3 +1,3 @@ -ExitFailure (-1) -Just (ExitFailure (-1)) -Just (ExitFailure (-1)) +ExitFailure (-9) +Just (ExitFailure (-9)) +Just (ExitFailure (-9)) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2722,18 +2722,18 @@ instance ExactPrint (BF.BooleanFormula GhcPs) where getAnnotationEntry = const NoEntryVal setAnnotationAnchor a _ _ _ = a - exact (BF.Var x) = do + exact (BF.Var e x) = do x' <- markAnnotated x - return (BF.Var x') - exact (BF.Or ls) = do + return (BF.Var e x') + exact (BF.Or e ls) = do ls' <- mapM markAnnotated ls - return (BF.Or ls') - exact (BF.And ls) = do + return (BF.Or e ls') + exact (BF.And e ls) = do ls' <- mapM markAnnotated ls - return (BF.And ls') - exact (BF.Parens x) = do + return (BF.And e ls') + exact (BF.Parens e x) = do x' <- markAnnotated x - return (BF.Parens x') + return (BF.Parens e x') -- --------------------------------------------------------------------- ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs ===================================== @@ -998,26 +998,26 @@ ppClassDecl -- Minimal complete definition minimalBit = case [s | MinimalSig _ (L _ s) <- sigs] of -- Miminal complete definition = every shown method - And xs : _ - | sort [getName n | L _ (Var (L _ n)) <- xs] + And _ xs : _ + | sort [getName n | L _ (Var _ (L _ n)) <- xs] == sort [getName n | ClassOpSig _ _ ns _ <- sigs, L _ n <- ns] -> noHtml -- Minimal complete definition = the only shown method - Var (L _ n) : _ + Var _ (L _ n) : _ | [getName n] == [getName n' | ClassOpSig _ _ ns _ <- sigs, L _ n' <- ns] -> noHtml -- Minimal complete definition = nothing - And [] : _ -> subMinimal $ toHtml ("Nothing" :: LText) + And _ [] : _ -> subMinimal $ toHtml ("Nothing" :: LText) m : _ -> subMinimal $ ppMinimal False m _ -> noHtml - ppMinimal _ (Var (L _ n)) = ppDocName qual Prefix True n - ppMinimal _ (And fs) = foldr1 (\a b -> a +++ (", " :: LText) +++ b) $ map (ppMinimal True . unLoc) fs - ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a +++ (" | " :: LText) +++ b) $ map (ppMinimal False . unLoc) fs + ppMinimal _ (Var _ (L _ n)) = ppDocName qual Prefix True n + ppMinimal _ (And _ fs) = foldr1 (\a b -> a +++ (", " :: LText) +++ b) $ map (ppMinimal True . unLoc) fs + ppMinimal p (Or _ fs) = wrap $ foldr1 (\a b -> a +++ (" | " :: LText) +++ b) $ map (ppMinimal False . unLoc) fs where wrap | p = parens | otherwise = id - ppMinimal p (Parens x) = ppMinimal p (unLoc x) + ppMinimal p (Parens _ x) = ppMinimal p (unLoc x) -- Instances instancesBit = ===================================== utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs ===================================== @@ -858,10 +858,10 @@ bfTraverse :: Applicative f -> f (BooleanFormula DocNameI) bfTraverse f = go where - go (Var a ) = Var <$> f a - go (And bfs) = And <$> traverse @[] (traverse go) bfs - go (Or bfs) = Or <$> traverse @[] (traverse go) bfs - go (Parens bf ) = Parens <$> traverse go bf + go (Var x a ) = Var x <$> f a + go (And x bfs) = And x <$> traverse @[] (traverse go) bfs + go (Or x bfs) = Or x <$> traverse @[] (traverse go) bfs + go (Parens x bf ) = Parens x <$> traverse go bf renameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI) renameForD (ForeignImport _ modifiers lname ltype x) = do ===================================== utils/haddock/haddock-api/src/Haddock/Types.hs ===================================== @@ -1038,6 +1038,12 @@ type instance XCTyFamInstDecl DocNameI = NoExtField type instance XHsContext DocNameI = NoExtField type instance XXHsContextDetails DocNameI = DataConCantHappen +type instance XBFVar DocNameI = NoExtField +type instance XBFAnd DocNameI = NoExtField +type instance XBFOr DocNameI = NoExtField +type instance XBFParens DocNameI = NoExtField +type instance XXBooleanFormula DocNameI = DataConCantHappen + ----------------------------------------------------------------------------- -- * NFData instances for GHC types View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2667cef68d74b079c03cb895a25c493... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2667cef68d74b079c03cb895a25c493... 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