Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 14 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/TyCl/Class.hs - compiler/Language/Haskell/Syntax/BooleanFormula.hs - compiler/Language/Haskell/Syntax/Extension.hs - 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: ===================================== 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/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/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/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/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 ===================================== 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/-/commit/d8f1a2a3a6507d9b8a8e556e6afdeec2... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8f1a2a3a6507d9b8a8e556e6afdeec2... 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