[Git][ghc/ghc][wip/ttg-booleanformula] Refactored BooleanFormula to be in line with TTG (#21592)
Hassan Al-Awwadi (@hassan.awwadi)
gitlab at gitlab.haskell.org
Sun Oct 27 14:12:57 UTC 2024
Hassan Al-Awwadi pushed to branch wip/ttg-booleanformula at Glasgow Haskell Compiler / GHC
Commits:
3a1114d9 by Hassan Al-Awwadi at 2024-10-27T15:10:02+01:00
Refactored BooleanFormula to be in line with TTG (#21592)
There are two parts to this commit.
- We moved the definition of BooleanFormula over to L.H.S.BooleanFormula
- We parameterized the BooleanFormula over the pass
The GHC specific details of BooleanFormula remain in Ghc.Data.BooleanFormula.
Because its parameterized over the pass its no longer a functor or
traversable, but we defined bfMap and bfTraverse for the cases where we
needed fmap and traverse originally. Most other changes are just churn.
There is one slightly harder change which is for IFaceBooleanFormula,
it used to be the case that we went back and forth between IFaceBooleanFormula
and regular BooleanFormula without any worry, since BooleanFormula could
contain an IfLclName without any issue. Since this is no longer the case,
we also need to go back and forth between Name and IfLclName when we do
toIfaceBooleanFormula/fromIfaceBooleanFormula. Not that big of a deal, though.
- - - - -
23 changed files:
- compiler/GHC/Core/Class.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Data/BooleanFormula.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/Language/Haskell/Syntax/Binds.hs
- + compiler/Language/Haskell/Syntax/BooleanFormula.hs
- compiler/ghc.cabal.in
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
Changes:
=====================================
compiler/GHC/Core/Class.hs
=====================================
@@ -26,6 +26,7 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Core.TyCon ( TyCon )
import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, PredType )
import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType )
+import GHC.Hs.Extension (GhcRn)
import GHC.Types.Var
import GHC.Types.Name
import GHC.Types.Basic
@@ -35,7 +36,7 @@ import GHC.Utils.Panic
import GHC.Types.SrcLoc
import GHC.Types.Var.Set
import GHC.Utils.Outputable
-import GHC.Data.BooleanFormula (BooleanFormula, mkTrue)
+import Language.Haskell.Syntax.BooleanFormula ( BooleanFormula, mkTrue )
import qualified Data.Data as Data
@@ -135,7 +136,7 @@ data TyFamEqnValidityInfo
-- Note [Type-checking default assoc decls] in GHC.Tc.TyCl.
}
-type ClassMinimalDef = BooleanFormula Name -- Required methods
+type ClassMinimalDef = BooleanFormula GhcRn -- Required methods
data ClassBody
= AbstractClass
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -43,6 +43,7 @@ module GHC.CoreToIface
, toIfaceVar
-- * Other stuff
, toIfaceLFInfo
+ , toIfaceBooleanFormula
-- * CgBreakInfo
, dehydrateCgBreakInfo
) where
@@ -69,6 +70,7 @@ import GHC.Builtin.Types ( heqTyCon )
import GHC.Iface.Syntax
import GHC.Data.FastString
+import GHC.Data.BooleanFormula qualified as BF(BooleanFormula(..))
import GHC.Types.Id
import GHC.Types.Id.Info
@@ -82,11 +84,14 @@ import GHC.Types.Var.Set
import GHC.Types.Tickish
import GHC.Types.Demand ( isNopSig )
import GHC.Types.Cpr ( topCprSig )
+import GHC.Types.SrcLoc (unLoc)
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
+import GHC.Hs.Extension (GhcRn)
+
import Data.Maybe ( isNothing, catMaybes )
{- Note [Avoiding space leaks in toIface*]
@@ -537,6 +542,14 @@ toIfGuidance src guidance
, isStableSource src = IfWhen arity unsat_ok boring_ok
| otherwise = IfNoGuidance
+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
+
{-
************************************************************************
* *
=====================================
compiler/GHC/Data/BooleanFormula.hs
=====================================
@@ -1,5 +1,6 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveTraversable #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies #-}
--------------------------------------------------------------------------------
-- | Boolean formulas without quantifiers and without negation.
@@ -8,73 +9,62 @@
-- This module is used to represent minimal complete definitions for classes.
--
module GHC.Data.BooleanFormula (
- BooleanFormula(..), LBooleanFormula,
- mkFalse, mkTrue, mkAnd, mkOr, mkVar,
+ module Language.Haskell.Syntax.BooleanFormula,
isFalse, isTrue,
+ bfMap, bfTraverse,
eval, simplify, isUnsatisfied,
implies, impliesAtom,
- pprBooleanFormula, pprBooleanFormulaNice
+ pprBooleanFormula, pprBooleanFormulaNice, pprBooleanFormulaNormal
) where
-import GHC.Prelude hiding ( init, last )
-
-import Data.List ( nub, intersperse )
+import Data.List ( intersperse )
import Data.List.NonEmpty ( NonEmpty (..), init, last )
-import Data.Data
-import GHC.Utils.Monad
-import GHC.Utils.Outputable
-import GHC.Parser.Annotation ( LocatedL )
-import GHC.Types.SrcLoc
+import GHC.Prelude hiding ( init, last )
import GHC.Types.Unique
import GHC.Types.Unique.Set
+import GHC.Types.SrcLoc (unLoc)
+import GHC.Utils.Outputable
+import GHC.Parser.Annotation ( SrcSpanAnnL )
+import GHC.Hs.Extension (GhcPass (..), OutputableBndrId)
+import Language.Haskell.Syntax.Extension (Anno, LIdP, IdP)
+import Language.Haskell.Syntax.BooleanFormula
+
----------------------------------------------------------------------
-- Boolean formula type and smart constructors
----------------------------------------------------------------------
-type LBooleanFormula a = LocatedL (BooleanFormula a)
-
-data BooleanFormula a = Var a | And [LBooleanFormula a] | Or [LBooleanFormula a]
- | Parens (LBooleanFormula a)
- deriving (Eq, Data, Functor, Foldable, Traversable)
-
-mkVar :: a -> BooleanFormula a
-mkVar = Var
+type instance Anno (BooleanFormula (GhcPass p)) = SrcSpanAnnL
-mkFalse, mkTrue :: BooleanFormula a
-mkFalse = Or []
-mkTrue = And []
+-- 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
+-- impossible.
--- Convert a Bool to a BooleanFormula
-mkBool :: Bool -> BooleanFormula a
-mkBool False = mkFalse
-mkBool True = mkTrue
-
--- Make a conjunction, and try to simplify
-mkAnd :: Eq a => [LBooleanFormula a] -> BooleanFormula a
-mkAnd = maybe mkFalse (mkAnd' . nub) . concatMapM fromAnd
+-- BooleanFormula can't be an instance of functor because it can't lift
+-- arbitrary functions `a -> b`, only functions of type `LIdP a -> LIdP b`
+-- ditto for Traversable.
+bfMap :: (LIdP (GhcPass p) -> LIdP (GhcPass p'))
+ -> BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p')
+bfMap f = go
where
- -- See Note [Simplification of BooleanFormulas]
- fromAnd :: LBooleanFormula a -> Maybe [LBooleanFormula a]
- fromAnd (L _ (And xs)) = Just xs
- -- assume that xs are already simplified
- -- otherwise we would need: fromAnd (And xs) = concat <$> traverse fromAnd xs
- fromAnd (L _ (Or [])) = Nothing
- -- in case of False we bail out, And [..,mkFalse,..] == mkFalse
- fromAnd x = Just [x]
- mkAnd' [x] = unLoc x
- mkAnd' xs = And xs
-
-mkOr :: Eq a => [LBooleanFormula a] -> BooleanFormula a
-mkOr = maybe mkTrue (mkOr' . nub) . concatMapM fromOr
+ 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
+
+bfTraverse :: Applicative f
+ => (LIdP (GhcPass p) -> f (LIdP (GhcPass p')))
+ -> BooleanFormula (GhcPass p)
+ -> f (BooleanFormula (GhcPass p'))
+bfTraverse f = go
where
- -- See Note [Simplification of BooleanFormulas]
- fromOr (L _ (Or xs)) = Just xs
- fromOr (L _ (And [])) = Nothing
- fromOr x = Just [x]
- mkOr' [x] = unLoc x
- mkOr' xs = Or xs
+ 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
+
{-
@@ -115,15 +105,15 @@ We don't show a ridiculous error message like
-- Evaluation and simplification
----------------------------------------------------------------------
-isFalse :: BooleanFormula a -> Bool
+isFalse :: BooleanFormula (GhcPass p) -> Bool
isFalse (Or []) = True
isFalse _ = False
-isTrue :: BooleanFormula a -> Bool
+isTrue :: BooleanFormula (GhcPass p) -> Bool
isTrue (And []) = True
isTrue _ = False
-eval :: (a -> Bool) -> BooleanFormula a -> Bool
+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
@@ -131,18 +121,24 @@ 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.
-simplify :: Eq a => (a -> Maybe Bool) -> BooleanFormula a -> BooleanFormula a
+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
Just b -> mkBool b
-simplify f (And xs) = mkAnd (map (\(L l x) -> L l (simplify f x)) xs)
-simplify f (Or xs) = mkOr (map (\(L l x) -> L l (simplify f x)) xs)
+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
-- if it is not, return (Just remainder)
-isUnsatisfied :: Eq a => (a -> Bool) -> BooleanFormula a -> Maybe (BooleanFormula a)
+isUnsatisfied :: Eq (LIdP (GhcPass p))
+ => (LIdP (GhcPass p) -> Bool)
+ -> BooleanFormula (GhcPass p)
+ -> Maybe (BooleanFormula (GhcPass p))
isUnsatisfied f bf
| isTrue bf' = Nothing
| otherwise = Just bf'
@@ -155,42 +151,42 @@ isUnsatisfied f bf
-- eval f x == False <==> isFalse (simplify (Just . f) x)
-- If the boolean formula holds, does that mean that the given atom is always true?
-impliesAtom :: Eq a => BooleanFormula a -> a -> Bool
-Var x `impliesAtom` y = x == y
-And xs `impliesAtom` y = any (\x -> (unLoc x) `impliesAtom` y) xs
+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
+Or xs `impliesAtom` y = all (\x -> unLoc x `impliesAtom` y) xs
+Parens x `impliesAtom` y = unLoc x `impliesAtom` y
-implies :: Uniquable a => BooleanFormula a -> BooleanFormula a -> Bool
+implies :: (Uniquable (IdP (GhcPass p))) => BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p) -> Bool
implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2])
where
- go :: Uniquable a => Clause a -> Clause a -> Bool
+ go :: Uniquable (IdP (GhcPass p)) => Clause (GhcPass p) -> Clause (GhcPass p) -> Bool
go l at Clause{ clauseExprs = hyp:hyps } r =
case hyp of
- Var x | memberClauseAtoms x r -> True
- | otherwise -> go (extendClauseAtoms l x) { clauseExprs = hyps } r
+ 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 at Clause{ clauseExprs = con:cons } =
case con of
- Var x | memberClauseAtoms x l -> True
- | otherwise -> go l (extendClauseAtoms r x) { clauseExprs = 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.
-data Clause a = Clause {
- clauseAtoms :: UniqSet a,
- clauseExprs :: [BooleanFormula a]
+data Clause p = Clause {
+ clauseAtoms :: UniqSet (IdP p),
+ clauseExprs :: [BooleanFormula p]
}
-extendClauseAtoms :: Uniquable a => Clause a -> a -> Clause a
+extendClauseAtoms :: Uniquable (IdP p) => Clause p -> IdP p -> Clause p
extendClauseAtoms c x = c { clauseAtoms = addOneToUniqSet (clauseAtoms c) x }
-memberClauseAtoms :: Uniquable a => a -> Clause a -> Bool
+memberClauseAtoms :: Uniquable (IdP p) => IdP p -> Clause p -> Bool
memberClauseAtoms x c = x `elementOfUniqSet` clauseAtoms c
----------------------------------------------------------------------
@@ -199,28 +195,29 @@ memberClauseAtoms x c = x `elementOfUniqSet` clauseAtoms c
-- Pretty print a BooleanFormula,
-- using the arguments as pretty printers for Var, And and Or respectively
-pprBooleanFormula' :: (Rational -> a -> SDoc)
- -> (Rational -> [SDoc] -> SDoc)
- -> (Rational -> [SDoc] -> SDoc)
- -> Rational -> BooleanFormula a -> SDoc
+pprBooleanFormula' :: (Rational -> LIdP (GhcPass p) -> SDoc)
+ -> (Rational -> [SDoc] -> SDoc)
+ -> (Rational -> [SDoc] -> 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 []) = 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 -> a -> SDoc) -> Rational -> BooleanFormula a -> SDoc
+pprBooleanFormula :: (Rational -> LIdP (GhcPass p) -> SDoc)
+ -> Rational -> BooleanFormula (GhcPass p) -> SDoc
pprBooleanFormula pprVar = pprBooleanFormula' pprVar pprAnd pprOr
where
pprAnd p = cparen (p > 3) . fsep . punctuate comma
pprOr p = cparen (p > 2) . fsep . intersperse vbar
-- Pretty print human in readable format, "either `a' or `b' or (`c', `d' and `e')"?
-pprBooleanFormulaNice :: Outputable a => BooleanFormula a -> SDoc
+pprBooleanFormulaNice :: Outputable (LIdP (GhcPass p)) => BooleanFormula (GhcPass p) -> SDoc
pprBooleanFormulaNice = pprBooleanFormula' pprVar pprAnd pprOr 0
where
pprVar _ = quotes . ppr
@@ -230,15 +227,14 @@ pprBooleanFormulaNice = pprBooleanFormula' pprVar pprAnd pprOr 0
pprAnd' (x:xs) = fsep (punctuate comma (init (x:|xs))) <> text ", and" <+> last (x:|xs)
pprOr p xs = cparen (p > 1) $ text "either" <+> sep (intersperse (text "or") xs)
-instance (OutputableBndr a) => Outputable (BooleanFormula a) where
+instance OutputableBndrId p => Outputable (BooleanFormula (GhcPass p)) where
ppr = pprBooleanFormulaNormal
-pprBooleanFormulaNormal :: (OutputableBndr a)
- => BooleanFormula a -> SDoc
+pprBooleanFormulaNormal :: OutputableBndrId p => BooleanFormula (GhcPass p) -> SDoc
pprBooleanFormulaNormal = go
where
- go (Var x) = pprPrefixOcc 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 (Parens x) = parens (go $ unLoc x)
\ No newline at end of file
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -36,6 +36,7 @@ import Language.Haskell.Syntax.Binds
import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprFunBind, pprPatBind )
import {-# SOURCE #-} GHC.Hs.Pat (pprLPat )
+import GHC.Data.BooleanFormula ( LBooleanFormula, pprBooleanFormulaNormal )
import GHC.Types.Tickish
import GHC.Hs.Extension
import GHC.Parser.Annotation
@@ -47,7 +48,6 @@ import GHC.Types.Basic
import GHC.Types.SourceText
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Var
-import GHC.Data.BooleanFormula (LBooleanFormula)
import GHC.Types.Name
import GHC.Utils.Outputable
@@ -968,9 +968,8 @@ instance Outputable TcSpecPrag where
ppr (SpecPrag var _ inl)
= text (extractSpecPragName $ inl_src inl) <+> pprSpec var (text "<type>") inl
-pprMinimalSig :: (OutputableBndr name)
- => LBooleanFormula (GenLocated l name) -> SDoc
-pprMinimalSig (L _ bf) = ppr (fmap unLoc bf)
+pprMinimalSig :: OutputableBndrId p => LBooleanFormula (GhcPass p) -> SDoc
+pprMinimalSig (L _ bf) = pprBooleanFormulaNormal bf
{-
************************************************************************
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -107,6 +107,7 @@ module GHC.Hs.Decls (
import GHC.Prelude
import Language.Haskell.Syntax.Decls
+import Language.Haskell.Syntax.Extension
import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprUntypedSplice )
-- Because Expr imports Decls via HsBracket
@@ -116,7 +117,7 @@ import GHC.Hs.Type
import GHC.Hs.Doc
import GHC.Types.Basic
import GHC.Core.Coercion
-import Language.Haskell.Syntax.Extension
+
import GHC.Hs.Extension
import GHC.Parser.Annotation
import GHC.Types.Name
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -33,6 +33,8 @@ import GHC.Hs.Type
import GHC.Hs.Pat
import GHC.Hs.ImpExp
import GHC.Parser.Annotation
+import GHC.Data.BooleanFormula (BooleanFormula(..))
+import Language.Haskell.Syntax.Extension (Anno)
-- ---------------------------------------------------------------------
-- Data derivations from GHC.Hs-----------------------------------------
@@ -590,3 +592,6 @@ deriving instance Data XXPatGhcTc
deriving instance Data XViaStrategyPs
-- ---------------------------------------------------------------------
+
+deriving instance (Typeable p, Data (Anno (IdGhcP p)), Data (IdGhcP p)) => Data (BooleanFormula (GhcPass p))
+---------------------------------------------------------------------
\ No newline at end of file
=====================================
compiler/GHC/Iface/Decl.hs
=====================================
@@ -13,7 +13,6 @@
module GHC.Iface.Decl
( coAxiomToIfaceDecl
, tyThingToIfaceDecl -- Converting things to their Iface equivalents
- , toIfaceBooleanFormula
)
where
@@ -33,21 +32,17 @@ import GHC.Core.DataCon
import GHC.Core.Type
import GHC.Core.Multiplicity
-
import GHC.Types.Id
import GHC.Types.Var.Env
import GHC.Types.Var
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Types.TyThing
-import GHC.Types.SrcLoc
import GHC.Utils.Panic.Plain
import GHC.Utils.Misc
import GHC.Data.Maybe
-import GHC.Data.BooleanFormula
-
import Data.List ( findIndex, mapAccumL )
{-
@@ -287,7 +282,7 @@ classToIfaceDecl env clas
ifClassCtxt = tidyToIfaceContext env1 sc_theta,
ifATs = map toIfaceAT clas_ats,
ifSigs = map toIfaceClassOp op_stuff,
- ifMinDef = toIfaceBooleanFormula $ fmap (mkIfLclName . getOccFS) (classMinimalDef clas)
+ ifMinDef = toIfaceBooleanFormula (classMinimalDef clas)
}
(env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
@@ -335,10 +330,3 @@ tidyTyConBinders = mapAccumL tidyTyConBinder
tidyTyVar :: TidyEnv -> TyVar -> IfLclName
tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
-
-toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula
-toIfaceBooleanFormula = \case
- Var nm -> IfVar nm
- And bfs -> IfAnd (map (toIfaceBooleanFormula . unLoc) bfs)
- Or bfs -> IfOr (map (toIfaceBooleanFormula . unLoc) bfs)
- Parens bf -> IfParens (toIfaceBooleanFormula . unLoc $ bf)
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -2041,8 +2041,9 @@ instance ToHie PendingRnSplice where
instance ToHie PendingTcSplice where
toHie (PendingTcSplice _ e) = toHie e
-instance ToHie (LBooleanFormula (LocatedN Name)) where
- toHie (L span form) = concatM $ makeNode form (locA span) : case form of
+instance (HiePass p, Data (IdGhcP p))
+ => ToHie (GenLocated SrcSpanAnnL (BooleanFormula (GhcPass p))) where
+ toHie (L span form) = concatM $ makeNode form (locA span) : case form of
Var a ->
[ toHie $ C Use a
]
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -35,10 +35,9 @@ module GHC.Iface.Syntax (
-- Misc
ifaceDeclImplicitBndrs, visibleIfConDecls,
ifaceDeclFingerprints,
- fromIfaceBooleanFormula,
fromIfaceWarnings,
fromIfaceWarningTxt,
-
+ fromIfaceBooleanFormula,
-- Free Names
freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
freeNamesIfConDecls,
@@ -51,7 +50,10 @@ module GHC.Iface.Syntax (
import GHC.Prelude
+import GHC.Builtin.Names(mkUnboundName)
import GHC.Data.FastString
+import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
+
import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,
constraintKindTyConKey )
import GHC.Types.Unique ( hasKey )
@@ -62,9 +64,9 @@ import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Core.Class
import GHC.Types.FieldLabel
-import GHC.Types.Name.Set
import GHC.Core.Coercion.Axiom ( BranchIndex )
import GHC.Types.Name
+import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.CostCentre
import GHC.Types.Literal
@@ -75,7 +77,6 @@ import GHC.Unit.Module
import GHC.Unit.Module.Warnings
import GHC.Types.SrcLoc
import GHC.Types.SourceText
-import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue )
import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike )
import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag )
import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
@@ -94,6 +95,8 @@ import GHC.Utils.Panic
import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith,
seqList, zipWithEqual )
+import Language.Haskell.Syntax.BooleanFormula(BooleanFormula(..))
+
import Control.Monad
import System.IO.Unsafe
import Control.DeepSeq
@@ -213,18 +216,22 @@ data IfaceClassBody
ifMinDef :: IfaceBooleanFormula -- Minimal complete definition
}
+-- See also 'BooleanFormula'
data IfaceBooleanFormula
= IfVar IfLclName
| IfAnd [IfaceBooleanFormula]
| IfOr [IfaceBooleanFormula]
| IfParens IfaceBooleanFormula
-fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula IfLclName
-fromIfaceBooleanFormula = \case
- IfVar nm -> Var nm
- IfAnd ibfs -> And (map (noLocA . fromIfaceBooleanFormula) ibfs)
- IfOr ibfs -> Or (map (noLocA . fromIfaceBooleanFormula) ibfs)
- IfParens ibf -> Parens (noLocA . fromIfaceBooleanFormula $ ibf)
+-- | note that this makes unbound names, so if you actually want
+-- proper Names, you'll need to properly Rename it (lookupIfaceTop).
+fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula GhcRn
+fromIfaceBooleanFormula = go
+ where
+ go (IfVar nm ) = Var $ noLocA . mkUnboundName . mkVarOccFS . ifLclNameFS $ nm
+ go (IfAnd bfs ) = And $ map (noLocA . go) bfs
+ go (IfOr bfs ) = Or $ map (noLocA . go) bfs
+ go (IfParens bf) = Parens $ (noLocA . go) bf
data IfaceTyConParent
= IfNoParent
@@ -1039,13 +1046,15 @@ pprIfaceDecl ss (IfaceClass { ifName = clas
| showSub ss sg = Just $ pprIfaceClassOp ss sg
| otherwise = Nothing
- pprMinDef :: BooleanFormula IfLclName -> SDoc
+ pprMinDef :: BooleanFormula GhcRn -> SDoc
pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
text "{-# MINIMAL" <+>
pprBooleanFormula
- (\_ def -> cparen (isLexSym def) (ppr def)) 0 (fmap ifLclNameFS minDef) <+>
+ (\_ def -> let fs = getOccFS def in cparen (isLexSym fs) (ppr fs)) 0 minDef <+>
text "#-}"
+
+
-- See Note [Suppressing binder signatures] in GHC.Iface.Type
suppress_bndr_sig = SuppressBndrSig True
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -32,6 +32,7 @@ module GHC.IfaceToCore (
hydrateCgBreakInfo
) where
+
import GHC.Prelude
import GHC.ByteCode.Types
@@ -43,7 +44,6 @@ import GHC.Driver.Config.Core.Lint ( initLintConfig )
import GHC.Builtin.Types.Literals(typeNatCoAxiomRules)
import GHC.Builtin.Types
-import GHC.Iface.Decl (toIfaceBooleanFormula)
import GHC.Iface.Syntax
import GHC.Iface.Load
import GHC.Iface.Env
@@ -123,11 +123,13 @@ import GHC.Types.Tickish
import GHC.Types.TyThing
import GHC.Types.Error
+import GHC.Parser.Annotation (noLocA)
+
+import GHC.Hs.Extension ( GhcRn )
+
import GHC.Fingerprint
-import qualified GHC.Data.BooleanFormula as BF
import Control.Monad
-import GHC.Parser.Annotation
import GHC.Driver.Env.KnotVars
import GHC.Unit.Module.WholeCoreBindings
import Data.IORef
@@ -137,6 +139,10 @@ import Data.List.NonEmpty ( NonEmpty )
import qualified Data.List.NonEmpty as NE
import GHC.Builtin.Names (ioTyConName, rOOT_MAIN)
import GHC.Iface.Errors.Types
+import GHC.CoreToIface(toIfaceBooleanFormula)
+
+import Language.Haskell.Syntax.BooleanFormula (mkOr, BooleanFormula)
+import Language.Haskell.Syntax.BooleanFormula qualified as BF(BooleanFormula(..))
import Language.Haskell.Syntax.Extension (NoExtField (NoExtField))
{-
@@ -297,9 +303,10 @@ mergeIfaceDecl d1 d2
plusNameEnv_C mergeIfaceClassOp
(mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])
(mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
+
in d1 { ifBody = (ifBody d1) {
ifSigs = ops,
- ifMinDef = toIfaceBooleanFormula . BF.mkOr . map (noLocA . fromIfaceBooleanFormula) $ [bf1, bf2]
+ ifMinDef = toIfaceBooleanFormula . mkOr . map (noLocA . fromIfaceBooleanFormula) $ [ bf1, bf2]
}
} `withRolesFrom` d2
-- It doesn't matter; we'll check for consistency later when
@@ -795,8 +802,7 @@ tc_iface_decl _parent ignore_prags
; sigs <- mapM tc_sig rdr_sigs
; fds <- mapM tc_fd rdr_fds
; traceIf (text "tc-iface-class3" <+> ppr tc_name)
- ; let mindef_occ = fromIfaceBooleanFormula if_mindef
- ; mindef <- traverse (lookupIfaceTop . mkVarOccFS . ifLclNameFS) mindef_occ
+ ; mindef <- tc_boolean_formula if_mindef
; cls <- fixM $ \ cls -> do
{ ats <- mapM (tc_at cls) rdr_ats
; traceIf (text "tc-iface-class4" <+> ppr tc_name)
@@ -845,6 +851,14 @@ tc_iface_decl _parent ignore_prags
-- e.g. type AT a; type AT b = AT [b] #8002
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 <$> tc_id nm
+ where
+ tc_id = lookupIfaceTop . mkVarOccFS . ifLclNameFS
+
mk_sc_doc pred = text "Superclass" <+> ppr pred
mk_at_doc tc = text "Associated type" <+> ppr tc
mk_op_doc op_name op_ty = text "Class op" <+> sep [ppr op_name, ppr op_ty]
=====================================
compiler/GHC/Parser.y
=====================================
@@ -39,9 +39,9 @@ module GHC.Parser
where
-- base
-import Control.Monad ( unless, liftM, when, (<=<) )
+import Control.Monad ( unless, liftM, when, (<=<) )
import GHC.Exts
-import Data.Maybe ( maybeToList )
+import Data.Maybe ( maybeToList )
import Data.List.NonEmpty ( NonEmpty(..) )
import qualified Data.List.NonEmpty as NE
import qualified Prelude -- for happy-generated code
@@ -3715,27 +3715,27 @@ overloaded_label :: { Located (SourceText, FastString) }
-----------------------------------------------------------------------------
-- Warnings and deprecations
-name_boolformula_opt :: { LBooleanFormula (LocatedN RdrName) }
+name_boolformula_opt :: { LBooleanFormula GhcPs }
: name_boolformula { $1 }
| {- empty -} { noLocA mkTrue }
-name_boolformula :: { LBooleanFormula (LocatedN RdrName) }
- : name_boolformula_and { $1 }
+name_boolformula :: { LBooleanFormula GhcPs }
+ : name_boolformula_and { $1 }
| name_boolformula_and '|' name_boolformula
{% do { h <- addTrailingVbarL $1 (gl $2)
; return (sLLa $1 $> (Or [h,$3])) } }
-name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) }
+name_boolformula_and :: { LBooleanFormula GhcPs }
: name_boolformula_and_list
{ sLLa (head $1) (last $1) (And ($1)) }
-name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] }
+name_boolformula_and_list :: { [LBooleanFormula GhcPs] }
: name_boolformula_atom { [$1] }
| name_boolformula_atom ',' name_boolformula_and_list
{% do { h <- addTrailingCommaL $1 (gl $2)
; return (h : $3) } }
-name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) }
+name_boolformula_atom :: { LBooleanFormula GhcPs }
: '(' name_boolformula ')' {% amsr (sLL $1 $> (Parens $2))
(AnnList Nothing (Just (mop $1)) (Just (mcp $3)) [] []) }
| name_var { sL1a $1 (Var $1) }
@@ -4746,4 +4746,4 @@ combineHasLocs a b = combineSrcSpans (getHasLoc a) (getHasLoc b)
fromTrailingN :: SrcSpanAnnN -> SrcSpanAnnA
fromTrailingN (EpAnn anc ann cs)
= EpAnn anc (AnnListItem (nann_trailing ann)) cs
-}
+}
\ No newline at end of file
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -80,6 +80,7 @@ import Control.Monad
import Data.List ( partition )
import Data.List.NonEmpty ( NonEmpty(..) )
import GHC.Types.Unique.DSet (mkUniqDSet)
+import GHC.Data.BooleanFormula (bfTraverse)
{-
-- ToDo: Put the annotations into the monad, so that they arrive in the proper
@@ -1137,7 +1138,7 @@ renameSig ctxt (FixSig _ fsig)
; return (FixSig noAnn new_fsig, emptyFVs) }
renameSig ctxt sig@(MinimalSig (_, s) (L l bf))
- = do new_bf <- traverse (lookupSigOccRnN ctxt sig) bf
+ = do new_bf <- bfTraverse (lookupSigOccRnN ctxt sig) bf
return (MinimalSig (noAnn, s) (L l new_bf), emptyFVs)
renameSig ctxt sig@(PatSynSig _ vs ty)
=====================================
compiler/GHC/Tc/TyCl/Class.hs
=====================================
@@ -344,7 +344,7 @@ tcClassMinimalDef _clas sigs op_info
where
-- By default require all methods without a default implementation
defMindef :: ClassMinimalDef
- defMindef = mkAnd [ noLocA (mkVar name)
+ defMindef = mkAnd [ noLocA (mkVar (noLocA name))
| (name, _, Nothing) <- op_info ]
instantiateMethod :: Class -> TcId -> [TcType] -> TcType
@@ -402,8 +402,8 @@ findMinimalDef :: [LSig GhcRn] -> Maybe ClassMinimalDef
findMinimalDef = firstJusts . map toMinimalDef
where
toMinimalDef :: LSig GhcRn -> Maybe ClassMinimalDef
- toMinimalDef (L _ (MinimalSig _ (L _ bf))) = Just (fmap unLoc bf)
- toMinimalDef _ = Nothing
+ toMinimalDef (L _ (MinimalSig _ (L _ bf))) = Just bf
+ toMinimalDef _ = Nothing
{-
Note [Polymorphic methods]
@@ -603,4 +603,4 @@ warnMissingAT name
$ InvalidAssoc $ InvalidAssocInstance
$ AssocInstanceMissing name
; diagnosticTc (warn && hsc_src == HsSrcFile) diag
- }
+ }
\ No newline at end of file
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -1889,7 +1889,7 @@ tcMethods skol_info dfun_id clas tyvars dfun_ev_vars inst_tys
--
-- See Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors,
-- point (D).
- whenIsJust (isUnsatisfied methodExists (classMinimalDef clas)) $
+ whenIsJust (isUnsatisfied (methodExists . unLoc) (classMinimalDef clas)) $
warnUnsatisfiedMinimalDefinition
methodExists meth = isJust (findMethodBind meth binds prag_fn)
=====================================
compiler/Language/Haskell/Syntax/Binds.hs
=====================================
@@ -26,15 +26,13 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
( LHsExpr
, MatchGroup
, GRHSs )
-import {-# SOURCE #-} Language.Haskell.Syntax.Pat
- ( LPat )
-
+import {-# SOURCE #-} Language.Haskell.Syntax.Pat( LPat )
+import Language.Haskell.Syntax.BooleanFormula (LBooleanFormula)
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Basic ( Fixity )
import GHC.Types.Basic (InlinePragma)
-import GHC.Data.BooleanFormula (LBooleanFormula)
import GHC.Types.SourceText (StringLiteral)
import Data.Void
@@ -464,7 +462,7 @@ data Sig pass
-- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
- | MinimalSig (XMinimalSig pass) (LBooleanFormula (LIdP pass))
+ | MinimalSig (XMinimalSig pass) (LBooleanFormula pass)
-- | A "set cost centre" pragma for declarations
--
=====================================
compiler/Language/Haskell/Syntax/BooleanFormula.hs
=====================================
@@ -0,0 +1,62 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+
+module Language.Haskell.Syntax.BooleanFormula(
+ BooleanFormula(..), LBooleanFormula,
+ mkVar, mkFalse, mkTrue, mkBool, mkAnd, mkOr
+ ) where
+
+import Prelude hiding ( init, last )
+import Data.List ( nub )
+import Language.Haskell.Syntax.Extension (XRec, UnXRec (..), LIdP)
+
+
+-- types
+type LBooleanFormula p = XRec p (BooleanFormula p)
+data BooleanFormula p = Var (LIdP p) | And [LBooleanFormula p] | Or [LBooleanFormula p]
+ | Parens (LBooleanFormula p)
+
+-- instances
+deriving instance (Eq (LIdP p), Eq (LBooleanFormula p)) => Eq (BooleanFormula p)
+
+-- smart constructors
+-- see note [Simplification of BooleanFormulas]
+mkVar :: LIdP p -> BooleanFormula p
+mkVar = Var
+
+mkFalse, mkTrue :: BooleanFormula p
+mkFalse = Or []
+mkTrue = And []
+
+-- Convert a Bool to a BooleanFormula
+mkBool :: 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 = 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
+ -- assume that xs are already simplified
+ -- otherwise we would need: fromAnd (And xs) = concat <$> traverse fromAnd xs
+ (Or []) -> Nothing
+ -- in case of False we bail out, And [..,mkFalse,..] == mkFalse
+ _ -> Just [bf]
+ mkAnd' [x] = unXRec @p x
+ mkAnd' xs = And xs
+
+mkOr :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula 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]
+ mkOr' [x] = unXRec @p x
+ mkOr' xs = Or xs
=====================================
compiler/ghc.cabal.in
=====================================
@@ -990,6 +990,7 @@ Library
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
+ Language.Haskell.Syntax.BooleanFormula
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -234,6 +234,7 @@ GHC.Utils.Word64
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
+Language.Haskell.Syntax.BooleanFormula
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -258,6 +258,7 @@ GHC.Utils.Word64
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
+Language.Haskell.Syntax.BooleanFormula
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3010,7 +3010,7 @@ instance ExactPrint (AnnDecl GhcPs) where
-- ---------------------------------------------------------------------
-instance ExactPrint (BF.BooleanFormula (LocatedN RdrName)) where
+instance ExactPrint (BF.BooleanFormula GhcPs) where
getAnnotationEntry = const NoEntryVal
setAnnotationAnchor a _ _ _ = a
@@ -4703,7 +4703,7 @@ instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where
(an', fs') <- markAnnList an (markAnnotated fs)
return (L an' fs')
-instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
+instance ExactPrint (LocatedL (BF.BooleanFormula GhcPs)) where
getAnnotationEntry = entryFromLocatedA
setAnnotationAnchor = setAnchorAn
exact (L an bf) = do
=====================================
utils/haddock/haddock-api/src/Haddock/Convert.hs
=====================================
@@ -45,6 +45,7 @@ import GHC.Builtin.Types
, promotedNilDataCon
, unitTy
)
+
import GHC.Builtin.Types.Prim (alphaTyVars)
import GHC.Core.Class
import GHC.Core.Coercion.Axiom
@@ -176,7 +177,7 @@ tyThingToLHsDecl prr t = case t of
$ snd
$ classTvsFds cl
, tcdSigs =
- noLocA (MinimalSig (noAnn, NoSourceText) . noLocA . fmap noLocA $ classMinimalDef cl)
+ noLocA (MinimalSig (noAnn, NoSourceText) . noLocA $ classMinimalDef cl)
: [ noLocA tcdSig
| clsOp <- classOpItems cl
, tcdSig <- synifyTcIdSig vs clsOp
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
=====================================
@@ -19,6 +19,8 @@
-- Portability : portable
module Haddock.Interface.Rename (renameInterface) where
+import Prelude hiding (mapM)
+
import Control.Applicative ()
import Control.DeepSeq (force)
import Control.Monad hiding (mapM)
@@ -28,12 +30,13 @@ import Data.Foldable (traverse_)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Traversable (mapM)
+
import GHC hiding (NoLink)
import GHC.Builtin.Types (eqTyCon_RDR, tupleDataConName, tupleTyConName)
import GHC.Types.Basic (Boxity (..), TopLevelFlag (..), TupleSort (..))
import GHC.Types.Name
import GHC.Types.Name.Reader (RdrName (Exact))
-import Prelude hiding (mapM)
+import Language.Haskell.Syntax.BooleanFormula(BooleanFormula(..))
import Haddock.Backends.Hoogle (ppExportD)
import Haddock.GhcUtils
@@ -770,11 +773,22 @@ renameSig sig = case sig of
lnames' <- mapM renameNameL lnames
return $ FixSig noExtField (FixitySig noExtField lnames' fixity)
MinimalSig _ (L l s) -> do
- s' <- traverse (traverse lookupRn) s
+ s' <- bfTraverse (traverse lookupRn) s
return $ MinimalSig noExtField (L l s')
-- we have filtered out all other kinds of signatures in Interface.Create
_ -> error "expected TypeSig"
+bfTraverse :: Applicative f
+ => (LIdP (GhcPass p) -> f (LIdP DocNameI))
+ -> BooleanFormula (GhcPass p)
+ -> 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
+
renameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI)
renameForD (ForeignImport _ lname ltype x) = do
lname' <- renameNameL lname
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -52,6 +52,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import GHC
import qualified GHC.Data.Strict as Strict
+import GHC.Data.BooleanFormula (BooleanFormula)
import GHC.Driver.Session (Language)
import qualified GHC.LanguageExtensions as LangExt
import GHC.Core.InstEnv (is_dfun_name)
@@ -818,6 +819,7 @@ type instance Anno (HsDecl DocNameI) = SrcSpanAnnA
type instance Anno (FamilyResultSig DocNameI) = EpAnn NoEpAnns
type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA
type instance Anno (HsSigType DocNameI) = SrcSpanAnnA
+type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnL
type XRecCond a =
( XParTy a ~ AnnParen
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a1114d9e56b3b0b6a6698381508cb3264e2f511
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a1114d9e56b3b0b6a6698381508cb3264e2f511
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241027/855f4923/attachment-0001.html>
More information about the ghc-commits
mailing list