[Git][ghc/ghc][wip/ttg/types/basic] Moved OverlapMode from GHC.Types.Basic to L.H.S.OverlapPragma
Hassan Al-Awwadi (@hassan.awwadi)
gitlab at gitlab.haskell.org
Mon Oct 21 13:02:08 UTC 2024
Hassan Al-Awwadi pushed to branch wip/ttg/types/basic at Glasgow Haskell Compiler / GHC
Commits:
09915909 by Hassan Al-Awwadi at 2024-10-21T15:00:44+02:00
Moved OverlapMode from GHC.Types.Basic to L.H.S.OverlapPragma
Parameterized it over the pass too. The rest is churn.
- - - - -
30 changed files:
- compiler/GHC/Builtin/PrimOps/Ids.hs
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/InlinePragma.hs
- compiler/GHC/Hs/Instances.hs
- + compiler/GHC/Hs/OverlapPragma.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/InlinePragma.hs
- + compiler/Language/Haskell/Syntax/OverlapPragma.hs
- compiler/ghc.cabal.in
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
Changes:
=====================================
compiler/GHC/Builtin/PrimOps/Ids.hs
=====================================
@@ -23,7 +23,6 @@ import GHC.Builtin.Uniques
import GHC.Builtin.Names
import GHC.Builtin.Types.Prim
-import GHC.Types.Basic
import GHC.Types.Cpr
import GHC.Types.Demand
import GHC.Types.Id
@@ -37,7 +36,7 @@ import GHC.Types.Var.Set
import GHC.Tc.Types.Origin
import GHC.Tc.Utils.TcType ( ConcreteTvOrigin(..), ConcreteTyVars, TcType )
-import GHC.Hs.InlinePragma(InlinePragma(..), neverInlinePragma )
+import GHC.Hs.InlinePragma(neverInlinePragma)
import GHC.Data.SmallArray
import Data.Maybe ( mapMaybe, listToMaybe, catMaybes, maybeToList )
=====================================
compiler/GHC/Core/InstEnv.hs
=====================================
@@ -12,7 +12,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv.
module GHC.Core.InstEnv (
DFunId, InstMatch, ClsInstLookupResult,
CanonicalEvidence(..), PotentialUnifiers(..), getCoherentUnifiers, nullUnifiers,
- OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
+ OverlapFlag(..), OverlapMode(..),
ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprDFunId, pprInstances,
instanceWarning, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst,
instanceDFunId, updateClsInstDFuns, updateClsInstDFun,
@@ -43,6 +43,7 @@ import GHC.Core.Class
import GHC.Core.Unify
import GHC.Core.FVs( orphNamesOfTypes, orphNamesOfType )
import GHC.Hs.Extension
+import GHC.Hs.OverlapPragma
import GHC.Unit.Module.Env
import GHC.Unit.Module.Warnings
@@ -52,10 +53,8 @@ import GHC.Types.Unique.DSet
import GHC.Types.Var.Set
import GHC.Types.Name
import GHC.Types.Name.Set
-import GHC.Types.Basic
import GHC.Types.Id
import GHC.Generics (Generic)
-import Data.Data ( Data )
import Data.List.NonEmpty ( NonEmpty (..), nonEmpty )
import qualified Data.List.NonEmpty as NE
import Data.Maybe ( isJust )
@@ -114,7 +113,7 @@ data ClsInst
-- See Note [Implementation of deprecated instances]
-- in GHC.Tc.Solver.Dict
}
- deriving Data
+ -- deriving Data
-- | A fuzzy comparison function for class instances, intended for sorting
-- instances before displaying them to the user.
=====================================
compiler/GHC/Hs.hs
=====================================
@@ -33,6 +33,7 @@ module GHC.Hs (
module GHC.Hs.Doc,
module GHC.Hs.Extension,
module GHC.Hs.InlinePragma,
+ module GHC.Hs.OverlapPragma,
module GHC.Parser.Annotation,
Fixity,
@@ -56,6 +57,7 @@ import GHC.Hs.Type
import GHC.Hs.Utils
import GHC.Hs.Doc
import GHC.Hs.InlinePragma
+import GHC.Hs.OverlapPragma
import GHC.Hs.Instances () -- For Data instances
-- others:
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -12,6 +12,7 @@
{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable
{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
{-
(c) The University of Glasgow 2006
@@ -137,6 +138,7 @@ import GHC.Data.Maybe
import Data.Data (Data)
import Data.List (concatMap)
import Data.Foldable (toList)
+import GHC.Hs.OverlapPragma
{-
************************************************************************
@@ -1025,16 +1027,15 @@ ppDerivStrategy mb =
Nothing -> empty
Just (L _ ds) -> ppr ds
-ppOverlapPragma :: Maybe (LocatedP OverlapMode) -> SDoc
-ppOverlapPragma mb =
- case mb of
+ppOverlapPragma :: Maybe (LOverlapMode (GhcPass p)) -> SDoc
+ppOverlapPragma = \case
Nothing -> empty
- Just (L _ (NoOverlap s)) -> maybe_stext s "{-# NO_OVERLAP #-}"
- Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"
- Just (L _ (Overlapping s)) -> maybe_stext s "{-# OVERLAPPING #-}"
- Just (L _ (Overlaps s)) -> maybe_stext s "{-# OVERLAPS #-}"
- Just (L _ (Incoherent s)) -> maybe_stext s "{-# INCOHERENT #-}"
- Just (L _ (NonCanonical s)) -> maybe_stext s "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet
+ Just (L _ (NoOverlap s)) -> maybe_stext s "{-# NO_OVERLAP #-}"
+ Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"
+ Just (L _ (Overlapping s)) -> maybe_stext s "{-# OVERLAPPING #-}"
+ Just (L _ (Overlaps s)) -> maybe_stext s "{-# OVERLAPS #-}"
+ Just (L _ (Incoherent s)) -> maybe_stext s "{-# INCOHERENT #-}"
+ Just (L _ (XOverlapMode (NonCanonical s))) -> maybe_stext s "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet
where
maybe_stext NoSourceText alt = text alt
maybe_stext (SourceText src) _ = ftext src <+> text "#-}"
@@ -1466,7 +1467,7 @@ type instance Anno (ClsInstDecl (GhcPass p)) = SrcSpanAnnA
type instance Anno (InstDecl (GhcPass p)) = SrcSpanAnnA
type instance Anno (DocDecl (GhcPass p)) = SrcSpanAnnA
type instance Anno (DerivDecl (GhcPass p)) = SrcSpanAnnA
-type instance Anno OverlapMode = SrcSpanAnnP
+type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnP
type instance Anno (DerivStrategy (GhcPass p)) = EpAnnCO
type instance Anno (DefaultDecl (GhcPass p)) = SrcSpanAnnA
type instance Anno (ForeignDecl (GhcPass p)) = SrcSpanAnnA
=====================================
compiler/GHC/Hs/InlinePragma.hs
=====================================
@@ -3,13 +3,14 @@
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use camelCase" #-}
module GHC.Hs.InlinePragma(
- CompilerPhase(..), PhaseNum, beginPhase, nextPhase, laterPhase,
+ module Language.Haskell.Syntax.InlinePragma,
+ CompilerPhase(..), beginPhase, nextPhase, laterPhase,
Activation(..), isActive, competesWith,
isNeverActive, isAlwaysActive, activeInFinalPhase,
activateAfterInitial, activateDuringFinal, activeAfter,
- RuleMatchInfo(..), isConLike, isFunLike,
+ RuleMatchInfo(..),
InlineSpec(..), noUserInlineSpec,
InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
neverInlinePragma, dfunInlinePragma,
@@ -22,8 +23,9 @@ module GHC.Hs.InlinePragma(
inlinePragmaActivation, inlinePragmaRuleMatchInfo,
setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
pprInline, pprInlineDebug,
- convertInlinePragma, convertInlineSpec, convertActivation
+ convertInlinePragma, convertInlineSpec, convertActivation,
+ set_pragma_inline, set_pragma_activation, set_pragma_rule
) where
import GHC.Prelude
@@ -46,18 +48,18 @@ import GHC.Data.FastString (fsLit)
-}
--InlinePragma
-type instance XInlinePragma (GhcPass _) = SourceText
-type instance XXCInlinePragma (GhcPass _) = DataConCantHappen
+type instance XInlinePragma (GhcPass p) = SourceText
+type instance XXCInlinePragma (GhcPass p) = DataConCantHappen
deriving instance Eq (InlinePragma (GhcPass p))
--InlineSpec
-type instance XInline (GhcPass _) = SourceText
-type instance XInlinable (GhcPass _) = SourceText
-type instance XNoInline (GhcPass _) = SourceText
-type instance XOpaque (GhcPass _) = SourceText
-type instance XNoUserInlinePrag (GhcPass _) = NoExtField
-type instance XXInlineSpec (GhcPass _) = DataConCantHappen
+type instance XInline (GhcPass p) = SourceText
+type instance XInlinable (GhcPass p) = SourceText
+type instance XNoInline (GhcPass p) = SourceText
+type instance XOpaque (GhcPass p) = SourceText
+type instance XNoUserInlinePrag (GhcPass p) = NoExtField
+type instance XXInlineSpec (GhcPass p) = DataConCantHappen
deriving instance Eq (InlineSpec (GhcPass p))
@@ -250,9 +252,11 @@ alwaysInlineConLikePragma :: InlinePragma (GhcPass p)
alwaysInlineConLikePragma = set_pragma_rule alwaysInlinePragma ConLike
inlinePragmaSpec :: InlinePragma (GhcPass p) -> InlineSpec (GhcPass p)
-inlinePragmaSpec = inl_inline
+inlinePragmaSpec inl@(InlinePragma{}) = inl_inline inl
+inlinePragmaSpec (XCInlinePragma imp) = dataConCantHappen imp
inlinePragmaSource :: InlinePragma (GhcPass p) -> SourceText
+inlinePragmaSource (XCInlinePragma imp) = dataConCantHappen imp
inlinePragmaSource prag = case inl_inline prag of
Inline x -> x
Inlinable y -> y
@@ -293,29 +297,38 @@ isInlinePragma prag@(InlinePragma{}) = case inl_inline prag of
isInlinePragma (XCInlinePragma imp) = dataConCantHappen imp
isInlinablePragma :: InlinePragma (GhcPass p) -> Bool
-isInlinablePragma prag = case inl_inline prag of
- Inlinable _ -> True
- _ -> False
+isInlinablePragma prag@(InlinePragma{}) =
+ case inl_inline prag of
+ Inlinable _ -> True
+ _ -> False
+isInlinablePragma (XCInlinePragma imp) = dataConCantHappen imp
isNoInlinePragma :: InlinePragma (GhcPass p) -> Bool
-isNoInlinePragma prag = case inl_inline prag of
- NoInline _ -> True
- _ -> False
+isNoInlinePragma prag@(InlinePragma{}) =
+ case inl_inline prag of
+ NoInline _ -> True
+ _ -> False
+isNoInlinePragma (XCInlinePragma imp) = dataConCantHappen imp
isAnyInlinePragma :: InlinePragma (GhcPass p) -> Bool
-- INLINE or INLINABLE
-isAnyInlinePragma prag = case inl_inline prag of
- Inline _ -> True
- Inlinable _ -> True
- _ -> False
+isAnyInlinePragma prag@(InlinePragma{}) =
+ case inl_inline prag of
+ Inline _ -> True
+ Inlinable _ -> True
+ _ -> False
+isAnyInlinePragma (XCInlinePragma imp) = dataConCantHappen imp
isOpaquePragma :: InlinePragma (GhcPass p) -> Bool
-isOpaquePragma prag = case inl_inline prag of
- Opaque _ -> True
- _ -> False
+isOpaquePragma prag@(InlinePragma{}) =
+ case inl_inline prag of
+ Opaque _ -> True
+ _ -> False
+isOpaquePragma (XCInlinePragma imp) = dataConCantHappen imp
inlinePragmaSat :: InlinePragma (GhcPass p) -> Maybe Arity
-inlinePragmaSat = inl_sat
+inlinePragmaSat prag@(InlinePragma{}) = inl_sat prag
+inlinePragmaSat (XCInlinePragma imp) = dataConCantHappen imp
inlinePragmaActivation :: InlinePragma (GhcPass p) -> Activation (GhcPass p)
inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -32,8 +32,11 @@ import GHC.Hs.Lit
import GHC.Hs.Type
import GHC.Hs.Pat
import GHC.Hs.ImpExp
+import GHC.Hs.OverlapPragma
+import GHC.Hs.InlinePragma
+
import GHC.Parser.Annotation
-import Language.Haskell.Syntax.InlinePragma
+--import GHC.Core.InstEnv (ClsInst)
-- ---------------------------------------------------------------------
-- Data derivations from GHC.Hs-----------------------------------------
@@ -595,6 +598,7 @@ deriving instance Data XXPatGhcTc
deriving instance Data XViaStrategyPs
-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs.InlinePragma ---------------------------
deriving instance Data (Activation GhcPs)
deriving instance Data (Activation GhcRn)
@@ -606,4 +610,14 @@ deriving instance Data (InlineSpec GhcTc)
deriving instance Data (InlinePragma GhcPs)
deriving instance Data (InlinePragma GhcRn)
-deriving instance Data (InlinePragma GhcTc)
\ No newline at end of file
+deriving instance Data (InlinePragma GhcTc)
+
+deriving instance Data RuleMatchInfo
+
+-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs.OverlapPragma --------------------------
+deriving instance Data (OverlapMode GhcPs)
+deriving instance Data (OverlapMode GhcRn)
+deriving instance Data (OverlapMode GhcTc)
+deriving instance Data NonCanonical
+deriving instance Data OverlapFlag
\ No newline at end of file
=====================================
compiler/GHC/Hs/OverlapPragma.hs
=====================================
@@ -0,0 +1,144 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module GHC.Hs.OverlapPragma(
+ module Language.Haskell.Syntax.OverlapPragma
+ , NonCanonical(..)
+ , OverlapFlag(..)
+ , hasIncoherentFlag
+ , hasOverlappableFlag
+ , hasOverlappingFlag
+ , hasNonCanonicalFlag
+ , pprSafeOverlap
+ , convertOverlapMode
+) where
+
+import Language.Haskell.Syntax.OverlapPragma
+import Language.Haskell.Syntax.Extension
+
+import GHC.Prelude
+import GHC.Types.SourceText
+import GHC.Hs.Extension (GhcPass, GhcTc)
+
+import GHC.Utils.Binary
+import GHC.Utils.Outputable
+
+import GHC.Utils.Panic (panic)
+
+------------------------
+-- type family instances
+
+type instance XNoOverlap (GhcPass _) = SourceText
+type instance XOverlappable (GhcPass _) = SourceText
+type instance XOverlapping (GhcPass _) = SourceText
+type instance XOverlaps (GhcPass _) = SourceText
+type instance XIncoherent (GhcPass _) = SourceText
+type instance XXOverlapMode (GhcPass _) = NonCanonical
+newtype NonCanonical = NonCanonical SourceText
+ deriving (Eq)
+ -- ^ Behave like Incoherent, but the instance choice is observable
+ -- by the program behaviour. See Note [Coherence and specialisation: overview].
+ --
+ -- We don't have surface syntax for the distinction between
+ -- Incoherent and NonCanonical instances; instead, the flag
+ -- `-f{no-}specialise-incoherents` (on by default) controls
+ -- whether `INCOHERENT` instances are regarded as Incoherent or
+ -- NonCanonical.
+
+
+-----------------------
+-- converting
+convertOverlapMode :: OverlapMode (GhcPass p) -> OverlapMode (GhcPass p')
+convertOverlapMode = \case
+ NoOverlap s -> NoOverlap s
+ Overlappable s -> Overlappable s
+ Overlapping s -> Overlapping s
+ Overlaps s -> Overlaps s
+ Incoherent s -> Incoherent s
+ XOverlapMode s -> XOverlapMode s
+
+------------------------
+-- overlap flag
+data OverlapFlag = OverlapFlag
+ { overlapMode :: OverlapMode GhcTc
+ , isSafeOverlap :: Bool
+ } deriving (Eq)
+
+------------------------
+-- deriving instances
+deriving instance Eq (OverlapMode (GhcPass p))
+
+------------------------
+-- hand rolled instances
+instance Outputable (OverlapMode (GhcPass p)) where
+ ppr (NoOverlap _) = empty
+ ppr (Overlappable _) = text "[overlappable]"
+ ppr (Overlapping _) = text "[overlapping]"
+ ppr (Overlaps _) = text "[overlap ok]"
+ ppr (Incoherent _) = text "[incoherent]"
+ ppr (XOverlapMode (NonCanonical _)) = text "[noncanonical]"
+
+
+instance Outputable OverlapFlag where
+ ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
+
+-- might want to make an explicit IfaceOverlapMode, I guess
+instance Binary (OverlapMode (GhcPass p)) where
+ put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s
+ put_ bh (Overlaps s) = putByte bh 1 >> put_ bh s
+ put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s
+ put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s
+ put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s
+ put_ bh (XOverlapMode (NonCanonical s)) = putByte bh 5 >> put_ bh s
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> (get bh) >>= \s -> return $ NoOverlap s
+ 1 -> (get bh) >>= \s -> return $ Overlaps s
+ 2 -> (get bh) >>= \s -> return $ Incoherent s
+ 3 -> (get bh) >>= \s -> return $ Overlapping s
+ 4 -> (get bh) >>= \s -> return $ Overlappable s
+ 5 -> (get bh) >>= \s -> return $ XOverlapMode (NonCanonical s)
+ _ -> panic ("get OverlapMode" ++ show h)
+
+
+instance Binary OverlapFlag where
+ put_ bh flag = do put_ bh (overlapMode flag)
+ put_ bh (isSafeOverlap flag)
+ get bh = do
+ h <- get bh
+ b <- get bh
+ return OverlapFlag { overlapMode = h, isSafeOverlap = b }
+
+------------------------
+-- helper functions
+hasIncoherentFlag :: OverlapMode (GhcPass p) -> Bool
+hasIncoherentFlag = \case
+ Incoherent _ -> True
+ XOverlapMode (NonCanonical _) -> True
+ _ -> False
+
+hasOverlappableFlag :: OverlapMode (GhcPass p) -> Bool
+hasOverlappableFlag = \case
+ Overlappable _ -> True
+ Overlaps _ -> True
+ Incoherent _ -> True
+ XOverlapMode (NonCanonical _) -> True
+ _ -> False
+
+hasOverlappingFlag :: OverlapMode (GhcPass p) -> Bool
+hasOverlappingFlag = \case
+ Overlapping _ -> True
+ Overlaps _ -> True
+ Incoherent _ -> True
+ XOverlapMode (NonCanonical _) -> True
+ _ -> False
+
+hasNonCanonicalFlag :: OverlapMode (GhcPass p) -> Bool
+hasNonCanonicalFlag = \case
+ XOverlapMode (NonCanonical _) -> True
+ _ -> False
+
+pprSafeOverlap :: Bool -> SDoc
+pprSafeOverlap True = text "[safe]"
+pprSafeOverlap False = empty
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -442,12 +442,15 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
= (gbl_id `setIdUnfolding` mkCompulsoryUnfolding' simpl_opts rhs, rhs)
| otherwise
- = case inlinePragmaSpec inline_prag of
+ = case inline_prag of
+ XCInlinePragma imp -> dataConCantHappen imp
+ InlinePragma{inl_inline = spec} -> case spec of
NoUserInlinePrag{} -> (gbl_id, rhs)
NoInline {} -> (gbl_id, rhs)
Opaque {} -> (gbl_id, rhs)
Inlinable {} -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)
Inline {} -> inline_pair
+ XInlineSpec i -> dataConCantHappen i
where
simpl_opts = initSimpleOpts dflags
inline_prag = idInlinePragma gbl_id
=====================================
compiler/GHC/HsToCore/Foreign/C.hs
=====================================
@@ -39,7 +39,6 @@ import GHC.Types.Name
import GHC.Types.RepType
import GHC.Types.ForeignCall
import GHC.Types.Basic
-import GHC.Hs.InlinePragma ( Activation(..) )
import GHC.Unit.Module
import GHC.Driver.DynFlags
@@ -60,7 +59,6 @@ import GHC.Utils.Encoding
import Data.Maybe
import Data.List (nub)
-import Language.Haskell.Syntax (noExtField)
dsCFExport:: Id -- Either the exported Id,
-- or the foreign-export-dynamic constructor
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -2707,18 +2707,18 @@ repNewtypeStrategy = rep2 newtypeStrategyName []
repViaStrategy :: Core (M TH.Type) -> MetaM (Core (M TH.DerivStrategy))
repViaStrategy (MkC t) = rep2 viaStrategyName [t]
-repOverlap :: Maybe OverlapMode -> MetaM (Core (Maybe TH.Overlap))
+repOverlap :: Maybe (OverlapMode (GhcPass p)) -> MetaM (Core (Maybe TH.Overlap))
repOverlap mb =
case mb of
Nothing -> nothing
Just o ->
case o of
- NoOverlap _ -> nothing
- Overlappable _ -> just =<< dataCon overlappableDataConName
- Overlapping _ -> just =<< dataCon overlappingDataConName
- Overlaps _ -> just =<< dataCon overlapsDataConName
- Incoherent _ -> just =<< dataCon incoherentDataConName
- NonCanonical _ -> just =<< dataCon incoherentDataConName
+ NoOverlap _ -> nothing
+ Overlappable _ -> just =<< dataCon overlappableDataConName
+ Overlapping _ -> just =<< dataCon overlappingDataConName
+ Overlaps _ -> just =<< dataCon overlapsDataConName
+ Incoherent _ -> just =<< dataCon incoherentDataConName
+ XOverlapMode (NonCanonical _) -> just =<< dataCon incoherentDataConName
where
nothing = coreNothing overlapTyConName
just = coreJust overlapTyConName
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -45,9 +45,6 @@ import GHC.Types.CostCentre
import GHC.Types.CostCentre.State
import GHC.Types.Tickish
import GHC.Types.ProfAuto
-
-import GHC.Hs.InlinePragma(isInlinePragma)
-
import Control.Monad
import Data.List (isSuffixOf, intersperse)
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -1742,7 +1742,7 @@ instance ToHie (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where
NewtypeStrategy _ -> []
ViaStrategy s -> [ toHie (TS (ResolvedScopes [sc]) s) ]
-instance ToHie (LocatedP OverlapMode) where
+instance ToHie (LocatedP (OverlapMode (GhcPass p))) where
toHie (L span _) = locOnly (locA span)
instance ToHie a => ToHie (HsScaled GhcRn a) where
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -86,7 +86,11 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
import GHC.Builtin.Types ( constraintKindTyConName )
import GHC.Stg.InferTags.TagSig
import GHC.Parser.Annotation (noLocA)
+
import GHC.Hs.Extension ( GhcRn, GhcPass )
+import GHC.Hs.OverlapPragma
+import GHC.Hs.InlinePragma
+
import GHC.Hs.Doc ( WithHsDocIdentifiers(..) )
import GHC.Utils.Lexeme (isLexSym)
@@ -98,7 +102,6 @@ import GHC.Utils.Panic
import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith,
seqList, zipWithEqual )
-import Language.Haskell.Syntax.InlinePragma
import Language.Haskell.Syntax.Extension(noExtField)
import Control.Monad
@@ -1685,6 +1688,7 @@ instance Binary IfaceActivation where
_ -> do src <- get bh
ab <- get bh
return (IfActiveAfter src ab)
+
instance Binary RuleMatchInfo where
put_ bh FunLike = putByte bh 0
put_ bh ConLike = putByte bh 1
=====================================
compiler/GHC/Parser.y
=====================================
@@ -95,7 +95,6 @@ import GHC.Builtin.Types ( unitTyCon, unitDataCon, sumTyCon,
listTyCon_RDR, consDataCon_RDR,
unrestrictedFunTyCon )
-import Language.Haskell.Syntax.InlinePragma(InlinePragma(..))
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import qualified Data.Semigroup as Semi
@@ -1420,7 +1419,7 @@ inst_decl :: { LInstDecl GhcPs }
(fmap reverse $7)
(AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}}
-overlap_pragma :: { Maybe (LocatedP OverlapMode) }
+overlap_pragma :: { Maybe (LOverlapMode GhcPs) }
: '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))
(AnnPragma (mo $1) (mc $2) []) }
| '{-# OVERLAPPING' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1)))
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -632,7 +632,8 @@ rnClsInstDecl (ClsInstDecl { cid_ext = (inst_warn_ps, _, _)
; return (ClsInstDecl { cid_ext = inst_warn_rn
, cid_poly_ty = inst_ty', cid_binds = mbinds'
, cid_sigs = uprags', cid_tyfam_insts = ats'
- , cid_overlap_mode = oflag
+ , cid_overlap_mode = fmap (fmap convertOverlapMode) oflag
+ --double fmap to pierce through the Maybe and the Located wrapper
, cid_datafam_insts = adts' },
all_fvs) }
-- We return the renamed associated data type declarations so
@@ -1139,7 +1140,9 @@ rnSrcDerivDecl (DerivDecl (inst_warn_ps, ann) ty mds overlap)
NFC_StandaloneDerivedInstanceHead
(getLHsInstDeclHead $ dropWildCards ty')
; inst_warn_rn <- mapM rnLWarningTxt inst_warn_ps
- ; return (DerivDecl (inst_warn_rn, ann) ty' mds' overlap, fvs) }
+ ; return (DerivDecl (inst_warn_rn, ann) ty' mds' (fmap (fmap convertOverlapMode) overlap), fvs) }
+ --double fmap to pierce through the Maybe and the Located wrapper
+
where
ctxt = DerivDeclCtx
nowc_ty = dropWildCards ty
=====================================
compiler/GHC/Tc/Deriv.hs
=====================================
@@ -762,7 +762,7 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo
then do warnUselessTypeable
return Nothing
else do early_deriv_spec <-
- mkEqnHelp (fmap unLoc overlap_mode)
+ mkEqnHelp (fmap (convertOverlapMode . unLoc) overlap_mode)
tvs' cls inst_tys'
deriv_ctxt' mb_deriv_strat'
(fmap unLoc warn)
@@ -1217,7 +1217,7 @@ instance (at least from the user's perspective), the amount of engineering
required to obtain the latter instance just isn't worth it.
-}
-mkEqnHelp :: Maybe OverlapMode
+mkEqnHelp :: Maybe (OverlapMode GhcTc)
-> [TyVar]
-> Class -> [Type]
-> DerivContext
=====================================
compiler/GHC/Tc/Deriv/Utils.hs
=====================================
@@ -120,7 +120,7 @@ mkDerivOrigin standalone_wildcard
-- determining what its @EarlyDerivSpec@ should be.
-- See @Note [DerivEnv and DerivSpecMechanism]@.
data DerivEnv = DerivEnv
- { denv_overlap_mode :: Maybe OverlapMode
+ { denv_overlap_mode :: Maybe (OverlapMode GhcTc)
-- ^ Is this an overlapping instance?
, denv_tvs :: [TyVar]
-- ^ Universally quantified type variables in the instance. If the
@@ -175,7 +175,7 @@ data DerivSpec theta = DS { ds_loc :: SrcSpan
, ds_tys :: [Type]
, ds_skol_info :: SkolemInfo
, ds_user_ctxt :: UserTypeCtxt
- , ds_overlap :: Maybe OverlapMode
+ , ds_overlap :: Maybe (OverlapMode GhcTc)
, ds_standalone_wildcard :: Maybe SrcSpan
-- See Note [Inferring the instance context]
-- in GHC.Tc.Deriv.Infer
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -2535,12 +2535,12 @@ reifyClassInstance is_poly_tvs i
cls_tc = classTyCon cls
dfun = instanceDFunId i
over = case overlapMode (is_flag i) of
- NoOverlap _ -> Nothing
- Overlappable _ -> Just TH.Overlappable
- Overlapping _ -> Just TH.Overlapping
- Overlaps _ -> Just TH.Overlaps
- Incoherent _ -> Just TH.Incoherent
- NonCanonical _ -> Just TH.Incoherent
+ NoOverlap _ -> Nothing
+ Overlappable _ -> Just TH.Overlappable
+ Overlapping _ -> Just TH.Overlapping
+ Overlaps _ -> Just TH.Overlaps
+ Incoherent _ -> Just TH.Incoherent
+ XOverlapMode (NonCanonical _) -> Just TH.Incoherent
------------------------------
reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec]
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -543,7 +543,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_ext = lwarn
-- Dfun location is that of instance *header*
; let warn = fmap unLoc lwarn
- ; ispec <- newClsInst (fmap unLoc overlap_mode) dfun_name
+ ; ispec <- newClsInst (fmap (convertOverlapMode . unLoc) overlap_mode) dfun_name
tyvars theta clas inst_tys warn
; let inst_binds = InstBindings
=====================================
compiler/GHC/Tc/Utils/Instantiate.hs
=====================================
@@ -940,7 +940,7 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity
************************************************************************
-}
-getOverlapFlag :: Maybe OverlapMode -- User pragma if any
+getOverlapFlag :: Maybe (OverlapMode GhcTc) -- User pragma if any
-> TcM OverlapFlag
-- Construct the OverlapFlag from the global module flags,
-- but if the overlap_mode argument is (Just m),
@@ -974,7 +974,7 @@ getOverlapFlag overlap_mode_prag
-- See GHC.Core.InstEnv Note [Coherence and specialisation: overview]
final_overlap_mode
| Incoherent s <- overlap_mode
- , noncanonical_incoherence = NonCanonical s
+ , noncanonical_incoherence = XOverlapMode (NonCanonical s)
| otherwise = overlap_mode
; return (OverlapFlag { isSafeOverlap = safeLanguageOn dflags
@@ -985,7 +985,7 @@ tcGetInsts :: TcM [ClsInst]
-- Gets the local class instances.
tcGetInsts = fmap tcg_insts getGblEnv
-newClsInst :: Maybe OverlapMode -- User pragma
+newClsInst :: Maybe (OverlapMode GhcTc) -- User pragma
-> Name -> [TyVar] -> ThetaType
-> Class -> [Type] -> Maybe (WarningTxt GhcRn) -> TcM ClsInst
newClsInst overlap_mode dfun_name tvs theta clas tys warn
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -45,9 +45,6 @@ module GHC.Types.Basic (
TopLevelFlag(..), isTopLevel, isNotTopLevel,
- OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
- hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag,
-
Boxity(..), isBoxed,
CbvMark(..), isMarkedCbv,
@@ -619,174 +616,6 @@ of whether we should do pattern-match checks; see the calls of the requiresPMC
function (e.g. isMatchContextPmChecked and needToRunPmCheck in GHC.HsToCore.Pmc.Utils).
-}
-{-
-************************************************************************
-* *
- Instance overlap flag
-* *
-************************************************************************
--}
-
--- | The semantics allowed for overlapping instances for a particular
--- instance. See Note [Safe Haskell isSafeOverlap] in GHC.Core.InstEnv for a
--- explanation of the `isSafeOverlap` field.
---
--- - 'GHC.Parser.Annotation.AnnKeywordId' :
--- 'GHC.Parser.Annotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
--- @'\{-\# OVERLAPPING'@ or
--- @'\{-\# OVERLAPS'@ or
--- @'\{-\# INCOHERENT'@,
--- 'GHC.Parser.Annotation.AnnClose' @`\#-\}`@,
-
--- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation"
-data OverlapFlag = OverlapFlag
- { overlapMode :: OverlapMode
- , isSafeOverlap :: Bool
- } deriving (Eq, Data)
-
-setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
-setOverlapModeMaybe f Nothing = f
-setOverlapModeMaybe f (Just m) = f { overlapMode = m }
-
-hasIncoherentFlag :: OverlapMode -> Bool
-hasIncoherentFlag mode =
- case mode of
- Incoherent _ -> True
- NonCanonical _ -> True
- _ -> False
-
-hasOverlappableFlag :: OverlapMode -> Bool
-hasOverlappableFlag mode =
- case mode of
- Overlappable _ -> True
- Overlaps _ -> True
- Incoherent _ -> True
- NonCanonical _ -> True
- _ -> False
-
-hasOverlappingFlag :: OverlapMode -> Bool
-hasOverlappingFlag mode =
- case mode of
- Overlapping _ -> True
- Overlaps _ -> True
- Incoherent _ -> True
- NonCanonical _ -> True
- _ -> False
-
-hasNonCanonicalFlag :: OverlapMode -> Bool
-hasNonCanonicalFlag = \case
- NonCanonical{} -> True
- _ -> False
-
-data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv
- = NoOverlap SourceText
- -- See Note [Pragma source text]
- -- ^ This instance must not overlap another `NoOverlap` instance.
- -- However, it may be overlapped by `Overlapping` instances,
- -- and it may overlap `Overlappable` instances.
-
-
- | Overlappable SourceText
- -- See Note [Pragma source text]
- -- ^ Silently ignore this instance if you find a
- -- more specific one that matches the constraint
- -- you are trying to resolve
- --
- -- Example: constraint (Foo [Int])
- -- instance Foo [Int]
- -- instance {-# OVERLAPPABLE #-} Foo [a]
- --
- -- Since the second instance has the Overlappable flag,
- -- the first instance will be chosen (otherwise
- -- its ambiguous which to choose)
-
-
- | Overlapping SourceText
- -- See Note [Pragma source text]
- -- ^ Silently ignore any more general instances that may be
- -- used to solve the constraint.
- --
- -- Example: constraint (Foo [Int])
- -- instance {-# OVERLAPPING #-} Foo [Int]
- -- instance Foo [a]
- --
- -- Since the first instance has the Overlapping flag,
- -- the second---more general---instance will be ignored (otherwise
- -- it is ambiguous which to choose)
-
-
- | Overlaps SourceText
- -- See Note [Pragma source text]
- -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
-
- | Incoherent SourceText
- -- See Note [Pragma source text]
- -- ^ Behave like Overlappable and Overlapping, and in addition pick
- -- an arbitrary one if there are multiple matching candidates, and
- -- don't worry about later instantiation
- --
- -- Example: constraint (Foo [b])
- -- instance {-# INCOHERENT -} Foo [Int]
- -- instance Foo [a]
- -- Without the Incoherent flag, we'd complain that
- -- instantiating 'b' would change which instance
- -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv"
-
- | NonCanonical SourceText
- -- ^ Behave like Incoherent, but the instance choice is observable
- -- by the program behaviour. See Note [Coherence and specialisation: overview].
- --
- -- We don't have surface syntax for the distinction between
- -- Incoherent and NonCanonical instances; instead, the flag
- -- `-f{no-}specialise-incoherents` (on by default) controls
- -- whether `INCOHERENT` instances are regarded as Incoherent or
- -- NonCanonical.
-
- deriving (Eq, Data)
-
-
-instance Outputable OverlapFlag where
- ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
-
-instance Outputable OverlapMode where
- ppr (NoOverlap _) = empty
- ppr (Overlappable _) = text "[overlappable]"
- ppr (Overlapping _) = text "[overlapping]"
- ppr (Overlaps _) = text "[overlap ok]"
- ppr (Incoherent _) = text "[incoherent]"
- ppr (NonCanonical _) = text "[noncanonical]"
-
-instance Binary OverlapMode where
- put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s
- put_ bh (Overlaps s) = putByte bh 1 >> put_ bh s
- put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s
- put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s
- put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s
- put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s
- get bh = do
- h <- getByte bh
- case h of
- 0 -> (get bh) >>= \s -> return $ NoOverlap s
- 1 -> (get bh) >>= \s -> return $ Overlaps s
- 2 -> (get bh) >>= \s -> return $ Incoherent s
- 3 -> (get bh) >>= \s -> return $ Overlapping s
- 4 -> (get bh) >>= \s -> return $ Overlappable s
- 5 -> (get bh) >>= \s -> return $ NonCanonical s
- _ -> panic ("get OverlapMode" ++ show h)
-
-
-instance Binary OverlapFlag where
- put_ bh flag = do put_ bh (overlapMode flag)
- put_ bh (isSafeOverlap flag)
- get bh = do
- h <- get bh
- b <- get bh
- return OverlapFlag { overlapMode = h, isSafeOverlap = b }
-
-pprSafeOverlap :: Bool -> SDoc
-pprSafeOverlap True = text "[safe]"
-pprSafeOverlap False = empty
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -612,7 +612,7 @@ mkDataConWorkId wkr_name data_con
`setLFInfo` wkr_lf_info
-- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon
- wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike }
+ wkr_inline_prag = set_pragma_rule defaultInlinePragma ConLike
wkr_arity = dataConRepArity data_con
-- See Note [LFInfo of DataCon workers and wrappers]
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -98,8 +98,8 @@ import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Basic (Role, LexicalFixity, TyConFlavour(..), TypeOrData(..))
import Language.Haskell.Syntax.Specificity (Specificity)
import Language.Haskell.Syntax.InlinePragma(Activation)
-
-import GHC.Types.Basic (OverlapMode, RuleName)
+import Language.Haskell.Syntax.OverlapPragma(LOverlapMode)
+import GHC.Types.Basic (RuleName)
import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec)
import GHC.Unit.Module.Warnings (WarningTxt)
@@ -1383,7 +1383,7 @@ data ClsInstDecl pass
, cid_sigs :: [LSig pass] -- User-supplied pragmatic info
, cid_tyfam_insts :: [LTyFamInstDecl pass] -- Type family instances
, cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances
- , cid_overlap_mode :: Maybe (XRec pass OverlapMode)
+ , cid_overlap_mode :: Maybe (LOverlapMode pass)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnClose',
@@ -1436,7 +1436,7 @@ data DerivDecl pass = DerivDecl
-- See Note [Inferring the instance context] in GHC.Tc.Deriv.Infer.
, deriv_strategy :: Maybe (LDerivStrategy pass)
- , deriv_overlap_mode :: Maybe (XRec pass OverlapMode)
+ , deriv_overlap_mode :: Maybe (LOverlapMode pass)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDeriving',
-- 'GHC.Parser.Annotation.AnnInstance', 'GHC.Parser.Annotation.AnnStock',
-- 'GHC.Parser.Annotation.AnnAnyClass', 'GHC.Parser.Annotation.AnnNewtype',
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -735,7 +735,7 @@ type family XOpaque p
type family XNoUserInlinePrag p
type family XXInlineSpec p
--- Activaiton
+-- Activation
type family XAlwaysActive p
type family XActiveBefore p
type family XActiveAfter p
@@ -743,6 +743,17 @@ type family XFinalActive p
type family XNeverActive p
type family XXActivation p
+
+-- -------------------------------------
+-- Overlap pragma
+
+type family XNoOverlap p
+type family XOverlappable p
+type family XOverlapping p
+type family XOverlaps p
+type family XIncoherent p
+type family XXOverlapMode p
+
-- =====================================================================
-- Misc
=====================================
compiler/Language/Haskell/Syntax/InlinePragma.hs
=====================================
@@ -55,7 +55,7 @@ type PhaseNum = Int -- Compilation phase
-- | Rule Match Information
data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma] in GHC.Hs.InlinePragma
| FunLike
- deriving( Eq, Data, Show )
+ deriving( Eq, Show )
-- Show needed for GHC.Parser.Lexer
isConLike :: RuleMatchInfo -> Bool
=====================================
compiler/Language/Haskell/Syntax/OverlapPragma.hs
=====================================
@@ -0,0 +1,72 @@
+module Language.Haskell.Syntax.OverlapPragma where
+
+import Language.Haskell.Syntax.Extension
+
+-- | The semantics allowed for overlapping instances for a particular
+-- instance. See Note [Safe Haskell isSafeOverlap] in GHC.Core.InstEnv for a
+-- explanation of the `isSafeOverlap` field.
+--
+-- - 'GHC.Parser.Annotation.AnnKeywordId' :
+-- 'GHC.Parser.Annotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
+-- @'\{-\# OVERLAPPING'@ or
+-- @'\{-\# OVERLAPS'@ or
+-- @'\{-\# INCOHERENT'@,
+-- 'GHC.Parser.Annotation.AnnClose' @`\#-\}`@,
+
+type LOverlapMode p = XRec p (OverlapMode p)
+data OverlapMode p -- See Note [Rules for instance lookup] in GHC.Core.InstEnv
+ = NoOverlap (XNoOverlap p)
+ -- See Note [Pragma source text]
+ -- ^ This instance must not overlap another `NoOverlap` instance.
+ -- However, it may be overlapped by `Overlapping` instances,
+ -- and it may overlap `Overlappable` instances.
+
+
+ | Overlappable (XOverlappable p)
+ -- See Note [Pragma source text]
+ -- ^ Silently ignore this instance if you find a
+ -- more specific one that matches the constraint
+ -- you are trying to resolve
+ --
+ -- Example: constraint (Foo [Int])
+ -- instance Foo [Int]
+ -- instance {-# OVERLAPPABLE #-} Foo [a]
+ --
+ -- Since the second instance has the Overlappable flag,
+ -- the first instance will be chosen (otherwise
+ -- its ambiguous which to choose)
+
+
+ | Overlapping (XOverlapping p)
+ -- See Note [Pragma source text]
+ -- ^ Silently ignore any more general instances that may be
+ -- used to solve the constraint.
+ --
+ -- Example: constraint (Foo [Int])
+ -- instance {-# OVERLAPPING #-} Foo [Int]
+ -- instance Foo [a]
+ --
+ -- Since the first instance has the Overlapping flag,
+ -- the second---more general---instance will be ignored (otherwise
+ -- it is ambiguous which to choose)
+
+
+ | Overlaps (XOverlaps p)
+ -- See Note [Pragma source text]
+ -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
+
+ | Incoherent (XIncoherent p)
+ -- See Note [Pragma source text]
+ -- ^ Behave like Overlappable and Overlapping, and in addition pick
+ -- an arbitrary one if there are multiple matching candidates, and
+ -- don't worry about later instantiation
+ --
+ -- Example: constraint (Foo [b])
+ -- instance {-# INCOHERENT -} Foo [Int]
+ -- instance Foo [a]
+ -- Without the Incoherent flag, we'd complain that
+ -- instantiating 'b' would change which instance
+ -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv"
+
+ | XOverlapMode (XXOverlapMode p)
+
=====================================
compiler/ghc.cabal.in
=====================================
@@ -548,6 +548,7 @@ Library
GHC.Hs.Specificity
GHC.Hs.Stats
GHC.Hs.InlinePragma
+ GHC.Hs.OverlapPragma
GHC.HsToCore
GHC.HsToCore.Arrows
GHC.HsToCore.Binds
@@ -1001,6 +1002,7 @@ Library
Language.Haskell.Syntax.Specificity
Language.Haskell.Syntax.Type
Language.Haskell.Syntax.InlinePragma
+ Language.Haskell.Syntax.OverlapPragma
autogen-modules: GHC.Platform.Constants
GHC.Settings.Config
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -47,6 +47,8 @@ import GHC.Types.PkgQual
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Types.Var
+import GHC.Hs.OverlapPragma
+import GHC.Hs.InlinePragma
import GHC.Unit.Module.Warnings
import GHC.Utils.Misc
import GHC.Utils.Outputable hiding ( (<>) )
@@ -2487,7 +2489,7 @@ instance ExactPrint (TyFamInstDecl GhcPs) where
-- ---------------------------------------------------------------------
-instance ExactPrint (LocatedP OverlapMode) where
+instance ExactPrint (LOverlapMode (GhcPass p)) where
getAnnotationEntry = entryFromLocatedA
setAnnotationAnchor = setAnchorAn
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
=====================================
@@ -801,6 +801,15 @@ renameInstD (DataFamInstD{dfid_inst = d}) = do
d' <- renameDataFamInstD d
return (DataFamInstD{dfid_ext = noExtField, dfid_inst = d'})
+convert_overlap_mode :: OverlapMode (GhcPass p) -> OverlapMode DocNameI
+convert_overlap_mode = \case
+ NoOverlap _ -> NoOverlap noExtField
+ Overlappable _ -> Overlappable noExtField
+ Overlapping _ -> Overlapping noExtField
+ Overlaps _ -> Overlaps noExtField
+ Incoherent _ -> Incoherent noExtField
+ XOverlapMode (NonCanonical _) -> XOverlapMode NonCanon
+
renameDerivD :: DerivDecl GhcRn -> RnM (DerivDecl DocNameI)
renameDerivD
( DerivDecl
@@ -816,9 +825,9 @@ renameDerivD
{ deriv_ext = noExtField
, deriv_type = ty'
, deriv_strategy = strat'
- , deriv_overlap_mode = omode
+ , deriv_overlap_mode = fmap (fmap convert_overlap_mode) omode
}
- )
+ )
renameDerivStrategy :: DerivStrategy GhcRn -> RnM (DerivStrategy DocNameI)
renameDerivStrategy (StockStrategy a) = pure (StockStrategy a)
@@ -841,7 +850,7 @@ renameClsInstD
return
( ClsInstDecl
{ cid_ext = noExtField
- , cid_overlap_mode = omode
+ , cid_overlap_mode = fmap (fmap convert_overlap_mode) omode
, cid_poly_ty = ltype'
, cid_binds = []
, cid_sigs = []
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -972,6 +972,15 @@ type instance XCFunDep DocNameI = NoExtField
type instance XCTyFamInstDecl DocNameI = NoExtField
+type instance Anno (OverlapMode DocNameI) = SrcSpanAnnP
+type instance XNoOverlap DocNameI = NoExtField
+type instance XOverlappable DocNameI = NoExtField
+type instance XOverlapping DocNameI = NoExtField
+type instance XOverlaps DocNameI = NoExtField
+type instance XIncoherent DocNameI = NoExtField
+type instance XXOverlapMode DocNameI = NonCanon
+data NonCanon = NonCanon -- no longer need the source text :relieved:
+
-----------------------------------------------------------------------------
-- * NFData instances for GHC types
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/099159094092132eca2e32569d66c9f42871d899
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/099159094092132eca2e32569d66c9f42871d899
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/20241021/b02a222e/attachment-0001.html>
More information about the ghc-commits
mailing list