[Git][ghc/ghc][wip/ttg-booleanformula] booleanFormula p -> booleanFormula a
Hassan Al-Awwadi (@hassan.awwadi)
gitlab at gitlab.haskell.org
Fri Oct 11 14:25:55 UTC 2024
Hassan Al-Awwadi pushed to branch wip/ttg-booleanformula at Glasgow Haskell Compiler / GHC
Commits:
cf67d010 by Hassan Al-Awwadi at 2024-10-11T16:25:14+02:00
booleanFormula p -> booleanFormula a
its been quite the cycle, but this time its ok because we don't need to have a p to pop into XRec
- - - - -
17 changed files:
- compiler/GHC/Core/Class.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Data/BooleanFormula.hs
- compiler/GHC/Hs/Binds.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
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
Changes:
=====================================
compiler/GHC/Core/Class.hs
=====================================
@@ -26,7 +26,6 @@ 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
@@ -136,7 +135,7 @@ data TyFamEqnValidityInfo
-- Note [Type-checking default assoc decls] in GHC.Tc.TyCl.
}
-type ClassMinimalDef = BooleanFormula GhcRn -- Required methods
+type ClassMinimalDef = BooleanFormula Name -- Required methods
data ClassBody
= AbstractClass
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -43,6 +43,7 @@ module GHC.CoreToIface
, toIfaceVar
-- * Other stuff
, toIfaceLFInfo
+ , toIfaceBooleanFormula
-- * CgBreakInfo
, dehydrateCgBreakInfo
) where
@@ -88,6 +89,7 @@ import GHC.Utils.Panic
import GHC.Utils.Misc
import Data.Maybe ( isNothing, catMaybes )
+import Language.Haskell.Syntax.BooleanFormula (BooleanFormula)
{- Note [Avoiding space leaks in toIface*]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -689,6 +691,10 @@ toIfaceLFInfo nm lfi = case lfi of
LFLetNoEscape ->
panic "toIfaceLFInfo: LFLetNoEscape"
+toIfaceBooleanFormula :: NamedThing a
+ => BooleanFormula a -> IfaceBooleanFormula
+toIfaceBooleanFormula = fmap (mkIfLclName . getOccFS)
+
-- Dehydrating CgBreakInfo
dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
=====================================
compiler/GHC/Data/BooleanFormula.hs
=====================================
@@ -11,7 +11,6 @@
module GHC.Data.BooleanFormula (
module Language.Haskell.Syntax.BooleanFormula,
isFalse, isTrue,
- bfMap, bfTraverse,
eval, simplify, isUnsatisfied,
implies, impliesAtom,
pprBooleanFormula, pprBooleanFormulaNice, pprBooleanFormulaNormal
@@ -23,50 +22,10 @@ import Data.List.NonEmpty ( NonEmpty (..), init, last )
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 instance Anno (BooleanFormula (GhcPass p)) = SrcSpanAnnL
-
--- 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.
-
--- 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
- go (Var a ) = Var $ f a
- go (And bfs) = And $ map go bfs
- go (Or bfs) = Or $ map go bfs
- go (Parens bf ) = Parens $ go bf
-
-bfTraverse :: Applicative f
- => (LIdP (GhcPass p) -> f (LIdP (GhcPass p')))
- -> BooleanFormula (GhcPass p)
- -> f (BooleanFormula (GhcPass p'))
-bfTraverse f = go
- where
- go (Var a ) = Var <$> f a
- go (And bfs) = And <$> traverse @[] go bfs
- go (Or bfs) = Or <$> traverse @[] go bfs
- go (Parens bf ) = Parens <$> go bf
-
-
-
{-
Note [Simplification of BooleanFormulas]
~~~~~~~~~~~~~~~~~~~~~~
@@ -105,15 +64,15 @@ We don't show a ridiculous error message like
-- Evaluation and simplification
----------------------------------------------------------------------
-isFalse :: BooleanFormula (GhcPass p) -> Bool
+isFalse :: BooleanFormula a -> Bool
isFalse (Or []) = True
isFalse _ = False
-isTrue :: BooleanFormula (GhcPass p) -> Bool
+isTrue :: BooleanFormula a -> Bool
isTrue (And []) = True
isTrue _ = False
-eval :: (LIdP (GhcPass p) -> Bool) -> BooleanFormula (GhcPass p) -> Bool
+eval :: (a -> Bool) -> BooleanFormula a -> Bool
eval f (Var x) = f x
eval f (And xs) = all (eval f) xs
eval f (Or xs) = any (eval f) xs
@@ -121,10 +80,10 @@ eval f (Parens x) = eval f x
-- Simplify a boolean formula.
-- The argument function should give the truth of the atoms, or Nothing if undecided.
-simplify :: forall p. Eq (LIdP (GhcPass p))
- => (LIdP (GhcPass p) -> Maybe Bool)
- -> BooleanFormula (GhcPass p)
- -> BooleanFormula (GhcPass p)
+simplify :: Eq a
+ => (a -> Maybe Bool)
+ -> BooleanFormula a
+ -> BooleanFormula a
simplify f (Var a) = case f a of
Nothing -> Var a
Just b -> mkBool b
@@ -135,10 +94,10 @@ simplify f (Parens x) = simplify f 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 (LIdP (GhcPass p))
- => (LIdP (GhcPass p) -> Bool)
- -> BooleanFormula (GhcPass p)
- -> Maybe (BooleanFormula (GhcPass p))
+isUnsatisfied :: Eq a
+ => (a -> Bool)
+ -> BooleanFormula a
+ -> Maybe (BooleanFormula a)
isUnsatisfied f bf
| isTrue bf' = Nothing
| otherwise = Just bf'
@@ -151,42 +110,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 (IdP (GhcPass p)) => BooleanFormula (GhcPass p) -> LIdP (GhcPass p) -> Bool
-Var x `impliesAtom` y = unLoc x == unLoc y
+impliesAtom :: Eq a => BooleanFormula a -> a-> Bool
+Var x `impliesAtom` y = x == y
And xs `impliesAtom` y = any (`impliesAtom` y) xs
-- we have all of xs, so one of them implying y is enough
Or xs `impliesAtom` y = all (`impliesAtom` y) xs
Parens x `impliesAtom` y = x `impliesAtom` y
-implies :: (Uniquable (IdP (GhcPass p))) => BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p) -> Bool
+implies :: Uniquable a => BooleanFormula a -> BooleanFormula a -> Bool
implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2])
where
- go :: Uniquable (IdP (GhcPass p)) => Clause (GhcPass p) -> Clause (GhcPass p) -> Bool
+ go :: Uniquable a => Clause a -> Clause a -> Bool
go l at Clause{ clauseExprs = hyp:hyps } r =
case hyp of
- Var x | memberClauseAtoms (unLoc x) r -> True
- | otherwise -> go (extendClauseAtoms l (unLoc x)) { clauseExprs = hyps } r
+ Var x | memberClauseAtoms x r -> True
+ | otherwise -> go (extendClauseAtoms l x) { clauseExprs = hyps } r
Parens hyp' -> go l { clauseExprs = hyp':hyps } r
And hyps' -> go l { clauseExprs = hyps' ++ hyps } r
Or hyps' -> all (\hyp' -> go l { clauseExprs = hyp':hyps } r) hyps'
go l r at Clause{ clauseExprs = con:cons } =
case con of
- Var x | memberClauseAtoms (unLoc x) l -> True
- | otherwise -> go l (extendClauseAtoms r (unLoc x)) { clauseExprs = cons }
+ Var x | memberClauseAtoms x l -> True
+ | otherwise -> go l (extendClauseAtoms r x) { clauseExprs = cons }
Parens con' -> go l r { clauseExprs = con':cons }
And cons' -> all (\con' -> go l r { clauseExprs = con':cons }) cons'
Or cons' -> go l r { clauseExprs = cons' ++ cons }
go _ _ = False
-- A small sequent calculus proof engine.
-data Clause p = Clause {
- clauseAtoms :: UniqSet (IdP p),
- clauseExprs :: [BooleanFormula p]
+data Clause a = Clause {
+ clauseAtoms :: UniqSet a,
+ clauseExprs :: [BooleanFormula a]
}
-extendClauseAtoms :: Uniquable (IdP p) => Clause p -> IdP p -> Clause p
+extendClauseAtoms :: Uniquable a => Clause a -> a -> Clause a
extendClauseAtoms c x = c { clauseAtoms = addOneToUniqSet (clauseAtoms c) x }
-memberClauseAtoms :: Uniquable (IdP p) => IdP p -> Clause p -> Bool
+memberClauseAtoms :: Uniquable a => a -> Clause a -> Bool
memberClauseAtoms x c = x `elementOfUniqSet` clauseAtoms c
----------------------------------------------------------------------
@@ -195,10 +154,10 @@ 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 -> LIdP (GhcPass p) -> SDoc)
+pprBooleanFormula' :: (Rational -> a -> SDoc)
-> (Rational -> [SDoc] -> SDoc)
-> (Rational -> [SDoc] -> SDoc)
- -> Rational -> BooleanFormula (GhcPass p) -> SDoc
+ -> Rational -> BooleanFormula a -> SDoc
pprBooleanFormula' pprVar pprAnd pprOr = go
where
go p (Var x) = pprVar p x
@@ -209,15 +168,15 @@ pprBooleanFormula' pprVar pprAnd pprOr = go
go p (Parens x) = go p x
-- Pretty print in source syntax, "a | b | c,d,e"
-pprBooleanFormula :: (Rational -> LIdP (GhcPass p) -> SDoc)
- -> Rational -> BooleanFormula (GhcPass p) -> SDoc
+pprBooleanFormula :: (Rational -> a -> SDoc)
+ -> Rational -> BooleanFormula a -> 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 (LIdP (GhcPass p)) => BooleanFormula (GhcPass p) -> SDoc
+pprBooleanFormulaNice :: Outputable a => BooleanFormula a -> SDoc
pprBooleanFormulaNice = pprBooleanFormula' pprVar pprAnd pprOr 0
where
pprVar _ = quotes . ppr
@@ -227,13 +186,13 @@ 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 OutputableBndrId p => Outputable (BooleanFormula (GhcPass p)) where
+instance OutputableBndr a => Outputable (BooleanFormula a) where
ppr = pprBooleanFormulaNormal
-pprBooleanFormulaNormal :: OutputableBndrId p => BooleanFormula (GhcPass p) -> SDoc
+pprBooleanFormulaNormal :: OutputableBndr a => BooleanFormula a -> SDoc
pprBooleanFormulaNormal = go
where
- go (Var x) = pprPrefixOcc (unLoc x)
+ go (Var x) = pprPrefixOcc x
go (And xs) = fsep $ punctuate comma (map go xs)
go (Or []) = keyword $ text "FALSE"
go (Or xs) = fsep $ intersperse vbar (map go xs)
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -13,6 +13,8 @@
-- in module Language.Haskell.Syntax.Extension
{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use camelCase" #-}
{-
(c) The University of Glasgow 2006
@@ -933,8 +935,9 @@ instance Outputable TcSpecPrag where
ppr (SpecPrag var _ inl)
= text (extractSpecPragName $ inl_src inl) <+> pprSpec var (text "<type>") inl
-pprMinimalSig :: OutputableBndrId p => BooleanFormula (GhcPass p) -> SDoc
-pprMinimalSig = pprBooleanFormulaNormal
+pprMinimalSig :: (OutputableBndr name)
+ => BooleanFormula (GenLocated l name) -> SDoc
+pprMinimalSig bf = ppr (fmap unLoc bf)
{-
************************************************************************
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -591,5 +591,5 @@ deriving instance Data XViaStrategyPs
-- ---------------------------------------------------------------------
-deriving instance (Typeable p, Data (Anno (IdGhcP p)), Data (IdGhcP p)) => Data (BooleanFormula (GhcPass p))
+deriving instance Data a => Data (BooleanFormula a)
---------------------------------------------------------------------
\ No newline at end of file
=====================================
compiler/GHC/Iface/Decl.hs
=====================================
@@ -13,10 +13,6 @@
module GHC.Iface.Decl
( coAxiomToIfaceDecl
, tyThingToIfaceDecl -- Converting things to their Iface equivalents
- , toIfaceBooleanFormula
-
- -- converting back
- , traverseIfaceBooleanFormula
)
where
@@ -340,22 +336,4 @@ tidyTyConBinders = mapAccumL tidyTyConBinder
tidyTyVar :: TidyEnv -> TyVar -> IfLclName
tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
-toIfaceBooleanFormula :: NamedThing (IdP (GhcPass p))
- => BooleanFormula (GhcPass p) -> IfaceBooleanFormula
-toIfaceBooleanFormula = go
- where
- go (Var nm ) = IfVar $ mkIfLclName . getOccFS . unLoc $ nm
- go (And bfs ) = IfAnd $ map go bfs
- go (Or bfs ) = IfOr $ map go bfs
- go (Parens bf) = IfParens $ go bf
-
-traverseIfaceBooleanFormula :: Applicative f
- => (IfLclName -> f (LIdP (GhcPass p)))
- -> IfaceBooleanFormula
- -> f (BooleanFormula (GhcPass p))
-traverseIfaceBooleanFormula f = go
- where
- go (IfVar nm ) = Var <$> f nm
- go (IfAnd ibfs ) = And <$> traverse go ibfs
- go (IfOr ibfs ) = Or <$> traverse go ibfs
- go (IfParens ibf) = Parens <$> go ibf
\ No newline at end of file
+
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -2041,24 +2041,13 @@ instance ToHie PendingRnSplice where
instance ToHie PendingTcSplice where
toHie (PendingTcSplice _ e) = toHie e
-instance (HiePass p, Data (IdGhcP p))
- => ToHie (GenLocated SrcSpanAnnL (BooleanFormula (GhcPass p))) where
- toHie (L span form) = concatM [makeNode form (locA span), toHie form]
-instance (HiePass p, Data (IdGhcP p))
- => ToHie (BooleanFormula (GhcPass p)) where
- toHie formula = concatM $ case formula of
- Var a ->
- [ toHie $ C Use a
- ]
- And forms ->
- [ toHie forms
- ]
- Or forms ->
- [ toHie forms
- ]
- Parens f ->
- [ toHie f
- ]
+instance ToHie (LocatedN (BooleanFormula (LocatedN Name))) where
+ toHie (L span form) = concatM [makeNode form (locA span), toHie form]
+instance ToHie (BooleanFormula (LocatedN Name)) where
+ toHie (Var a) = toHie $ C Use a
+ toHie (And forms) = toHie forms
+ toHie (Or forms ) = toHie forms
+ toHie (Parens f ) = toHie f
instance ToHie (LocatedAn NoEpAnns HsIPName) where
toHie (L span e) = makeNodeA e span
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -6,6 +6,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveTraversable #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
module GHC.Iface.Syntax (
module GHC.Iface.Type,
@@ -92,6 +93,9 @@ import GHC.Utils.Panic
import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith,
seqList, zipWithEqual )
+import Language.Haskell.Syntax.BooleanFormula (BooleanFormula(..))
+import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
+
import Control.Monad
import System.IO.Unsafe
import Control.DeepSeq
@@ -212,12 +216,7 @@ data IfaceClassBody
ifMinDef :: IfaceBooleanFormula -- Minimal complete definition
}
-data IfaceBooleanFormula
- = IfVar IfLclName
- | IfAnd [IfaceBooleanFormula]
- | IfOr [IfaceBooleanFormula]
- | IfParens IfaceBooleanFormula
- deriving Eq
+type IfaceBooleanFormula = BooleanFormula IfLclName
data IfaceTyConParent
= IfNoParent
@@ -1033,29 +1032,12 @@ pprIfaceDecl ss (IfaceClass { ifName = clas
| otherwise = Nothing
pprMinDef :: IfaceBooleanFormula -> SDoc
- pprMinDef minDef = ppUnless (ifLclIsTrue minDef) $ -- hide empty definitions
+ pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
text "{-# MINIMAL" <+>
- pprifLclBooleanFormula
+ pprBooleanFormula
(\_ def -> let fs = ifLclNameFS def in cparen (isLexSym fs) (ppr fs)) 0 minDef <+>
text "#-}"
- ifLclIsTrue :: IfaceBooleanFormula -> Bool
- ifLclIsTrue (IfAnd []) = True
- ifLclIsTrue _ = False
-
- pprifLclBooleanFormula :: (Rational -> IfLclName -> SDoc)
- -> Rational -> IfaceBooleanFormula -> SDoc
- pprifLclBooleanFormula pprVar = go
- where
- go p (IfVar x) = pprVar p x
- go p (IfAnd []) = cparen (p > 0) empty
- go p (IfAnd xs) = pprAnd p (map (go 3) xs)
- go _ (IfOr []) = keyword $ text "FALSE"
- go p (IfOr xs) = pprOr p (map (go 2) xs)
- go p (IfParens x) = go p x
- pprAnd p = cparen (p > 3) . fsep . punctuate comma
- pprOr p = cparen (p > 2) . fsep . intersperse vbar
-
-- See Note [Suppressing binder signatures] in GHC.Iface.Type
suppress_bndr_sig = SuppressBndrSig True
@@ -2146,17 +2128,17 @@ instance Binary IfaceDecl where
instance Binary IfaceBooleanFormula where
put_ bh = \case
- IfVar a1 -> putByte bh 0 >> put_ bh a1
- IfAnd a1 -> putByte bh 1 >> put_ bh a1
- IfOr a1 -> putByte bh 2 >> put_ bh a1
- IfParens a1 -> putByte bh 3 >> put_ bh a1
+ Var a1 -> putByte bh 0 >> put_ bh a1
+ And a1 -> putByte bh 1 >> put_ bh a1
+ Or a1 -> putByte bh 2 >> put_ bh a1
+ Parens a1 -> putByte bh 3 >> put_ bh a1
get bh = do
getByte bh >>= \case
- 0 -> IfVar <$> get bh
- 1 -> IfAnd <$> get bh
- 2 -> IfOr <$> get bh
- _ -> IfParens <$> get bh
+ 0 -> Var <$> get bh
+ 1 -> And <$> get bh
+ 2 -> Or <$> get bh
+ _ -> Parens <$> get bh
{- Note [Lazy deserialization of IfaceId]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2813,10 +2795,10 @@ instance NFData IfaceClassBody where
instance NFData IfaceBooleanFormula where
rnf = \case
- IfVar f1 -> rnf f1
- IfAnd f1 -> rnf f1
- IfOr f1 -> rnf f1
- IfParens f1 -> rnf f1
+ Var f1 -> rnf f1
+ And f1 -> rnf f1
+ Or f1 -> rnf f1
+ Parens f1 -> rnf f1
instance NFData IfaceAT where
rnf (IfaceAT f1 f2) = rnf f1 `seq` rnf f2
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -44,7 +44,6 @@ import GHC.Driver.Config.Core.Lint ( initLintConfig )
import GHC.Builtin.Types.Literals(typeNatCoAxiomRules)
import GHC.Builtin.Types
-import GHC.Iface.Decl (traverseIfaceBooleanFormula)
import GHC.Iface.Syntax
import GHC.Iface.Load
import GHC.Iface.Env
@@ -139,6 +138,7 @@ import qualified Data.List.NonEmpty as NE
import GHC.Builtin.Names (ioTyConName, rOOT_MAIN)
import GHC.Iface.Errors.Types
import Language.Haskell.Syntax.Extension (NoExtField (NoExtField))
+import Language.Haskell.Syntax.BooleanFormula (mkOr)
{-
This module takes
@@ -299,23 +299,9 @@ mergeIfaceDecl d1 d2
(mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])
(mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
- -- same as BooleanFormula's mkOr, but specialized to IfaceBooleanFormula,
- -- which can be taught of as being (BooleanFormula IfacePass) morally.
- -- In practice, however, its a seperate type so it needs its own function
- -- It makes an Or and does some super basic simplification.
- mkIfaceOr :: [IfaceBooleanFormula] -> IfaceBooleanFormula
- mkIfaceOr = maybe (IfAnd []) (mkIfaceOr' . nub . concat) . mapM fromOr
- where
- fromOr bf = case bf of
- (IfOr xs) -> Just xs
- (IfAnd []) -> Nothing
- _ -> Just [bf]
- mkIfaceOr' [x] = x
- mkIfaceOr' xs = IfOr xs
-
in d1 { ifBody = (ifBody d1) {
ifSigs = ops,
- ifMinDef = mkIfaceOr [bf1, bf2]
+ ifMinDef = mkOr [bf1, bf2]
}
} `withRolesFrom` d2
-- It doesn't matter; we'll check for consistency later when
@@ -811,7 +797,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)
- ; mindef <- traverseIfaceBooleanFormula (fmap noLocA . lookupIfaceTop . mkVarOccFS . ifLclNameFS) if_mindef
+ ; mindef <- traverse (lookupIfaceTop . mkVarOccFS . ifLclNameFS) if_mindef
; cls <- fixM $ \ cls -> do
{ ats <- mapM (tc_at cls) rdr_ats
; traceIf (text "tc-iface-class4" <+> ppr tc_name)
=====================================
compiler/GHC/Parser.y
=====================================
@@ -55,7 +55,6 @@ import GHC.Unit.Module
import GHC.Unit.Module.Warnings
import GHC.Data.OrdList
-import GHC.Data.BooleanFormula ( BooleanFormula(..), LBooleanFormula, mkTrue )
import GHC.Data.FastString
import GHC.Data.Maybe ( orElse )
@@ -96,6 +95,7 @@ import GHC.Builtin.Types ( unitTyCon, unitDataCon, sumTyCon,
unrestrictedFunTyCon )
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
+import Language.Haskell.Syntax.BooleanFormula ( BooleanFormula(..), mkTrue )
import qualified Data.Semigroup as Semi
}
@@ -3701,26 +3701,24 @@ overloaded_label :: { Located (SourceText, FastString) }
-----------------------------------------------------------------------------
-- Warnings and deprecations
-name_boolformula_opt :: { BooleanFormula GhcPs }
+name_boolformula_opt :: { BooleanFormula (LocatedN RdrName) }
: name_boolformula { $1 }
| {- empty -} { mkTrue }
-name_boolformula :: { BooleanFormula GhcPs }
- : name_boolformula_and { $1 }
- | name_boolformula_and '|' name_boolformula
- { (Or [$1, $3]) }
+name_boolformula :: { BooleanFormula (LocatedN RdrName) }
+ : name_boolformula_and { $1 }
+ | name_boolformula_and '|' name_boolformula { Or [ $1 , $3 ] }
-name_boolformula_and :: { BooleanFormula GhcPs }
+name_boolformula_and :: { BooleanFormula (LocatedN RdrName) }
: name_boolformula_and_list { (And ($1)) }
-name_boolformula_and_list :: { [BooleanFormula GhcPs] }
- : name_boolformula_atom { [$1] }
- | name_boolformula_atom ',' name_boolformula_and_list
- { ($1 : $3) }
+name_boolformula_and_list :: { [BooleanFormula (LocatedN RdrName)] }
+ : name_boolformula_atom { [$1] }
+ | name_boolformula_atom ',' name_boolformula_and_list { ($1 : $3) }
-name_boolformula_atom :: { BooleanFormula GhcPs }
- : '(' name_boolformula ')' { (Parens $2) }
- | name_var { (Var $1) }
+name_boolformula_atom :: { BooleanFormula (LocatedN RdrName) }
+ : '(' name_boolformula ')' { (Parens $2) }
+ | name_var { (Var $1) }
namelist :: { Located [LocatedN RdrName] }
namelist : name_var { sL1 $1 [$1] }
@@ -4724,4 +4722,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,7 +80,6 @@ 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
@@ -1138,7 +1137,7 @@ renameSig ctxt (FixSig _ fsig)
; return (FixSig noAnn new_fsig, emptyFVs) }
renameSig ctxt sig@(MinimalSig (_, s) bf)
- = do new_bf <- bfTraverse (lookupSigOccRnN ctxt sig) bf
+ = do new_bf <- traverse (lookupSigOccRnN ctxt sig) bf
return (MinimalSig (noAnn, s) 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 [ mkVar (noLocA name)
+ defMindef = mkAnd [ mkVar 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 _ bf)) = Just bf
- toMinimalDef _ = Nothing
+ toMinimalDef (L _ (MinimalSig _ bf)) = Just $ fmap unLoc bf
+ toMinimalDef _ = Nothing
{-
Note [Polymorphic methods]
=====================================
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 . unLoc) (classMinimalDef clas)) $
+ whenIsJust (isUnsatisfied methodExists (classMinimalDef clas)) $
warnUnsatisfiedMinimalDefinition
methodExists meth = isJust (findMethodBind meth binds prag_fn)
=====================================
compiler/Language/Haskell/Syntax/Binds.hs
=====================================
@@ -465,7 +465,7 @@ data Sig pass
-- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
- | MinimalSig (XMinimalSig pass) (BooleanFormula pass)
+ | MinimalSig (XMinimalSig pass) (BooleanFormula (LIdP pass))
-- | A "set cost centre" pragma for declarations
--
=====================================
compiler/Language/Haskell/Syntax/BooleanFormula.hs
=====================================
@@ -3,43 +3,38 @@
{-# LANGUAGE QuantifiedConstraints #-}
module Language.Haskell.Syntax.BooleanFormula(
- BooleanFormula(..), LBooleanFormula,
+ BooleanFormula(..),
mkVar, mkFalse, mkTrue, mkBool, mkAnd, mkOr
) where
import Prelude hiding ( init, last )
import Data.List ( nub )
-import Language.Haskell.Syntax.Extension (XRec, LIdP)
-
-- types
-type LBooleanFormula p = XRec p (BooleanFormula p)
-data BooleanFormula p = Var (LIdP p) | And [BooleanFormula p] | Or [BooleanFormula p]
- | Parens (BooleanFormula p)
-
--- instances
-deriving instance Eq (LIdP p) => Eq (BooleanFormula p)
+data BooleanFormula a = Var a | And [BooleanFormula a] | Or [BooleanFormula a]
+ | Parens (BooleanFormula a)
+ deriving (Eq, Functor, Foldable, Traversable)
-- smart constructors
-- see note [Simplification of BooleanFormulas]
-mkVar :: LIdP p -> BooleanFormula p
+mkVar :: a -> BooleanFormula a
mkVar = Var
-mkFalse, mkTrue :: BooleanFormula p
+mkFalse, mkTrue :: BooleanFormula a
mkFalse = Or []
mkTrue = And []
-- Convert a Bool to a BooleanFormula
-mkBool :: Bool -> BooleanFormula p
+mkBool :: Bool -> BooleanFormula a
mkBool False = mkFalse
mkBool True = mkTrue
-- Make a conjunction, and try to simplify
-mkAnd :: Eq (LIdP p) => [BooleanFormula p] -> BooleanFormula p
+mkAnd :: Eq a => [BooleanFormula a] -> BooleanFormula a
mkAnd = maybe mkFalse (mkAnd' . nub . concat) . mapM fromAnd
where
-- See Note [Simplification of BooleanFormulas]
- fromAnd :: BooleanFormula p -> Maybe [BooleanFormula p]
+ fromAnd :: BooleanFormula a -> Maybe [BooleanFormula a]
fromAnd bf = case bf of
(And xs) -> Just xs
-- assume that xs are already simplified
@@ -50,7 +45,7 @@ mkAnd = maybe mkFalse (mkAnd' . nub . concat) . mapM fromAnd
mkAnd' [x] = x
mkAnd' xs = And xs
-mkOr :: Eq (LIdP p) => [BooleanFormula p] -> BooleanFormula p
+mkOr :: Eq a => [BooleanFormula a] -> BooleanFormula a
mkOr = maybe mkTrue (mkOr' . nub . concat) . mapM fromOr
where
-- See Note [Simplification of BooleanFormulas]
=====================================
utils/haddock/haddock-api/src/Haddock/Convert.hs
=====================================
@@ -177,7 +177,7 @@ tyThingToLHsDecl prr t = case t of
$ snd
$ classTvsFds cl
, tcdSigs =
- noLocA (MinimalSig (noAnn, NoSourceText) $ classMinimalDef cl)
+ noLocA (MinimalSig (noAnn, NoSourceText) . fmap noLocA $ classMinimalDef cl)
: [ noLocA tcdSig
| clsOp <- classOpItems cl
, tcdSig <- synifyTcIdSig vs clsOp
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
=====================================
@@ -773,21 +773,12 @@ renameSig sig = case sig of
lnames' <- mapM renameNameL lnames
return $ FixSig noExtField (FixitySig noExtField lnames' fixity)
MinimalSig _ s -> do
- s' <- bfTraverse (traverse lookupRn) s
+ s' <- traverse (traverse lookupRn) s
return $ MinimalSig noExtField 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 @[] go bfs
- go (Or bfs) = Or <$> traverse @[] go bfs
- go (Parens bf ) = Parens <$> go bf
+
renameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI)
renameForD (ForeignImport _ lname ltype x) = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf67d010459bf26dfad38e05b6d9a7426be45b95
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf67d010459bf26dfad38e05b6d9a7426be45b95
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/20241011/2e2e665b/attachment-0001.html>
More information about the ghc-commits
mailing list