recursion-ninja pushed to branch wip/26699 at Glasgow Haskell Compiler / GHC

Commits:

26 changed files:

Changes:

  • compiler/GHC/Core/InstEnv.hs
    ... ... @@ -10,7 +10,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv.
    10 10 
     module GHC.Core.InstEnv (
    11 11 
             DFunId, InstMatch, ClsInstLookupResult,
    12 12 
             CanonicalEvidence(..), PotentialUnifiers(..), getCoherentUnifiers, nullUnifiers,
    13 
    -        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
    13 
    +        OverlapFlag(..), OverlapMode(..),
    14 14 
             ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprDFunId, pprInstances,
    15 15 
             instanceWarning, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst,
    16 16 
             instanceDFunId, updateClsInstDFuns, updateClsInstDFun,
    ... ... @@ -40,6 +40,7 @@ import GHC.Core.RoughMap
    40 40 
     import GHC.Core.Class
    41 41 
     import GHC.Core.Unify
    42 42 
     import GHC.Core.FVs( orphNamesOfTypes, orphNamesOfType )
    43 
    +import GHC.Hs.Decls.Overlap
    43 44 
     import GHC.Hs.Extension
    44 45
    45 46 
     import GHC.Unit.Module.Env
    ... ... @@ -50,7 +51,6 @@ import GHC.Types.Unique.DSet
    50 51 
     import GHC.Types.Var.Set
    51 52 
     import GHC.Types.Name
    52 53 
     import GHC.Types.Name.Set
    53 
    -import GHC.Types.Basic
    54 54 
     import GHC.Types.Id
    55 55 
     import GHC.Generics (Generic)
    56 56 
     import Data.List.NonEmpty ( NonEmpty (..), nonEmpty )

  • compiler/GHC/Hs/Decls.hs
    ... ... @@ -100,13 +100,17 @@ module GHC.Hs.Decls (
    100 100 
     -- friends:
    101 101 
     import GHC.Prelude
    102 102
    103 
    +import Language.Haskell.Syntax.Binds
    103 104 
     import Language.Haskell.Syntax.Decls
    105 
    +import Language.Haskell.Syntax.Decls.Overlap (OverlapMode(..))
    104 106 
     import Language.Haskell.Syntax.Extension
    105 107
    106 
    -import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprUntypedSplice )
    108 
    +import {-# SOURCE #-} GHC.Hs.Expr (pprExpr, pprUntypedSplice)
    107 109 
             -- Because Expr imports Decls via HsBracket
    108 110
    109 
    -import GHC.Hs.Binds
    111 
    +import GHC.Hs.Binds (ActivationAnn(..),
    112 
    +                     emptyValBindsIn, emptyValBindsOut, isEmptyValBinds,
    113 
    +                     plusHsValBinds, pprDeclList, pprLHsBindsForUser)
    110 114 
     import GHC.Hs.Type
    111 115 
     import GHC.Hs.Doc
    112 116 
     import GHC.Types.Basic
    ... ... @@ -1061,7 +1065,7 @@ ppDerivStrategy mb =
    1061 1065 
         Nothing       -> empty
    1062 1066 
         Just (L _ ds) -> ppr ds
    1063 1067
    1064 
    -ppOverlapPragma :: Maybe (LocatedP OverlapMode) -> SDoc
    1068 
    +ppOverlapPragma :: Maybe (LocatedP (OverlapMode (GhcPass p))) -> SDoc
    1065 1069 
     ppOverlapPragma mb =
    1066 1070 
       case mb of
    1067 1071 
         Nothing           -> empty
    ... ... @@ -1489,7 +1493,7 @@ type instance Anno (ClsInstDecl (GhcPass p)) = SrcSpanAnnA
    1489 1493 
     type instance Anno (InstDecl (GhcPass p)) = SrcSpanAnnA
    1490 1494 
     type instance Anno (DocDecl (GhcPass p)) = SrcSpanAnnA
    1491 1495 
     type instance Anno (DerivDecl (GhcPass p)) = SrcSpanAnnA
    1492 
    -type instance Anno OverlapMode = SrcSpanAnnP
    1496 
    +type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnP
    1493 1497 
     type instance Anno (DerivStrategy (GhcPass p)) = EpAnnCO
    1494 1498 
     type instance Anno (DefaultDecl (GhcPass p)) = SrcSpanAnnA
    1495 1499 
     type instance Anno (ForeignDecl (GhcPass p)) = SrcSpanAnnA

  • compiler/GHC/Hs/Decls/Overlap.hs
    1 
    +{-# LANGUAGE LambdaCase #-}
    2 
    +{-# LANGUAGE TypeFamilies #-}
    3 
    +{-# LANGUAGE UndecidableInstances #-} -- XOverlapMode, XXOverlapMode
    4 
    +
    5 
    +{-# OPTIONS_GHC -fno-warn-orphans #-}
    6 
    +{- Necessary for the following instances:
    7 
    +  * (type class):  Binary OverlapMode
    8 
    +  * (type family): XOverlapMode  (GhcPass p)
    9 
    +  * (type family): XXOverlapMode (GhcPass p)
    10 
    +-}
    11 
    +
    12 
    +{- |
    13 
    +Data-types describing the overlap annotations for instances as well as
    14 
    +interpreting the instances usage within the Safe Haskell context.
    15 
    +-}
    16 
    +module GHC.Hs.Decls.Overlap (
    17 
    +        -- * OverlapFlag
    18 
    +        -- ** Data-type
    19 
    +        OverlapFlag(..),
    20 
    +
    21 
    +        -- * OverlapMode
    22 
    +        -- ** Data-type
    23 
    +        OverlapMode(..),
    24 
    +        -- ** Queries
    25 
    +        hasOverlappableFlag,
    26 
    +        hasOverlappingFlag,
    27 
    +        hasIncoherentFlag,
    28 
    +        hasNonCanonicalFlag,
    29 
    +    ) where
    30 
    +
    31 
    +import GHC.Prelude
    32 
    +
    33 
    +import GHC.Hs.Extension
    34 
    +
    35 
    +import Language.Haskell.Syntax.Decls.Overlap
    36 
    +import Language.Haskell.Syntax.Extension
    37 
    +
    38 
    +import GHC.Types.SourceText
    39 
    +import GHC.Utils.Binary
    40 
    +import GHC.Utils.Outputable
    41 
    +
    42 
    +import Control.DeepSeq (NFData(..))
    43 
    +
    44 
    +{-
    45 
    +************************************************************************
    46 
    +*                                                                      *
    47 
    +                Instance overlap flag
    48 
    +*                                                                      *
    49 
    +************************************************************************
    50 
    +-}
    51 
    +
    52 
    +-- | The semantics allowed for overlapping instances for a particular
    53 
    +-- instance. See Note [Safe Haskell isSafeOverlap] in GHC.Core.InstEnv for a
    54 
    +-- explanation of the `isSafeOverlap` field.
    55 
    +data OverlapFlag = OverlapFlag
    56 
    +  { isSafeOverlap :: Bool
    57 
    +  , overlapMode   :: OverlapMode GhcTc
    58 
    +  } deriving (Eq)
    59 
    +
    60 
    +instance Binary OverlapFlag where
    61 
    +    put_ bh flag = do put_ bh (overlapMode flag)
    62 
    +                      put_ bh (isSafeOverlap flag)
    63 
    +    get bh = do
    64 
    +        h <- get bh
    65 
    +        b <- get bh
    66 
    +        return OverlapFlag { isSafeOverlap = b, overlapMode = h }
    67 
    +
    68 
    +instance NFData OverlapFlag where
    69 
    +    rnf (OverlapFlag mode safe) = rnf mode `seq` rnf safe
    70 
    +
    71 
    +instance Outputable OverlapFlag where
    72 
    +    ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
    73 
    +
    74 
    +type instance XOverlapMode  (GhcPass _) = SourceText
    75 
    +
    76 
    +type instance XXOverlapMode (GhcPass _) = DataConCantHappen
    77 
    +
    78 
    +instance NFData (OverlapMode (GhcPass p)) where
    79 
    +    rnf = \case
    80 
    +        NoOverlap    s -> rnf s
    81 
    +        Overlappable s -> rnf s
    82 
    +        Overlapping  s -> rnf s
    83 
    +        Overlaps     s -> rnf s
    84 
    +        Incoherent   s -> rnf s
    85 
    +        NonCanonical s -> rnf s
    86 
    +
    87 
    +instance Binary (OverlapMode (GhcPass p)) where
    88 
    +    put_ bh = \case
    89 
    +        NoOverlap    s -> putByte bh 0 >> put_ bh s
    90 
    +        Overlaps     s -> putByte bh 1 >> put_ bh s
    91 
    +        Incoherent   s -> putByte bh 2 >> put_ bh s
    92 
    +        Overlapping  s -> putByte bh 3 >> put_ bh s
    93 
    +        Overlappable s -> putByte bh 4 >> put_ bh s
    94 
    +        NonCanonical s -> putByte bh 5 >> put_ bh s
    95 
    +
    96 
    +    get bh = do
    97 
    +        h <- getByte bh
    98 
    +        case h of
    99 
    +            0 -> get bh >>= \s -> return $ NoOverlap    s
    100 
    +            1 -> get bh >>= \s -> return $ Overlaps     s
    101 
    +            2 -> get bh >>= \s -> return $ Incoherent   s
    102 
    +            3 -> get bh >>= \s -> return $ Overlapping  s
    103 
    +            4 -> get bh >>= \s -> return $ Overlappable s
    104 
    +            _ -> get bh >>= \s -> return $ NonCanonical s
    105 
    +
    106 
    +pprSafeOverlap :: Bool -> SDoc
    107 
    +pprSafeOverlap True  = text "[safe]"
    108 
    +pprSafeOverlap False = empty

  • compiler/GHC/Hs/Instances.hs
    ... ... @@ -33,6 +33,7 @@ import GHC.Types.Name.Reader (WithUserRdr(..))
    33 33 
     import GHC.Types.InlinePragma (ActivationGhc)
    34 34 
     import GHC.Data.BooleanFormula (BooleanFormula(..))
    35 35 
     import Language.Haskell.Syntax.Decls
    36 
    +import Language.Haskell.Syntax.Decls.Overlap (OverlapMode(..))
    36 37 
     import Language.Haskell.Syntax.Extension (Anno)
    37 38 
     import Language.Haskell.Syntax.Binds.InlinePragma (ActivationX(..), InlinePragma(..))
    38 39
    ... ... @@ -642,3 +643,8 @@ deriving instance Data ActivationGhc
    642 643 
     deriving instance Data (InlinePragma GhcPs)
    643 644 
     deriving instance Data (InlinePragma GhcRn)
    644 645 
     deriving instance Data (InlinePragma GhcTc)
    646 
    +
    647 
    +-- deriving instance Data (OverlapMode p)
    648 
    +deriving instance Data (OverlapMode GhcPs)
    649 
    +deriving instance Data (OverlapMode GhcRn)
    650 
    +deriving instance Data (OverlapMode GhcTc)

  • compiler/GHC/HsToCore/Quote.hs
    ... ... @@ -37,6 +37,7 @@ import GHC.HsToCore.Binds
    37 37 
     import qualified GHC.Boot.TH.Syntax as TH
    38 38
    39 39 
     import GHC.Hs
    40 
    +import GHC.Hs.Decls.Overlap ( OverlapMode(..) )
    40 41
    41 42 
     import GHC.Tc.Utils.TcType
    42 43 
     import GHC.Tc.Types.Evidence
    ... ... @@ -68,7 +69,6 @@ import qualified GHC.Data.List.NonEmpty as NE
    68 69
    69 70 
     import GHC.Types.SrcLoc as SrcLoc
    70 71 
     import GHC.Types.Unique
    71 
    -import GHC.Types.Basic
    72 72 
     import GHC.Types.ForeignCall
    73 73 
     import GHC.Types.Var
    74 74 
     import GHC.Types.Id
    ... ... @@ -2731,7 +2731,7 @@ repNewtypeStrategy = rep2 newtypeStrategyName []
    2731 2731 
     repViaStrategy :: Core (M TH.Type) -> MetaM (Core (M TH.DerivStrategy))
    2732 2732 
     repViaStrategy (MkC t) = rep2 viaStrategyName [t]
    2733 2733
    2734 
    -repOverlap :: Maybe OverlapMode -> MetaM (Core (Maybe TH.Overlap))
    2734 
    +repOverlap :: Maybe (OverlapMode GhcRn) -> MetaM (Core (Maybe TH.Overlap))
    2735 2735 
     repOverlap mb =
    2736 2736 
       case mb of
    2737 2737 
         Nothing -> nothing

  • compiler/GHC/Iface/Ext/Ast.hs
    ... ... @@ -1718,7 +1718,7 @@ instance ToHie (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where
    1718 1718 
           NewtypeStrategy _ -> []
    1719 1719 
           ViaStrategy s -> [ toHie (TS (ResolvedScopes [sc]) s) ]
    1720 1720
    1721 
    -instance ToHie (LocatedP OverlapMode) where
    1721 
    +instance ToHie (LocatedP (OverlapMode GhcRn)) where
    1722 1722 
       toHie (L span _) = locOnly (locA span)
    1723 1723
    1724 1724 
     instance ToHie (LocatedA (ConDecl GhcRn)) where

  • compiler/GHC/Iface/Syntax.hs
    ... ... @@ -85,6 +85,7 @@ import GHC.Builtin.Types ( constraintKindTyConName )
    85 85 
     import GHC.Stg.EnforceEpt.TagSig
    86 86 
     import GHC.Parser.Annotation (noLocA)
    87 87 
     import GHC.Hs.Extension ( GhcRn )
    88 
    +import GHC.Hs.Decls.Overlap ( OverlapFlag )
    88 89 
     import GHC.Hs.Doc ( WithHsDocIdentifiers(..) )
    89 90
    90 91 
     import GHC.Utils.Lexeme (isLexSym)

  • compiler/GHC/Parser.y
    ... ... @@ -43,6 +43,7 @@ import qualified Data.List.NonEmpty as NE
    43 43 
     import qualified Prelude -- for happy-generated code
    44 44
    45 45 
     import GHC.Hs
    46 
    +import GHC.Hs.Decls.Overlap ( OverlapMode(..) )
    46 47
    47 48 
     import GHC.Driver.Backpack.Syntax
    48 49
    ... ... @@ -1443,7 +1444,7 @@ inst_decl :: { LInstDecl GhcPs }
    1443 1444 
                                        (fmap reverse $7)
    1444 1445 
                                 (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}}
    1445 1446
    1446 
    -overlap_pragma :: { Maybe (LocatedP OverlapMode) }
    1447 
    +overlap_pragma :: { Maybe (LocatedP (OverlapMode GhcPs)) }
    1447 1448 
       : '{-# OVERLAPPABLE'    '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))
    1448 1449 
                                            (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }
    1449 1450 
       | '{-# OVERLAPPING'     '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1)))

  • compiler/GHC/Rename/Module.hs
    1 
    +{-# LANGUAGE LambdaCase          #-}
    1 2 
     {-# LANGUAGE MultiWayIf          #-}
    2 3 
     {-# LANGUAGE RecursiveDo         #-}
    3 4 
     {-# LANGUAGE TypeFamilies        #-}
    ... ... @@ -21,6 +22,7 @@ import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr )
    21 22 
     import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls )
    22 23
    23 24 
     import GHC.Hs
    25 
    +import GHC.Hs.Decls.Overlap ( OverlapMode(..) )
    24 26
    25 27 
     import GHC.Rename.HsType
    26 28 
     import GHC.Rename.Bind
    ... ... @@ -582,7 +584,7 @@ rnClsInstDecl :: ClsInstDecl GhcPs -> RnM (ClsInstDecl GhcRn, FreeVars)
    582 584 
     rnClsInstDecl (ClsInstDecl { cid_ext = (inst_warn_ps, _, _)
    583 585 
                                , cid_poly_ty = inst_ty, cid_binds = mbinds
    584 586 
                                , cid_sigs = uprags, cid_tyfam_insts = ats
    585 
    -                           , cid_overlap_mode = oflag
    587 
    +                           , cid_overlap_mode = omode
    586 588 
                                , cid_datafam_insts = adts })
    587 589 
       = do { rec { let ctxt = ClassInstanceCtx head_ty'
    588 590 
                  ; checkInferredVars ctxt inst_ty
    ... ... @@ -656,13 +658,14 @@ rnClsInstDecl (ClsInstDecl { cid_ext = (inst_warn_ps, _, _)
    656 658 
                        ; (adts', adt_fvs) <- rnATInstDecls rnDataFamInstDecl cls ktv_names adts
    657 659 
                        ; return ( (ats', adts'), at_fvs `plusFV` adt_fvs) }
    658 660
    661 
    +       ; let omode'  = rnOverlapMode omode
    659 662 
            ; let all_fvs = meth_fvs `plusFV` more_fvs
    660 663 
                                     `plusFV` inst_fvs
    661 664 
            ; inst_warn_rn <- mapM rnLWarningTxt inst_warn_ps
    662 665 
            ; return (ClsInstDecl { cid_ext = inst_warn_rn
    663 666 
                                  , cid_poly_ty = inst_ty', cid_binds = mbinds'
    664 667 
                                  , cid_sigs = uprags', cid_tyfam_insts = ats'
    665 
    -                             , cid_overlap_mode = oflag
    668 
    +                             , cid_overlap_mode = omode'
    666 669 
                                  , cid_datafam_insts = adts' },
    667 670 
                      all_fvs) }
    668 671 
                  -- We return the renamed associated data type declarations so
    ... ... @@ -685,6 +688,18 @@ rnClsInstDecl (ClsInstDecl { cid_ext = (inst_warn_ps, _, _)
    685 688 
           addErrAt l $ TcRnWithHsDocContext ctxt err_msg
    686 689 
           pure $ mkUnboundName (mkTcOccFS (fsLit "<class>"))
    687 690
    691 
    +rnOverlapMode :: Maybe (XRec GhcPs (OverlapMode GhcPs))
    692 
    +              -> Maybe (XRec GhcRn (OverlapMode GhcRn))
    693 
    +rnOverlapMode =
    694 
    +    let advancePass = \case
    695 
    +          NoOverlap    s -> NoOverlap    s
    696 
    +          Overlappable s -> Overlappable s
    697 
    +          Overlapping  s -> Overlapping  s
    698 
    +          Overlaps     s -> Overlaps     s
    699 
    +          Incoherent   s -> Incoherent   s
    700 
    +          NonCanonical s -> NonCanonical s
    701 
    +    in  fmap (fmap advancePass)
    702 
    +
    688 703 
     rnFamEqn :: HsDocContext
    689 704 
              -> AssocTyFamInfo
    690 705 
              -> FamEqn GhcPs rhs
    ... ... @@ -1167,7 +1182,8 @@ rnSrcDerivDecl (DerivDecl (inst_warn_ps, ann) ty mds overlap)
    1167 1182 
                NFC_StandaloneDerivedInstanceHead
    1168 1183 
                (getLHsInstDeclHead $ dropWildCards ty')
    1169 1184 
            ; inst_warn_rn <- mapM rnLWarningTxt inst_warn_ps
    1170 
    -       ; return (DerivDecl (inst_warn_rn, ann) ty' mds' overlap, fvs) }
    1185 
    +       ; let overlap' = rnOverlapMode overlap
    1186 
    +       ; return (DerivDecl (inst_warn_rn, ann) ty' mds' overlap', fvs) }
    1171 1187 
       where
    1172 1188 
         ctxt    = DerivDeclCtx
    1173 1189 
         nowc_ty = dropWildCards ty

  • compiler/GHC/Tc/Deriv.hs
    ... ... @@ -763,7 +763,7 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo
    763 763 
              then do warnUselessTypeable
    764 764 
                      return Nothing
    765 765 
              else do early_deriv_spec <-
    766 
    -                   mkEqnHelp (fmap unLoc overlap_mode)
    766 
    +                   mkEqnHelp (fmap (tcOverlapMode . unLoc) overlap_mode)
    767 767 
                                  tvs' cls inst_tys'
    768 768 
                                  deriv_ctxt' mb_deriv_strat'
    769 769 
                                  (fmap unLoc warn)
    ... ... @@ -773,6 +773,16 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo
    773 773 
                        early_deriv_spec
    774 774 
                      pure (Just early_deriv_spec) }
    775 775
    776 
    +
    777 
    +tcOverlapMode :: OverlapMode GhcRn -> OverlapMode GhcTc
    778 
    +tcOverlapMode = \case
    779 
    +  NoOverlap    s -> NoOverlap    s
    780 
    +  Overlappable s -> Overlappable s
    781 
    +  Overlapping  s -> Overlapping  s
    782 
    +  Overlaps     s -> Overlaps     s
    783 
    +  Incoherent   s -> Incoherent   s
    784 
    +  NonCanonical s -> NonCanonical s
    785 
    +
    776 786 
     -- Typecheck the type in a standalone deriving declaration.
    777 787 
     --
    778 788 
     -- This may appear dense, but it's mostly huffing and puffing to recognize
    ... ... @@ -1218,7 +1228,7 @@ instance (at least from the user's perspective), the amount of engineering
    1218 1228 
     required to obtain the latter instance just isn't worth it.
    1219 1229 
     -}
    1220 1230
    1221 
    -mkEqnHelp :: Maybe OverlapMode
    1231 
    +mkEqnHelp :: Maybe (OverlapMode GhcTc)
    1222 1232 
               -> [TyVar]
    1223 1233 
               -> Class -> [Type]
    1224 1234 
               -> DerivContext

  • compiler/GHC/Tc/Deriv/Utils.hs
    ... ... @@ -112,7 +112,7 @@ mkDerivOrigin standalone = DerivOrigin standalone
    112 112 
     -- determining what its @EarlyDerivSpec@ should be.
    113 113 
     -- See @Note [DerivEnv and DerivSpecMechanism]@.
    114 114 
     data DerivEnv = DerivEnv
    115 
    -  { denv_overlap_mode :: Maybe OverlapMode
    115 
    +  { denv_overlap_mode :: Maybe (OverlapMode GhcTc)
    116 116 
         -- ^ Is this an overlapping instance?
    117 117 
       , denv_tvs          :: [TyVar]
    118 118 
         -- ^ Universally quantified type variables in the instance. If the
    ... ... @@ -167,7 +167,7 @@ data DerivSpec theta = DS { ds_loc :: SrcSpan
    167 167 
                               , ds_tys                 :: [Type]
    168 168 
                               , ds_skol_info           :: SkolemInfo
    169 169 
                               , ds_user_ctxt           :: UserTypeCtxt
    170 
    -                          , ds_overlap             :: Maybe OverlapMode
    170 
    +                          , ds_overlap             :: Maybe (OverlapMode GhcTc)
    171 171 
                               , ds_standalone_wildcard :: Maybe SrcSpan
    172 172 
                                   -- See Note [Inferring the instance context]
    173 173 
                                   -- in GHC.Tc.Deriv.Infer

  • compiler/GHC/Tc/Errors/Ppr.hs
    ... ... @@ -70,6 +70,7 @@ import GHC.CoreToIface
    70 70 
     import GHC.Driver.Flags
    71 71 
     import GHC.Driver.Backend
    72 72 
     import GHC.Hs hiding (HoleError)
    73 
    +import GHC.Hs.Decls.Overlap
    73 74
    74 75 
     import GHC.Tc.Errors.Types
    75 76 
     import GHC.Tc.Errors.Types.PromotionErr (pprTermLevelUseCtxt)

  • compiler/GHC/Tc/Utils/Instantiate.hs
    ... ... @@ -912,7 +912,7 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity
    912 912 
     ************************************************************************
    913 913 
     -}
    914 914
    915 
    -getOverlapFlag :: Maybe OverlapMode   -- User pragma if any
    915 
    +getOverlapFlag :: Maybe (OverlapMode (GhcPass p)) -- User pragma if any
    916 916 
                    -> TcM OverlapFlag
    917 917 
     -- Construct the OverlapFlag from the global module flags,
    918 918 
     -- but if the overlap_mode argument is (Just m),
    ... ... @@ -946,18 +946,25 @@ getOverlapFlag overlap_mode_prag
    946 946 
                   -- See GHC.Core.InstEnv Note [Coherence and specialisation: overview]
    947 947 
                   final_overlap_mode
    948 948 
                     | Incoherent s <- overlap_mode
    949 
    -                , noncanonical_incoherence       = NonCanonical s
    950 
    -                | otherwise                      = overlap_mode
    949 
    +                , noncanonical_incoherence    = NonCanonical s
    950 
    +                | otherwise                   = overlap_mode
    951 951
    952 
    -        ; return (OverlapFlag { isSafeOverlap = safeLanguageOn dflags
    953 
    -                              , overlapMode   = final_overlap_mode }) }
    952 
    +              final_overlap_flag = OverlapFlag (safeLanguageOn dflags) $
    953 
    +                case final_overlap_mode of
    954 
    +                  NoOverlap    s -> NoOverlap    s
    955 
    +                  Overlappable s -> Overlappable s
    956 
    +                  Overlapping  s -> Overlapping  s
    957 
    +                  Overlaps     s -> Overlaps     s
    958 
    +                  Incoherent   s -> Incoherent   s
    959 
    +                  NonCanonical s -> NonCanonical s
    954 960
    961 
    +        ; return $ final_overlap_flag }
    955 962
    956 963 
     tcGetInsts :: TcM [ClsInst]
    957 964 
     -- Gets the local class instances.
    958 965 
     tcGetInsts = fmap tcg_insts getGblEnv
    959 966
    960 
    -newClsInst :: Maybe OverlapMode   -- User pragma
    967 
    +newClsInst :: Maybe (OverlapMode (GhcPass p))   -- User pragma
    961 968 
                -> Name -> [TyVar] -> ThetaType
    962 969 
                -> Class -> [Type] -> Maybe (WarningTxt GhcRn) -> TcM ClsInst
    963 970 
     newClsInst overlap_mode dfun_name tvs theta clas tys warn

  • compiler/GHC/ThToHs.hs
    ... ... @@ -38,6 +38,7 @@ import GHC.Core.Type as Hs
    38 38 
     import qualified GHC.Core.Coercion as Coercion ( Role(..) )
    39 39 
     import GHC.Builtin.Types
    40 40 
     import GHC.Builtin.Types.Prim( fUNTyCon )
    41 
    +import GHC.Hs.Decls.Overlap as Hs
    41 42 
     import GHC.Types.Basic as Hs
    42 43 
     import GHC.Types.InlinePragma as Hs
    43 44 
     import GHC.Types.ForeignCall

  • compiler/GHC/Types/Basic.hs
    ... ... @@ -14,7 +14,14 @@ types that
    14 14 
     \end{itemize}
    15 15 
     -}
    16 16
    17 
    -{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable PromotionFlag, Binary PromotionFlag, Outputable Boxity, Binay Boxity
    17 
    +{-# OPTIONS_GHC -Wno-orphans #-}
    18 
    +{-
    19 
    +Above flag is necessary for these instances:
    20 
    +  * Binary Boxity
    21 
    +  * Binary PromotionFlag
    22 
    +  * Outputable Boxity
    23 
    +  * Outputable PromotionFlag
    24 
    +-}
    18 25 
     {-# LANGUAGE DerivingVia #-}
    19 26
    20 27 
     module GHC.Types.Basic (
    ... ... @@ -40,9 +47,6 @@ module GHC.Types.Basic (
    40 47
    41 48 
             TopLevelFlag(..), isTopLevel, isNotTopLevel,
    42 49
    43 
    -        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
    44 
    -        hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag,
    45 
    -
    46 50 
             Boxity(..), isBoxed,
    47 51
    48 52 
             CbvMark(..), isMarkedCbv,
    ... ... @@ -107,13 +111,13 @@ import GHC.Utils.Outputable
    107 111 
     import GHC.Utils.Panic
    108 112 
     import GHC.Utils.Binary
    109 113 
     import GHC.Types.Arity
    110 
    -import GHC.Types.SourceText
    114 
    +
    111 115 
     import qualified GHC.LanguageExtensions as LangExt
    112 116 
     import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted)
    113 117 
     import {-# SOURCE #-} Language.Haskell.Syntax.Expr (HsDoFlavour)
    114 118
    115 119 
     import Language.Haskell.Syntax.Basic
    116 
    -import Language.Haskell.Syntax.ImpExp
    120 
    +import Language.Haskell.Syntax.ImpExp (ImportDeclLevel(..), ImportDeclLevelStyle(..))
    117 121
    118 122 
     import Control.DeepSeq ( NFData(..) )
    119 123 
     import Data.Data
    ... ... @@ -592,178 +596,6 @@ of whether we should do pattern-match checks; see the calls of the requiresPMC
    592 596 
     function (e.g. isMatchContextPmChecked and needToRunPmCheck in GHC.HsToCore.Pmc.Utils).
    593 597 
     -}
    594 598
    595 
    -{-
    596 
    -************************************************************************
    597 
    -*                                                                      *
    598 
    -                Instance overlap flag
    599 
    -*                                                                      *
    600 
    -************************************************************************
    601 
    --}
    602 
    -
    603 
    --- | The semantics allowed for overlapping instances for a particular
    604 
    --- instance. See Note [Safe Haskell isSafeOverlap] in GHC.Core.InstEnv for a
    605 
    --- explanation of the `isSafeOverlap` field.
    606 
    ---
    607 
    -
    608 
    -data OverlapFlag = OverlapFlag
    609 
    -  { overlapMode   :: OverlapMode
    610 
    -  , isSafeOverlap :: Bool
    611 
    -  } deriving (Eq, Data)
    612 
    -
    613 
    -setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
    614 
    -setOverlapModeMaybe f Nothing  = f
    615 
    -setOverlapModeMaybe f (Just m) = f { overlapMode = m }
    616 
    -
    617 
    -hasIncoherentFlag :: OverlapMode -> Bool
    618 
    -hasIncoherentFlag mode =
    619 
    -  case mode of
    620 
    -    Incoherent   _ -> True
    621 
    -    NonCanonical _ -> True
    622 
    -    _              -> False
    623 
    -
    624 
    -hasOverlappableFlag :: OverlapMode -> Bool
    625 
    -hasOverlappableFlag mode =
    626 
    -  case mode of
    627 
    -    Overlappable _ -> True
    628 
    -    Overlaps     _ -> True
    629 
    -    Incoherent   _ -> True
    630 
    -    NonCanonical _ -> True
    631 
    -    _              -> False
    632 
    -
    633 
    -hasOverlappingFlag :: OverlapMode -> Bool
    634 
    -hasOverlappingFlag mode =
    635 
    -  case mode of
    636 
    -    Overlapping  _ -> True
    637 
    -    Overlaps     _ -> True
    638 
    -    Incoherent   _ -> True
    639 
    -    NonCanonical _ -> True
    640 
    -    _              -> False
    641 
    -
    642 
    -hasNonCanonicalFlag :: OverlapMode -> Bool
    643 
    -hasNonCanonicalFlag = \case
    644 
    -  NonCanonical{} -> True
    645 
    -  _              -> False
    646 
    -
    647 
    -data OverlapMode  -- See Note [Rules for instance lookup] in GHC.Core.InstEnv
    648 
    -  = NoOverlap SourceText
    649 
    -                  -- See Note [Pragma source text]
    650 
    -    -- ^ This instance must not overlap another `NoOverlap` instance.
    651 
    -    -- However, it may be overlapped by `Overlapping` instances,
    652 
    -    -- and it may overlap `Overlappable` instances.
    653 
    -
    654 
    -
    655 
    -  | Overlappable SourceText
    656 
    -                  -- See Note [Pragma source text]
    657 
    -    -- ^ Silently ignore this instance if you find a
    658 
    -    -- more specific one that matches the constraint
    659 
    -    -- you are trying to resolve
    660 
    -    --
    661 
    -    -- Example: constraint (Foo [Int])
    662 
    -    --   instance                      Foo [Int]
    663 
    -    --   instance {-# OVERLAPPABLE #-} Foo [a]
    664 
    -    --
    665 
    -    -- Since the second instance has the Overlappable flag,
    666 
    -    -- the first instance will be chosen (otherwise
    667 
    -    -- its ambiguous which to choose)
    668 
    -
    669 
    -
    670 
    -  | Overlapping SourceText
    671 
    -                  -- See Note [Pragma source text]
    672 
    -    -- ^ Silently ignore any more general instances that may be
    673 
    -    --   used to solve the constraint.
    674 
    -    --
    675 
    -    -- Example: constraint (Foo [Int])
    676 
    -    --   instance {-# OVERLAPPING #-} Foo [Int]
    677 
    -    --   instance                     Foo [a]
    678 
    -    --
    679 
    -    -- Since the first instance has the Overlapping flag,
    680 
    -    -- the second---more general---instance will be ignored (otherwise
    681 
    -    -- it is ambiguous which to choose)
    682 
    -
    683 
    -
    684 
    -  | Overlaps SourceText
    685 
    -                  -- See Note [Pragma source text]
    686 
    -    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
    687 
    -
    688 
    -  | Incoherent SourceText
    689 
    -                  -- See Note [Pragma source text]
    690 
    -    -- ^ Behave like Overlappable and Overlapping, and in addition pick
    691 
    -    -- an arbitrary one if there are multiple matching candidates, and
    692 
    -    -- don't worry about later instantiation
    693 
    -    --
    694 
    -    -- Example: constraint (Foo [b])
    695 
    -    -- instance {-# INCOHERENT -} Foo [Int]
    696 
    -    -- instance                   Foo [a]
    697 
    -    -- Without the Incoherent flag, we'd complain that
    698 
    -    -- instantiating 'b' would change which instance
    699 
    -    -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv"
    700 
    -
    701 
    -  | NonCanonical SourceText
    702 
    -    -- ^ Behave like Incoherent, but the instance choice is observable
    703 
    -    -- by the program behaviour. See Note [Coherence and specialisation: overview].
    704 
    -    --
    705 
    -    -- We don't have surface syntax for the distinction between
    706 
    -    -- Incoherent and NonCanonical instances; instead, the flag
    707 
    -    -- `-f{no-}specialise-incoherents` (on by default) controls
    708 
    -    -- whether `INCOHERENT` instances are regarded as Incoherent or
    709 
    -    -- NonCanonical.
    710 
    -
    711 
    -  deriving (Eq, Data)
    712 
    -
    713 
    -
    714 
    -instance Outputable OverlapFlag where
    715 
    -   ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
    716 
    -
    717 
    -instance NFData OverlapFlag where
    718 
    -  rnf (OverlapFlag mode safe) = rnf mode `seq` rnf safe
    719 
    -
    720 
    -instance Outputable OverlapMode where
    721 
    -   ppr (NoOverlap    _) = empty
    722 
    -   ppr (Overlappable _) = text "[overlappable]"
    723 
    -   ppr (Overlapping  _) = text "[overlapping]"
    724 
    -   ppr (Overlaps     _) = text "[overlap ok]"
    725 
    -   ppr (Incoherent   _) = text "[incoherent]"
    726 
    -   ppr (NonCanonical _) = text "[noncanonical]"
    727 
    -
    728 
    -instance NFData OverlapMode where
    729 
    -  rnf (NoOverlap s) = rnf s
    730 
    -  rnf (Overlappable s) = rnf s
    731 
    -  rnf (Overlapping s) = rnf s
    732 
    -  rnf (Overlaps s) = rnf s
    733 
    -  rnf (Incoherent s) = rnf s
    734 
    -  rnf (NonCanonical s) = rnf s
    735 
    -
    736 
    -instance Binary OverlapMode where
    737 
    -    put_ bh (NoOverlap    s) = putByte bh 0 >> put_ bh s
    738 
    -    put_ bh (Overlaps     s) = putByte bh 1 >> put_ bh s
    739 
    -    put_ bh (Incoherent   s) = putByte bh 2 >> put_ bh s
    740 
    -    put_ bh (Overlapping  s) = putByte bh 3 >> put_ bh s
    741 
    -    put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s
    742 
    -    put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s
    743 
    -    get bh = do
    744 
    -        h <- getByte bh
    745 
    -        case h of
    746 
    -            0 -> (get bh) >>= \s -> return $ NoOverlap s
    747 
    -            1 -> (get bh) >>= \s -> return $ Overlaps s
    748 
    -            2 -> (get bh) >>= \s -> return $ Incoherent s
    749 
    -            3 -> (get bh) >>= \s -> return $ Overlapping s
    750 
    -            4 -> (get bh) >>= \s -> return $ Overlappable s
    751 
    -            5 -> (get bh) >>= \s -> return $ NonCanonical s
    752 
    -            _ -> panic ("get OverlapMode" ++ show h)
    753 
    -
    754 
    -
    755 
    -instance Binary OverlapFlag where
    756 
    -    put_ bh flag = do put_ bh (overlapMode flag)
    757 
    -                      put_ bh (isSafeOverlap flag)
    758 
    -    get bh = do
    759 
    -        h <- get bh
    760 
    -        b <- get bh
    761 
    -        return OverlapFlag { overlapMode = h, isSafeOverlap = b }
    762 
    -
    763 
    -pprSafeOverlap :: Bool -> SDoc
    764 
    -pprSafeOverlap True  = text "[safe]"
    765 
    -pprSafeOverlap False = empty
    766 
    -
    767 599 
     {-
    768 600 
     ************************************************************************
    769 601 
     *                                                                      *

  • compiler/GHC/Types/Name.hs
    ... ... @@ -105,10 +105,11 @@ import GHC.Utils.Outputable
    105 105 
     import GHC.Utils.Panic
    106 106 
     import GHC.OldList (intersperse)
    107 107
    108 
    +import Language.Haskell.Syntax.Basic (Boxity(Boxed, Unboxed))
    109 
    +
    108 110 
     import Control.DeepSeq
    109 111 
     import Data.Data
    110 112 
     import qualified Data.Semigroup as S
    111 
    -import GHC.Types.Basic (Boxity(Boxed, Unboxed))
    112 113 
     import GHC.Builtin.Uniques ( isTupleTyConUnique, isCTupleTyConUnique,
    113 114 
                                  isSumTyConUnique, isTupleDataConLikeUnique )
    114 115

  • compiler/GHC/Unit/Types.hs
    ... ... @@ -99,7 +99,7 @@ import qualified Data.ByteString as BS
    99 99 
     import qualified Data.ByteString.Char8 as BS.Char8
    100 100
    101 101 
     import Language.Haskell.Syntax.Module.Name
    102 
    -import Language.Haskell.Syntax.ImpExp (IsBootInterface(..))
    102 
    +import Language.Haskell.Syntax.ImpExp.IsBoot (IsBootInterface(..))
    103 103
    104 104 
     ---------------------------------------------------------------------
    105 105 
     -- MODULES

  • compiler/GHC/Utils/Outputable.hs
    ... ... @@ -114,6 +114,7 @@ import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
    114 114
    115 115 
     import Language.Haskell.Syntax.Basic
    116 116 
     import Language.Haskell.Syntax.Binds.InlinePragma
    117 
    +import Language.Haskell.Syntax.Decls.Overlap ( OverlapMode(..) )
    117 118 
     import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
    118 119
    119 120 
     import GHC.Prelude.Basic
    ... ... @@ -2026,3 +2027,12 @@ instance Outputable RuleMatchInfo where
    2026 2027 
     instance Outputable TopLevelFlag where
    2027 2028 
       ppr TopLevel    = text "<TopLevel>"
    2028 2029 
       ppr NotTopLevel = text "<NotTopLevel>"
    2030 
    +
    2031 
    +instance Outputable (OverlapMode p) where
    2032 
    +  ppr (NoOverlap    _) = empty
    2033 
    +  ppr (Overlappable _) = text "[overlappable]"
    2034 
    +  ppr (Overlapping  _) = text "[overlapping]"
    2035 
    +  ppr (Overlaps     _) = text "[overlap ok]"
    2036 
    +  ppr (Incoherent   _) = text "[incoherent]"
    2037 
    +  ppr (NonCanonical _) = text "[noncanonical]"
    2038 
    +  ppr (XOverlapMode _) = text "[user TTG extension]"

  • compiler/Language/Haskell/Syntax/Basic.hs
    1 1 
     {-# LANGUAGE GeneralisedNewtypeDeriving #-}
    2 
    +
    2 3 
     module Language.Haskell.Syntax.Basic where
    3 4
    5 
    +import Control.DeepSeq
    4 6 
     import Data.Data (Data)
    5 7 
     import Data.Eq
    6 8 
     import Data.Ord
    ... ... @@ -8,7 +10,6 @@ import Data.Bool
    8 10 
     import Prelude
    9 11
    10 12 
     import GHC.Data.FastString (FastString)
    11 
    -import Control.DeepSeq
    12 13
    13 14 
     {-
    14 15 
     ************************************************************************

  • compiler/Language/Haskell/Syntax/Decls.hs
    ... ... @@ -88,18 +88,18 @@ module Language.Haskell.Syntax.Decls (
    88 88
    89 89 
     -- friends:
    90 90 
     import {-# SOURCE #-} Language.Haskell.Syntax.Expr
    91 
    -  ( HsExpr, HsUntypedSplice )
    91 
    +  (HsExpr, HsUntypedSplice)
    92 92 
             -- Because Expr imports Decls via HsBracket
    93 93
    94 
    -import Language.Haskell.Syntax.Basic (TopLevelFlag, RuleName)
    94 
    +import Language.Haskell.Syntax.Basic
    95 
    +  (LexicalFixity, Role, RuleName, TopLevelFlag)
    95 96 
     import Language.Haskell.Syntax.Binds
    96 97 
     import Language.Haskell.Syntax.Binds.InlinePragma (Activation)
    98 
    +import Language.Haskell.Syntax.Decls.Overlap (OverlapMode)
    97 99 
     import Language.Haskell.Syntax.Extension
    98 
    -import Language.Haskell.Syntax.Type
    99 
    -import Language.Haskell.Syntax.Basic (Role, LexicalFixity)
    100 100 
     import Language.Haskell.Syntax.Specificity (Specificity)
    101 
    +import Language.Haskell.Syntax.Type
    101 102
    102 
    -import GHC.Types.Basic (OverlapMode)
    103 103 
     import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec)
    104 104
    105 105 
     import GHC.Data.FastString (FastString)
    ... ... @@ -119,7 +119,7 @@ import Prelude (Show)
    119 119 
     import Data.Foldable
    120 120 
     import Data.Traversable
    121 121 
     import Data.List.NonEmpty (NonEmpty (..))
    122 
    -import GHC.Generics ( Generic )
    122 
    +import GHC.Generics (Generic)
    123 123
    124 124
    125 125 
     {-
    ... ... @@ -1261,7 +1261,7 @@ data ClsInstDecl pass
    1261 1261 
           , cid_sigs          :: [LSig pass]         -- User-supplied pragmatic info
    1262 1262 
           , cid_tyfam_insts   :: [LTyFamInstDecl pass]   -- Type family instances
    1263 1263 
           , cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances
    1264 
    -      , cid_overlap_mode  :: Maybe (XRec pass OverlapMode)
    1264 
    +      , cid_overlap_mode  :: Maybe (XRec pass (OverlapMode pass))
    1265 1265 
           }
    1266 1266 
       | XClsInstDecl !(XXClsInstDecl pass)
    1267 1267
    ... ... @@ -1310,7 +1310,7 @@ data DerivDecl pass = DerivDecl
    1310 1310 
               -- See Note [Inferring the instance context] in GHC.Tc.Deriv.Infer.
    1311 1311
    1312 1312 
             , deriv_strategy     :: Maybe (LDerivStrategy pass)
    1313 
    -        , deriv_overlap_mode :: Maybe (XRec pass OverlapMode)
    1313 
    +        , deriv_overlap_mode :: Maybe (XRec pass (OverlapMode pass))
    1314 1314 
             }
    1315 1315 
       | XDerivDecl !(XXDerivDecl pass)
    1316 1316

  • compiler/Language/Haskell/Syntax/Decls/Overlap.hs
    1 
    +{-# LANGUAGE GeneralisedNewtypeDeriving #-}
    2 
    +{-# LANGUAGE LambdaCase #-}
    3 
    +{-# LANGUAGE OverlappingInstances #-}
    4 
    +{-# LANGUAGE UndecidableInstances #-} -- Eq XOverlapMode, NFData OverlapMode
    5 
    +
    6 
    +{- |
    7 
    +Data-type describing the overlap annotations for instances.
    8 
    +-}
    9 
    +module Language.Haskell.Syntax.Decls.Overlap where
    10 
    +
    11 
    +import Control.DeepSeq
    12 
    +import Data.Eq
    13 
    +import Prelude
    14 
    +
    15 
    +import Language.Haskell.Syntax.Extension
    16 
    +
    17 
    +-- | The status of overlapping instances /(including no overlap)/ for a type.
    18 
    +data OverlapMode pass -- See Note [Rules for instance lookup] in GHC.Core.InstEnv
    19 
    +  = NoOverlap (XOverlapMode pass)
    20 
    +    -- ^ This instance must not overlap another `NoOverlap` instance.
    21 
    +    -- However, it may be overlapped by `Overlapping` instances,
    22 
    +    -- and it may overlap `Overlappable` instances.
    23 
    +
    24 
    +
    25 
    +  | Overlappable (XOverlapMode pass)
    26 
    +    -- ^ Silently ignore this instance if you find a
    27 
    +    -- more specific one that matches the constraint
    28 
    +    -- you are trying to resolve
    29 
    +    --
    30 
    +    -- Example: constraint (Foo [Int])
    31 
    +    --   instance                      Foo [Int]
    32 
    +    --   instance {-# OVERLAPPABLE #-} Foo [a]
    33 
    +    --
    34 
    +    -- Since the second instance has the Overlappable flag,
    35 
    +    -- the first instance will be chosen (otherwise
    36 
    +    -- its ambiguous which to choose)
    37 
    +
    38 
    +  | Overlapping (XOverlapMode pass)
    39 
    +    -- ^ Silently ignore any more general instances that may be
    40 
    +    --   used to solve the constraint.
    41 
    +    --
    42 
    +    -- Example: constraint (Foo [Int])
    43 
    +    --   instance {-# OVERLAPPING #-} Foo [Int]
    44 
    +    --   instance                     Foo [a]
    45 
    +    --
    46 
    +    -- Since the first instance has the Overlapping flag,
    47 
    +    -- the second---more general---instance will be ignored (otherwise
    48 
    +    -- it is ambiguous which to choose)
    49 
    +
    50 
    +  | Overlaps (XOverlapMode pass)
    51 
    +    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
    52 
    +
    53 
    +  | Incoherent (XOverlapMode pass)
    54 
    +    -- ^ Behave like Overlappable and Overlapping, and in addition pick
    55 
    +    -- an arbitrary one if there are multiple matching candidates, and
    56 
    +    -- don't worry about later instantiation
    57 
    +    --
    58 
    +    -- Example: constraint (Foo [b])
    59 
    +    -- instance {-# INCOHERENT -} Foo [Int]
    60 
    +    -- instance                   Foo [a]
    61 
    +    -- Without the Incoherent flag, we'd complain that
    62 
    +    -- instantiating 'b' would change which instance
    63 
    +    -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv"
    64 
    +
    65 
    +  | NonCanonical (XOverlapMode pass)
    66 
    +    -- ^ Behave like Incoherent, but the instance choice is observable
    67 
    +    -- by the program behaviour. See Note [Coherence and specialisation: overview].
    68 
    +    --
    69 
    +    -- We don't have surface syntax for the distinction between
    70 
    +    -- Incoherent and NonCanonical instances; instead, the flag
    71 
    +    -- `-f{no-}specialise-incoherents` (on by default) controls
    72 
    +    -- whether `INCOHERENT` instances are regarded as Incoherent or
    73 
    +    -- NonCanonical.
    74 
    +
    75 
    +  | XOverlapMode !(XXOverlapMode pass)
    76 
    +    -- ^ The /Trees That Grow/ extension point constructor.
    77 
    +
    78 
    +deriving instance ( Eq (XOverlapMode pass)
    79 
    +                  , Eq (XXOverlapMode pass)
    80 
    +                  ) => Eq (OverlapMode pass)
    81 
    +
    82 
    +instance ( NFData (XOverlapMode pass)
    83 
    +         , NFData (XXOverlapMode pass)
    84 
    +         ) => NFData (OverlapMode pass) where
    85 
    +  rnf = \case
    86 
    +    NoOverlap    s -> rnf s
    87 
    +    Overlappable s -> rnf s
    88 
    +    Overlapping  s -> rnf s
    89 
    +    Overlaps     s -> rnf s
    90 
    +    Incoherent   s -> rnf s
    91 
    +    NonCanonical s -> rnf s
    92 
    +    XOverlapMode s -> rnf s
    93 
    +
    94 
    +
    95 
    +hasIncoherentFlag :: OverlapMode p -> Bool
    96 
    +hasIncoherentFlag mode =
    97 
    +  case mode of
    98 
    +    Incoherent   _ -> True
    99 
    +    NonCanonical _ -> True
    100 
    +    _              -> False
    101 
    +
    102 
    +hasOverlappableFlag :: OverlapMode p -> Bool
    103 
    +hasOverlappableFlag mode =
    104 
    +  case mode of
    105 
    +    Overlappable _ -> True
    106 
    +    Overlaps     _ -> True
    107 
    +    Incoherent   _ -> True
    108 
    +    NonCanonical _ -> True
    109 
    +    _              -> False
    110 
    +
    111 
    +hasOverlappingFlag :: OverlapMode p -> Bool
    112 
    +hasOverlappingFlag mode =
    113 
    +  case mode of
    114 
    +    Overlapping  _ -> True
    115 
    +    Overlaps     _ -> True
    116 
    +    Incoherent   _ -> True
    117 
    +    NonCanonical _ -> True
    118 
    +    _              -> False
    119 
    +
    120 
    +hasNonCanonicalFlag :: OverlapMode p -> Bool
    121 
    +hasNonCanonicalFlag = \case
    122 
    +    NonCanonical{} -> True
    123 
    +    _              -> False

  • compiler/Language/Haskell/Syntax/Extension.hs
    ... ... @@ -359,6 +359,11 @@ type family XDataFamInstD x
    359 359 
     type family XTyFamInstD    x
    360 360 
     type family XXInstDecl     x
    361 361
    362 
    +-- -------------------------------------
    363 
    +-- OverlapMode type families
    364 
    +type family XOverlapMode  x
    365 
    +type family XXOverlapMode x
    366 
    +
    362 367 
     -- -------------------------------------
    363 368 
     -- DerivDecl type families
    364 369 
     type family XCDerivDecl      x

  • compiler/ghc.cabal.in
    ... ... @@ -546,6 +546,7 @@ Library
    546 546 
             GHC.Hs.Basic
    547 547 
             GHC.Hs.Binds
    548 548 
             GHC.Hs.Decls
    549 
    +        GHC.Hs.Decls.Overlap
    549 550 
             GHC.Hs.Doc
    550 551 
             GHC.Hs.DocString
    551 552 
             GHC.Hs.Dump
    ... ... @@ -1024,6 +1025,7 @@ Library
    1024 1025 
             Language.Haskell.Syntax.Binds.InlinePragma
    1025 1026 
             Language.Haskell.Syntax.BooleanFormula
    1026 1027 
             Language.Haskell.Syntax.Decls
    1028 
    +        Language.Haskell.Syntax.Decls.Overlap
    1027 1029 
             Language.Haskell.Syntax.Expr
    1028 1030 
             Language.Haskell.Syntax.Extension
    1029 1031 
             Language.Haskell.Syntax.ImpExp

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -45,8 +45,8 @@ import GHC.Base (NonEmpty(..))
    45 45 
     import qualified GHC.Data.BooleanFormula as BF
    46 46 
     import GHC.Data.FastString
    47 47 
     import qualified GHC.Data.Strict as Strict
    48 
    +import GHC.Hs.Decls.Overlap (OverlapMode(..))
    48 49 
     import GHC.TypeLits
    49 
    -import GHC.Types.Basic hiding (EP)
    50 50 
     import GHC.Types.ForeignCall
    51 51 
     import GHC.Types.InlinePragma (ActivationGhc, inlinePragmaActivation, inlinePragmaSource)
    52 52 
     import GHC.Types.Name.Reader
    ... ... @@ -2263,7 +2263,7 @@ instance ExactPrint (TyFamInstDecl GhcPs) where
    2263 2263
    2264 2264 
     -- ---------------------------------------------------------------------
    2265 2265
    2266 
    -instance ExactPrint (LocatedP OverlapMode) where
    2266 
    +instance Typeable p => ExactPrint (LocatedP (OverlapMode (GhcPass p))) where
    2267 2267 
       getAnnotationEntry = entryFromLocatedA
    2268 2268 
       setAnnotationAnchor = setAnchorAn
    2269 2269

  • utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
    ... ... @@ -37,6 +37,7 @@ import GHC hiding (NoLink, HsTypeGhcPsExt (..))
    37 37 
     import GHC.Builtin.Types (eqTyCon_RDR, tupleDataConName, tupleTyConName)
    38 38 
     import GHC.Core.TyCon (tyConResKind)
    39 39 
     import GHC.Driver.DynFlags (getDynFlags)
    40 
    +import GHC.Hs.Decls.Overlap (OverlapMode(..))
    40 41 
     import GHC.Types.Basic (TupleSort (..))
    41 42 
     import GHC.Types.Name
    42 43 
     import GHC.Types.Name.Reader (RdrName (Exact))
    ... ... @@ -860,10 +861,19 @@ renameDerivD
    860 861 
               { deriv_ext = noExtField
    861 862 
               , deriv_type = ty'
    862 863 
               , deriv_strategy = strat'
    863 
    -          , deriv_overlap_mode = omode
    864 
    +          , deriv_overlap_mode = fmap convertOverlapMode <$> omode
    864 865 
               }
    865 866 
           )
    866 867
    868 
    +convertOverlapMode :: OverlapMode GhcRn -> OverlapMode DocNameI
    869 
    +convertOverlapMode = \case
    870 
    +  NoOverlap    _ -> NoOverlap    NoExtField
    871 
    +  Overlappable _ -> Overlappable NoExtField
    872 
    +  Overlapping  _ -> Overlapping  NoExtField
    873 
    +  Overlaps     _ -> Overlaps     NoExtField
    874 
    +  Incoherent   _ -> Incoherent   NoExtField
    875 
    +  NonCanonical _ -> NonCanonical NoExtField
    876 
    +
    867 877 
     renameDerivStrategy :: DerivStrategy GhcRn -> RnM (DerivStrategy DocNameI)
    868 878 
     renameDerivStrategy (StockStrategy a) = pure (StockStrategy a)
    869 879 
     renameDerivStrategy (AnyclassStrategy a) = pure (AnyclassStrategy a)
    ... ... @@ -885,7 +895,7 @@ renameClsInstD
    885 895 
         return
    886 896 
           ( ClsInstDecl
    887 897 
               { cid_ext = noExtField
    888 
    -          , cid_overlap_mode = omode
    898 
    +          , cid_overlap_mode = fmap convertOverlapMode <$> omode
    889 899 
               , cid_poly_ty = ltype'
    890 900 
               , cid_binds = []
    891 901 
               , cid_sigs = []

  • utils/haddock/haddock-api/src/Haddock/Types.hs
    ... ... @@ -56,6 +56,7 @@ import GHC.Data.BooleanFormula (BooleanFormula)
    56 56 
     import GHC.Driver.Session (Language)
    57 57 
     import qualified GHC.LanguageExtensions as LangExt
    58 58 
     import GHC.Core.InstEnv (is_dfun_name)
    59 
    +import GHC.Hs.Decls.Overlap (OverlapMode)
    59 60 
     import GHC.Types.Name (stableNameCmp)
    60 61 
     import GHC.Types.Name.Occurrence
    61 62 
     import GHC.Types.Name.Reader (RdrName (..))
    ... ... @@ -829,6 +830,7 @@ type instance Anno (FamilyResultSig DocNameI) = EpAnn NoEpAnns
    829 830 
     type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA
    830 831 
     type instance Anno (HsSigType DocNameI) = SrcSpanAnnA
    831 832 
     type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnL
    833 
    +type instance Anno (OverlapMode DocNameI) = EpAnn AnnPragma
    832 834
    833 835 
     type XRecCond a =
    834 836 
       ( XParTy a ~ (EpToken "(", EpToken ")")
    ... ... @@ -960,8 +962,10 @@ type instance XClassDecl DocNameI = NoExtField
    960 962 
     type instance XDataDecl DocNameI = NoExtField
    961 963 
     type instance XSynDecl DocNameI = NoExtField
    962 964 
     type instance XFamDecl DocNameI = NoExtField
    965 
    +type instance XOverlapMode DocNameI = NoExtField
    963 966 
     type instance XXHsDataDefn DocNameI = DataConCantHappen
    964 967 
     type instance XXFamilyDecl DocNameI = DataConCantHappen
    968 
    +type instance XXOverlapMode DocNameI = DataConCantHappen
    965 969 
     type instance XXTyClDecl DocNameI = DataConCantHappen
    966 970
    967 971 
     type instance XHsWC DocNameI _ = NoExtField

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help