summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Hs/Binds.hs16
-rw-r--r--compiler/GHC/Hs/Decls.hs56
-rw-r--r--compiler/GHC/Hs/Expr.hs89
-rw-r--r--compiler/GHC/Hs/Extension.hs24
-rw-r--r--compiler/GHC/Hs/ImpExp.hs4
-rw-r--r--compiler/GHC/Hs/Lit.hs4
-rw-r--r--compiler/GHC/Hs/Pat.hs11
-rw-r--r--compiler/GHC/Hs/Type.hs20
-rw-r--r--compiler/GHC/Hs/Utils.hs2
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs2
-rw-r--r--compiler/GHC/Rename/Expr.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Expr.hs2
-rw-r--r--compiler/Language/Haskell/Syntax/Extension.hs49
m---------utils/haddock0
14 files changed, 134 insertions, 147 deletions
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index f25d28bee9..f5f9b725f4 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -71,7 +71,7 @@ Global bindings (where clauses)
type instance XHsValBinds (GhcPass pL) (GhcPass pR) = EpAnn AnnList
type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = EpAnn AnnList
type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField
-type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
+type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = DataConCantHappen
-- ---------------------------------------------------------------------
-- Deal with ValBindsOut
@@ -99,16 +99,16 @@ type instance XPatBind GhcTc (GhcPass pR) = Type -- Type of the GRHSs
type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExtField
type instance XAbsBinds (GhcPass pL) (GhcPass pR) = NoExtField
type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField
-type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
+type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = DataConCantHappen
type instance XABE (GhcPass p) = NoExtField
-type instance XXABExport (GhcPass p) = NoExtCon
+type instance XXABExport (GhcPass p) = DataConCantHappen
type instance XPSB (GhcPass idL) GhcPs = EpAnn [AddEpAnn]
type instance XPSB (GhcPass idL) GhcRn = NameSet
type instance XPSB (GhcPass idL) GhcTc = NameSet
-type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExtCon
+type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = DataConCantHappen
{-
Note [AbsBinds]
@@ -543,7 +543,7 @@ type instance XIPBinds GhcTc = TcEvBinds -- binds uses of the
-- implicit parameters
-type instance XXHsIPBinds (GhcPass p) = NoExtCon
+type instance XXHsIPBinds (GhcPass p) = DataConCantHappen
isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
isEmptyIPBindsPR (IPBinds _ is) = null is
@@ -552,7 +552,7 @@ isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool
isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds
type instance XCIPBind (GhcPass p) = EpAnn [AddEpAnn]
-type instance XXIPBind (GhcPass p) = NoExtCon
+type instance XXIPBind (GhcPass p) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (HsIPBinds (GhcPass p)) where
@@ -585,10 +585,10 @@ type instance XMinimalSig (GhcPass p) = EpAnn [AddEpAnn]
type instance XSCCFunSig (GhcPass p) = EpAnn [AddEpAnn]
type instance XCompleteMatchSig (GhcPass p) = EpAnn [AddEpAnn]
-type instance XXSig (GhcPass p) = NoExtCon
+type instance XXSig (GhcPass p) = DataConCantHappen
type instance XFixitySig (GhcPass p) = NoExtField
-type instance XXFixitySig (GhcPass p) = NoExtCon
+type instance XXFixitySig (GhcPass p) = DataConCantHappen
data AnnSig
= AnnSig {
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 3a58ddfce1..40c54b629a 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -153,7 +153,7 @@ type instance XRuleD (GhcPass _) = NoExtField
type instance XSpliceD (GhcPass _) = NoExtField
type instance XDocD (GhcPass _) = NoExtField
type instance XRoleAnnotD (GhcPass _) = NoExtField
-type instance XXHsDecl (GhcPass _) = NoExtCon
+type instance XXHsDecl (GhcPass _) = DataConCantHappen
-- | Partition a list of HsDecls into function/pattern bindings, signatures,
-- type family declarations, type family instances, and documentation comments.
@@ -188,7 +188,7 @@ partitionBindsAndSigs = go
_ -> pprPanic "partitionBindsAndSigs" (ppr decl)
type instance XCHsGroup (GhcPass _) = NoExtField
-type instance XXHsGroup (GhcPass _) = NoExtCon
+type instance XXHsGroup (GhcPass _) = DataConCantHappen
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
@@ -309,7 +309,7 @@ instance (OutputableBndrId p) => Outputable (HsGroup (GhcPass p)) where
vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds
type instance XSpliceDecl (GhcPass _) = NoExtField
-type instance XXSpliceDecl (GhcPass _) = NoExtCon
+type instance XXSpliceDecl (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (SpliceDecl (GhcPass p)) where
@@ -338,10 +338,10 @@ type instance XClassDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey, LayoutInfo)
type instance XClassDecl GhcRn = NameSet -- FVs
type instance XClassDecl GhcTc = NameSet -- FVs
-type instance XXTyClDecl (GhcPass _) = NoExtCon
+type instance XXTyClDecl (GhcPass _) = DataConCantHappen
type instance XCTyFamInstDecl (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXTyFamInstDecl (GhcPass _) = NoExtCon
+type instance XXTyFamInstDecl (GhcPass _) = DataConCantHappen
-- Dealing with names
@@ -464,7 +464,7 @@ instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where
ppr = pprFunDep
type instance XCFunDep (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXFunDep (GhcPass _) = NoExtCon
+type instance XXFunDep (GhcPass _) = DataConCantHappen
pprFundeps :: OutputableBndrId p => [FunDep (GhcPass p)] -> SDoc
pprFundeps [] = empty
@@ -482,7 +482,7 @@ pprFunDep (FunDep _ us vs) = hsep [interppSP us, arrow, interppSP vs]
********************************************************************* -}
type instance XCTyClGroup (GhcPass _) = NoExtField
-type instance XXTyClGroup (GhcPass _) = NoExtCon
+type instance XXTyClGroup (GhcPass _) = DataConCantHappen
{- *********************************************************************
@@ -495,10 +495,10 @@ type instance XNoSig (GhcPass _) = NoExtField
type instance XCKindSig (GhcPass _) = NoExtField
type instance XTyVarSig (GhcPass _) = NoExtField
-type instance XXFamilyResultSig (GhcPass _) = NoExtCon
+type instance XXFamilyResultSig (GhcPass _) = DataConCantHappen
type instance XCFamilyDecl (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXFamilyDecl (GhcPass _) = NoExtCon
+type instance XXFamilyDecl (GhcPass _) = DataConCantHappen
------------- Functions over FamilyDecls -----------
@@ -525,7 +525,7 @@ resultVariableName _ = Nothing
------------- Pretty printing FamilyDecls -----------
type instance XCInjectivityAnn (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXInjectivityAnn (GhcPass _) = NoExtCon
+type instance XXInjectivityAnn (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (FamilyDecl (GhcPass p)) where
@@ -569,10 +569,10 @@ instance OutputableBndrId p
********************************************************************* -}
type instance XCHsDataDefn (GhcPass _) = NoExtField
-type instance XXHsDataDefn (GhcPass _) = NoExtCon
+type instance XXHsDataDefn (GhcPass _) = DataConCantHappen
type instance XCHsDerivingClause (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXHsDerivingClause (GhcPass _) = NoExtCon
+type instance XXHsDerivingClause (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (HsDerivingClause (GhcPass p)) where
@@ -592,7 +592,7 @@ instance OutputableBndrId p
type instance XDctSingle (GhcPass _) = NoExtField
type instance XDctMulti (GhcPass _) = NoExtField
-type instance XXDerivClauseTys (GhcPass _) = NoExtCon
+type instance XXDerivClauseTys (GhcPass _) = DataConCantHappen
instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where
ppr (DctSingle _ ty) = ppr ty
@@ -602,7 +602,7 @@ type instance XStandaloneKindSig GhcPs = EpAnn [AddEpAnn]
type instance XStandaloneKindSig GhcRn = NoExtField
type instance XStandaloneKindSig GhcTc = NoExtField
-type instance XXStandaloneKindSig (GhcPass p) = NoExtCon
+type instance XXStandaloneKindSig (GhcPass p) = DataConCantHappen
standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname
@@ -610,7 +610,7 @@ standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname
type instance XConDeclGADT (GhcPass _) = EpAnn [AddEpAnn]
type instance XConDeclH98 (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXConDecl (GhcPass _) = NoExtCon
+type instance XXConDecl (GhcPass _) = DataConCantHappen
getConNames :: ConDecl GhcRn -> [LocatedN Name]
getConNames ConDeclH98 {con_name = name} = [name]
@@ -728,7 +728,7 @@ ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
-}
type instance XCFamEqn (GhcPass _) r = EpAnn [AddEpAnn]
-type instance XXFamEqn (GhcPass _) r = NoExtCon
+type instance XXFamEqn (GhcPass _) r = DataConCantHappen
type instance Anno (FamEqn (GhcPass p) _) = SrcSpanAnnA
@@ -738,7 +738,7 @@ type instance XCClsInstDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey) -- TODO:AZ
type instance XCClsInstDecl GhcRn = NoExtField
type instance XCClsInstDecl GhcTc = NoExtField
-type instance XXClsInstDecl (GhcPass _) = NoExtCon
+type instance XXClsInstDecl (GhcPass _) = DataConCantHappen
----------------- Instances of all kinds -------------
@@ -752,7 +752,7 @@ type instance XTyFamInstD GhcPs = NoExtField
type instance XTyFamInstD GhcRn = NoExtField
type instance XTyFamInstD GhcTc = NoExtField
-type instance XXInstDecl (GhcPass _) = NoExtCon
+type instance XXInstDecl (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (TyFamInstDecl (GhcPass p)) where
@@ -881,7 +881,7 @@ instDeclDataFamInsts inst_decls
-}
type instance XCDerivDecl (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXDerivDecl (GhcPass _) = NoExtCon
+type instance XXDerivDecl (GhcPass _) = DataConCantHappen
type instance Anno OverlapMode = SrcSpanAnnP
@@ -963,7 +963,7 @@ type instance XCDefaultDecl GhcPs = EpAnn [AddEpAnn]
type instance XCDefaultDecl GhcRn = NoExtField
type instance XCDefaultDecl GhcTc = NoExtField
-type instance XXDefaultDecl (GhcPass _) = NoExtCon
+type instance XXDefaultDecl (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (DefaultDecl (GhcPass p)) where
@@ -986,7 +986,7 @@ type instance XForeignExport GhcPs = EpAnn [AddEpAnn]
type instance XForeignExport GhcRn = NoExtField
type instance XForeignExport GhcTc = Coercion
-type instance XXForeignDecl (GhcPass _) = NoExtCon
+type instance XXForeignDecl (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (ForeignDecl (GhcPass p)) where
@@ -1009,13 +1009,13 @@ type instance XCRuleDecls GhcPs = EpAnn [AddEpAnn]
type instance XCRuleDecls GhcRn = NoExtField
type instance XCRuleDecls GhcTc = NoExtField
-type instance XXRuleDecls (GhcPass _) = NoExtCon
+type instance XXRuleDecls (GhcPass _) = DataConCantHappen
type instance XHsRule GhcPs = EpAnn HsRuleAnn
type instance XHsRule GhcRn = HsRuleRn
type instance XHsRule GhcTc = HsRuleRn
-type instance XXRuleDecl (GhcPass _) = NoExtCon
+type instance XXRuleDecl (GhcPass _) = DataConCantHappen
type instance Anno (SourceText, RuleName) = SrcAnn NoEpAnns
@@ -1035,7 +1035,7 @@ flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
type instance XCRuleBndr (GhcPass _) = EpAnn [AddEpAnn]
type instance XRuleBndrSig (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXRuleBndr (GhcPass _) = NoExtCon
+type instance XXRuleBndr (GhcPass _) = DataConCantHappen
instance (OutputableBndrId p) => Outputable (RuleDecls (GhcPass p)) where
ppr (HsRules { rds_src = st
@@ -1076,10 +1076,10 @@ type instance XWarnings GhcPs = EpAnn [AddEpAnn]
type instance XWarnings GhcRn = NoExtField
type instance XWarnings GhcTc = NoExtField
-type instance XXWarnDecls (GhcPass _) = NoExtCon
+type instance XXWarnDecls (GhcPass _) = DataConCantHappen
type instance XWarning (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXWarnDecl (GhcPass _) = NoExtCon
+type instance XXWarnDecl (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
@@ -1103,7 +1103,7 @@ instance OutputableBndrId p
-}
type instance XHsAnnotation (GhcPass _) = EpAnn AnnPragma
-type instance XXAnnDecl (GhcPass _) = NoExtCon
+type instance XXAnnDecl (GhcPass _) = DataConCantHappen
instance (OutputableBndrId p) => Outputable (AnnDecl (GhcPass p)) where
ppr (HsAnnotation _ _ provenance expr)
@@ -1128,7 +1128,7 @@ type instance XCRoleAnnotDecl GhcPs = EpAnn [AddEpAnn]
type instance XCRoleAnnotDecl GhcRn = NoExtField
type instance XCRoleAnnotDecl GhcTc = NoExtField
-type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon
+type instance XXRoleAnnotDecl (GhcPass _) = DataConCantHappen
type instance Anno (Maybe Role) = SrcAnn NoEpAnns
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index ad49273464..6228b7d90e 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -70,7 +70,6 @@ import Data.Data hiding (Fixity(..))
import qualified Data.Data as Data (Fixity(..))
import qualified Data.Kind
import Data.Maybe (isJust)
-import Data.Void ( Void )
import Data.Foldable ( toList )
{- *********************************************************************
@@ -190,30 +189,6 @@ type instance PendingTcSplice' (GhcPass _) = PendingTcSplice
-- ---------------------------------------------------------------------
-{- Note [Constructor cannot occur]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Some data constructors can't occur in certain phases; e.g. the output
-of the type checker never has OverLabel. We signal this by
-* setting the extension field to Void
-* using dataConCantHappen in the cases that can't happen
-
-For example:
-
- type instance XOverLabel GhcTc = Void
-
- dsExpr :: HsExpr GhcTc -> blah
- dsExpr (HsOverLabel x _) = dataConCantHappen x
-
-The function dataConCantHappen is defined thus:
- dataConCantHappen :: Void -> a
- dataConCantHappen x = case x of {}
-(i.e. identically to Data.Void.absurd, but more helpfully named).
-Remember Void is a type whose only element is bottom.
-
-It would be better to omit the pattern match altogether, but we
-could only do that if the extension field was strict (#18764).
--}
-
-- API Annotations types
data EpAnnHsCase = EpAnnHsCase
@@ -231,7 +206,7 @@ type instance XVar (GhcPass _) = NoExtField
-- Record selectors at parse time are HsVar; they convert to HsRecSel
-- on renaming.
-type instance XRecSel GhcPs = Void
+type instance XRecSel GhcPs = DataConCantHappen
type instance XRecSel GhcRn = NoExtField
type instance XRecSel GhcTc = NoExtField
@@ -241,7 +216,7 @@ type instance XLam (GhcPass _) = NoExtField
-- Note [Handling overloaded and rebindable constructs]
type instance XOverLabel GhcPs = EpAnnCO
type instance XOverLabel GhcRn = EpAnnCO
-type instance XOverLabel GhcTc = Void -- See Note [Constructor cannot occur]
+type instance XOverLabel GhcTc = DataConCantHappen
-- ---------------------------------------------------------------------
@@ -257,7 +232,7 @@ type instance XUnboundVar GhcTc = HoleExprRef
type instance XIPVar GhcPs = EpAnnCO
type instance XIPVar GhcRn = EpAnnCO
-type instance XIPVar GhcTc = Void -- See Note [Constructor cannot occur]
+type instance XIPVar GhcTc = DataConCantHappen
type instance XOverLitE (GhcPass _) = EpAnnCO
type instance XLitE (GhcPass _) = EpAnnCO
@@ -274,7 +249,7 @@ type instance XAppTypeE GhcTc = Type
-- Note [Handling overloaded and rebindable constructs]
type instance XOpApp GhcPs = EpAnn [AddEpAnn]
type instance XOpApp GhcRn = Fixity
-type instance XOpApp GhcTc = Void -- See Note [Constructor cannot occur]
+type instance XOpApp GhcTc = DataConCantHappen
-- SectionL, SectionR not present in GhcTc pass; see GHC.Rename.Expr
-- Note [Handling overloaded and rebindable constructs]
@@ -282,8 +257,8 @@ type instance XSectionL GhcPs = EpAnnCO
type instance XSectionR GhcPs = EpAnnCO
type instance XSectionL GhcRn = EpAnnCO
type instance XSectionR GhcRn = EpAnnCO
-type instance XSectionL GhcTc = Void -- See Note [Constructor cannot occur]
-type instance XSectionR GhcTc = Void -- See Note [Constructor cannot occur]
+type instance XSectionL GhcTc = DataConCantHappen
+type instance XSectionR GhcTc = DataConCantHappen
type instance XNegApp GhcPs = EpAnn [AddEpAnn]
@@ -341,13 +316,13 @@ type instance XRecordUpd GhcTc = RecordUpdTc
type instance XGetField GhcPs = EpAnnCO
type instance XGetField GhcRn = NoExtField
-type instance XGetField GhcTc = Void
+type instance XGetField GhcTc = DataConCantHappen
-- HsGetField is eliminated by the renamer. See [Handling overloaded
-- and rebindable constructs].
type instance XProjection GhcPs = EpAnn AnnProjection
type instance XProjection GhcRn = NoExtField
-type instance XProjection GhcTc = Void
+type instance XProjection GhcTc = DataConCantHappen
-- HsProjection is eliminated by the renamer. See [Handling overloaded
-- and rebindable constructs].
@@ -361,14 +336,14 @@ type instance XArithSeq GhcTc = PostTcExpr
type instance XBracket GhcPs = EpAnn [AddEpAnn]
type instance XBracket GhcRn = EpAnn [AddEpAnn]
-type instance XBracket GhcTc = Void -- See Note [Constructor cannot occur]
+type instance XBracket GhcTc = DataConCantHappen
-type instance XRnBracketOut GhcPs = Void -- See Note [Constructor cannot occur]
+type instance XRnBracketOut GhcPs = DataConCantHappen
type instance XRnBracketOut GhcRn = NoExtField
-type instance XRnBracketOut GhcTc = Void -- See Note [Constructor cannot occur]
+type instance XRnBracketOut GhcTc = DataConCantHappen
-type instance XTcBracketOut GhcPs = Void -- See Note [Constructor cannot occur]
-type instance XTcBracketOut GhcRn = Void -- See Note [Constructor cannot occur]
+type instance XTcBracketOut GhcPs = DataConCantHappen
+type instance XTcBracketOut GhcRn = DataConCantHappen
type instance XTcBracketOut GhcTc = Type -- Type of the TcBracketOut
type instance XSpliceE (GhcPass _) = EpAnnCO
@@ -414,10 +389,10 @@ data AnnsIf
-- ---------------------------------------------------------------------
type instance XSCC (GhcPass _) = EpAnn AnnPragma
-type instance XXPragE (GhcPass _) = NoExtCon
+type instance XXPragE (GhcPass _) = DataConCantHappen
type instance XCDotFieldOcc (GhcPass _) = EpAnn AnnFieldLabel
-type instance XXDotFieldOcc (GhcPass _) = NoExtCon
+type instance XXDotFieldOcc (GhcPass _) = DataConCantHappen
type instance XPresent (GhcPass _) = EpAnn [AddEpAnn]
@@ -425,7 +400,7 @@ type instance XMissing GhcPs = EpAnn EpaLocation
type instance XMissing GhcRn = NoExtField
type instance XMissing GhcTc = Scaled Type
-type instance XXTupArg (GhcPass _) = NoExtCon
+type instance XXTupArg (GhcPass _) = DataConCantHappen
tupArgPresent :: HsTupArg (GhcPass p) -> Bool
tupArgPresent (Present {}) = True
@@ -438,7 +413,7 @@ tupArgPresent (Missing {}) = False
* *
********************************************************************* -}
-type instance XXExpr GhcPs = NoExtCon
+type instance XXExpr GhcPs = DataConCantHappen
type instance XXExpr GhcRn = HsExpansion (HsExpr GhcRn) (HsExpr GhcRn)
type instance XXExpr GhcTc = XXExprGhcTc
-- HsExpansion: see Note [Rebindable syntax and HsExpansion] below
@@ -1106,8 +1081,8 @@ type instance XCmdDo GhcTc = Type
type instance XCmdWrap (GhcPass _) = NoExtField
-type instance XXCmd GhcPs = NoExtCon
-type instance XXCmd GhcRn = NoExtCon
+type instance XXCmd GhcPs = DataConCantHappen
+type instance XXCmd GhcRn = DataConCantHappen
type instance XXCmd GhcTc = HsWrap HsCmd
type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))]
@@ -1126,7 +1101,7 @@ type instance XCmdTop GhcPs = NoExtField
type instance XCmdTop GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]
type instance XCmdTop GhcTc = CmdTopTc
-type instance XXCmdTop (GhcPass _) = NoExtCon
+type instance XXCmdTop (GhcPass _) = DataConCantHappen
instance (OutputableBndrId p) => Outputable (HsCmd (GhcPass p)) where
ppr cmd = pprCmd cmd
@@ -1249,10 +1224,10 @@ type instance XMG GhcPs b = NoExtField
type instance XMG GhcRn b = NoExtField
type instance XMG GhcTc b = MatchGroupTc
-type instance XXMatchGroup (GhcPass _) b = NoExtCon
+type instance XXMatchGroup (GhcPass _) b = DataConCantHappen
type instance XCMatch (GhcPass _) b = EpAnn [AddEpAnn]
-type instance XXMatch (GhcPass _) b = NoExtCon
+type instance XXMatch (GhcPass _) b = DataConCantHappen
instance (OutputableBndrId pr, Outputable body)
=> Outputable (Match (GhcPass pr) body) where
@@ -1286,7 +1261,7 @@ hsLMatchPats (L _ (Match { m_pats = pats })) = pats
-- item. So this can never be used in practice.
type instance XCGRHSs (GhcPass _) _ = EpAnnComments
-type instance XXGRHSs (GhcPass _) _ = NoExtCon
+type instance XXGRHSs (GhcPass _) _ = DataConCantHappen
data GrhsAnn
= GrhsAnn {
@@ -1298,7 +1273,7 @@ type instance XCGRHS (GhcPass _) _ = EpAnn GrhsAnn
-- Location of matchSeparator
-- TODO:AZ does this belong on the GRHS, or GRHSs?
-type instance XXGRHS (GhcPass _) b = NoExtCon
+type instance XXGRHS (GhcPass _) b = DataConCantHappen
pprMatches :: (OutputableBndrId idR, Outputable body)
=> MatchGroup (GhcPass idR) body -> SDoc
@@ -1446,17 +1421,17 @@ type instance XRecStmt (GhcPass _) GhcPs b = EpAnn AnnList
type instance XRecStmt (GhcPass _) GhcRn b = NoExtField
type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc
-type instance XXStmtLR (GhcPass _) (GhcPass _) b = NoExtCon
+type instance XXStmtLR (GhcPass _) (GhcPass _) b = DataConCantHappen
type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtField
-type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtCon
+type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = DataConCantHappen
type instance XApplicativeArgOne GhcPs = NoExtField
type instance XApplicativeArgOne GhcRn = FailOperator GhcRn
type instance XApplicativeArgOne GhcTc = FailOperator GhcTc
type instance XApplicativeArgMany (GhcPass _) = NoExtField
-type instance XXApplicativeArg (GhcPass _) = NoExtCon
+type instance XXApplicativeArg (GhcPass _) = DataConCantHappen
instance (Outputable (StmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))),
Outputable (XXParStmtBlock (GhcPass idL) (GhcPass idR)))
@@ -1633,8 +1608,8 @@ type instance XTypedSplice (GhcPass _) = EpAnn [AddEpAnn]
type instance XUntypedSplice (GhcPass _) = EpAnn [AddEpAnn]
type instance XQuasiQuote (GhcPass _) = NoExtField
type instance XSpliced (GhcPass _) = NoExtField
-type instance XXSplice GhcPs = NoExtCon
-type instance XXSplice GhcRn = NoExtCon
+type instance XXSplice GhcPs = DataConCantHappen
+type instance XXSplice GhcRn = DataConCantHappen
type instance XXSplice GhcTc = HsSplicedT
-- See Note [Running typed splices in the zonker]
@@ -1761,8 +1736,8 @@ pprSplice (HsQuasiQuote _ n q _ s) = ppr_quasi n q s
pprSplice (HsSpliced _ _ thing) = ppr thing
pprSplice (XSplice x) = case ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
- GhcPs -> noExtCon x
- GhcRn -> noExtCon x
+ GhcPs -> dataConCantHappen x
+ GhcRn -> dataConCantHappen x
#endif
GhcTc -> case x of
HsSplicedT _ -> text "Unevaluated typed splice"
@@ -1784,7 +1759,7 @@ type instance XDecBrG (GhcPass _) = NoExtField
type instance XTypBr (GhcPass _) = NoExtField
type instance XVarBr (GhcPass _) = NoExtField
type instance XTExpBr (GhcPass _) = NoExtField
-type instance XXBracket (GhcPass _) = NoExtCon
+type instance XXBracket (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (HsBracket (GhcPass p)) where
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index ce28e0355d..d58bd9efbc 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -32,8 +32,6 @@ import GHC.Types.SrcLoc (GenLocated(..), unLoc)
import GHC.Utils.Panic
import GHC.Parser.Annotation
-import Data.Void
-
{-
Note [IsPass]
~~~~~~~~~~~~~
@@ -115,12 +113,12 @@ instance MapXRec (GhcPass p) where
-- wrapXRec = noLocA
{-
-Note [NoExtCon and strict fields]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [DataConCantHappen and strict fields]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Currently, any unused TTG extension constructor will generally look like the
following:
- type instance XXHsDecl (GhcPass _) = NoExtCon
+ type instance XXHsDecl (GhcPass _) = DataConCantHappen
data HsDecl p
= ...
| XHsDecl !(XXHsDecl p)
@@ -132,17 +130,17 @@ the following function which consumes an HsDecl:
ex :: HsDecl GhcPs -> HsDecl GhcRn
...
- ex (XHsDecl nec) = noExtCon nec
+ ex (XHsDecl nec) = dataConCantHappen nec
Because `p` equals GhcPs (i.e., GhcPass 'Parsed), XHsDecl's field has the type
-NoExtCon. But since (1) the field is strict and (2) NoExtCon is an empty data
-type, there is no possible way to reach the right-hand side of the XHsDecl
-case. As a result, the coverage checker concludes that the XHsDecl case is
-inaccessible, so it can be removed.
+DataConCantHappen. But since (1) the field is strict and (2) DataConCantHappen
+is an empty data type, there is no possible way to reach the right-hand side
+of the XHsDecl case. As a result, the coverage checker concludes that
+the XHsDecl case is inaccessible, so it can be removed.
(See Note [Strict argument type constraints] in GHC.HsToCore.Pmc.Solver for
more on how this works.)
-Bottom line: if you add a TTG extension constructor that uses NoExtCon, make
+Bottom line: if you add a TTG extension constructor that uses DataConCantHappen, make
sure that any uses of it as a field are strict.
-}
@@ -219,10 +217,6 @@ type OutputableBndrId pass =
, IsPass pass
)
--- | See Note [Constructor cannot occur]
-dataConCantHappen :: Void -> a
-dataConCantHappen = absurd
-
-- useful helper functions:
pprIfPs :: forall p. IsPass p => (p ~ 'Parsed => SDoc) -> SDoc
pprIfPs pp = case ghcPass @p of GhcPs -> pp
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 7282b724cf..4bc0fc9d4a 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -122,7 +122,7 @@ type instance XCImportDecl GhcPs = EpAnn EpAnnImportDecl
type instance XCImportDecl GhcRn = NoExtField
type instance XCImportDecl GhcTc = NoExtField
-type instance XXImportDecl (GhcPass _) = NoExtCon
+type instance XXImportDecl (GhcPass _) = DataConCantHappen
type instance Anno ModuleName = SrcSpanAnnA
type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnL
@@ -303,7 +303,7 @@ type instance XIEModuleContents GhcTc = NoExtField
type instance XIEGroup (GhcPass _) = NoExtField
type instance XIEDoc (GhcPass _) = NoExtField
type instance XIEDocNamed (GhcPass _) = NoExtField
-type instance XXIE (GhcPass _) = NoExtCon
+type instance XXIE (GhcPass _) = DataConCantHappen
type instance Anno (LocatedA (IE (GhcPass p))) = SrcSpanAnnA
diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs
index 9341827a79..3b9b6948c6 100644
--- a/compiler/GHC/Hs/Lit.hs
+++ b/compiler/GHC/Hs/Lit.hs
@@ -55,7 +55,7 @@ type instance XHsInteger (GhcPass _) = SourceText
type instance XHsRat (GhcPass _) = NoExtField
type instance XHsFloatPrim (GhcPass _) = NoExtField
type instance XHsDoublePrim (GhcPass _) = NoExtField
-type instance XXLit (GhcPass _) = NoExtCon
+type instance XXLit (GhcPass _) = DataConCantHappen
data OverLitRn
= OverLitRn {
@@ -98,7 +98,7 @@ pprXOverLit GhcPs noExt = ppr noExt
pprXOverLit GhcRn OverLitRn{ ol_from_fun = from_fun } = ppr from_fun
pprXOverLit GhcTc OverLitTc{ ol_witness = witness } = pprExpr witness
-type instance XXOverLit (GhcPass _) = NoExtCon
+type instance XXOverLit (GhcPass _) = DataConCantHappen
overLitType :: HsOverLit GhcTc -> Type
overLitType (OverLit OverLitTc{ ol_type = ty } _) = ty
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index a98070c6a7..43f161f9bd 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -82,7 +82,6 @@ import GHC.Types.Name (Name)
import GHC.Driver.Session
import qualified GHC.LanguageExtensions as LangExt
import Data.Data
-import Data.Void
type instance XWildPat GhcPs = NoExtField
@@ -139,7 +138,7 @@ type instance XViewPat GhcTc = Type
type instance XSplicePat GhcPs = NoExtField
type instance XSplicePat GhcRn = NoExtField
-type instance XSplicePat GhcTc = Void -- See Note [Constructor cannot occur]
+type instance XSplicePat GhcTc = DataConCantHappen
type instance XLitPat (GhcPass _) = NoExtField
@@ -155,7 +154,7 @@ type instance XSigPat GhcPs = EpAnn [AddEpAnn]
type instance XSigPat GhcRn = NoExtField
type instance XSigPat GhcTc = Type
-type instance XXPat GhcPs = NoExtCon
+type instance XXPat GhcPs = DataConCantHappen
type instance XXPat GhcRn = HsPatExpansion (Pat GhcRn) (Pat GhcRn)
-- Original pattern and its desugaring/expansion.
-- See Note [Rebindable syntax and HsExpansion].
@@ -356,7 +355,7 @@ pprPat (ConPat { pat_con = con
pprPat (XPat ext) = case ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
- GhcPs -> noExtCon ext
+ GhcPs -> dataConCantHappen ext
#endif
GhcRn -> case ext of
HsPatExpanded orig _ -> pprPat orig
@@ -567,7 +566,7 @@ isIrrefutableHsPat' is_strict = goL
go (XPat ext) = case ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
- GhcPs -> noExtCon ext
+ GhcPs -> dataConCantHappen ext
#endif
GhcRn -> case ext of
HsPatExpanded _ pat -> go pat
@@ -630,7 +629,7 @@ patNeedsParens p = go @p
go (ViewPat {}) = True
go (XPat ext) = case ghcPass @q of
#if __GLASGOW_HASKELL__ < 901
- GhcPs -> noExtCon ext
+ GhcPs -> dataConCantHappen ext
#endif
GhcRn -> case ext of
HsPatExpanded orig _ -> go orig
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 0e6d8564ae..2b17df420e 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -149,7 +149,7 @@ type instance XHsForAllVis (GhcPass _) = EpAnnForallTy
type instance XHsForAllInvis (GhcPass _) = EpAnnForallTy
-- Location of 'forall' and '.'
-type instance XXHsForAllTelescope (GhcPass _) = NoExtCon
+type instance XXHsForAllTelescope (GhcPass _) = DataConCantHappen
type EpAnnForallTy = EpAnn (AddEpAnn, AddEpAnn)
-- ^ Location of 'forall' and '->' for HsForAllVis
@@ -163,7 +163,7 @@ type instance XHsQTvs GhcPs = NoExtField
type instance XHsQTvs GhcRn = HsQTvsRn
type instance XHsQTvs GhcTc = HsQTvsRn
-type instance XXLHsQTyVars (GhcPass _) = NoExtCon
+type instance XXLHsQTyVars (GhcPass _) = DataConCantHappen
mkHsForAllVisTele ::EpAnnForallTy ->
[LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
@@ -192,22 +192,22 @@ type instance XHsOuterExplicit GhcPs _ = EpAnnForallTy
type instance XHsOuterExplicit GhcRn _ = NoExtField
type instance XHsOuterExplicit GhcTc flag = [VarBndr TyVar flag]
-type instance XXHsOuterTyVarBndrs (GhcPass _) = NoExtCon
+type instance XXHsOuterTyVarBndrs (GhcPass _) = DataConCantHappen
type instance XHsWC GhcPs b = NoExtField
type instance XHsWC GhcRn b = [Name]
type instance XHsWC GhcTc b = [Name]
-type instance XXHsWildCardBndrs (GhcPass _) _ = NoExtCon
+type instance XXHsWildCardBndrs (GhcPass _) _ = DataConCantHappen
type instance XHsPS GhcPs = EpAnn EpaLocation
type instance XHsPS GhcRn = HsPSRn
type instance XHsPS GhcTc = HsPSRn
-type instance XXHsPatSigType (GhcPass _) = NoExtCon
+type instance XXHsPatSigType (GhcPass _) = DataConCantHappen
type instance XHsSig (GhcPass _) = NoExtField
-type instance XXHsSigType (GhcPass _) = NoExtCon
+type instance XXHsSigType (GhcPass _) = DataConCantHappen
hsSigWcType :: forall p. UnXRec p => LHsSigWcType p -> LHsType p
hsSigWcType = sig_body . unXRec @p . hswc_body
@@ -262,7 +262,7 @@ mkEmptyWildCardBndrs x = HsWC { hswc_body = x
type instance XUserTyVar (GhcPass _) = EpAnn [AddEpAnn]
type instance XKindedTyVar (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXTyVarBndr (GhcPass _) = NoExtCon
+type instance XXTyVarBndr (GhcPass _) = DataConCantHappen
-- | Return the attached flag
hsTyVarBndrFlag :: HsTyVarBndr flag (GhcPass pass) -> flag
@@ -361,7 +361,7 @@ pprHsArrow (HsLinearArrow _) = lollipop
pprHsArrow (HsExplicitMult _ p _) = mulArrow (ppr p)
type instance XConDeclField (GhcPass _) = EpAnn [AddEpAnn]
-type instance XXConDeclField (GhcPass _) = NoExtCon
+type instance XXConDeclField (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=> Outputable (ConDeclField (GhcPass p)) where
@@ -807,7 +807,7 @@ type instance XCFieldOcc GhcPs = NoExtField
type instance XCFieldOcc GhcRn = Name
type instance XCFieldOcc GhcTc = Id
-type instance XXFieldOcc (GhcPass _) = NoExtCon
+type instance XXFieldOcc (GhcPass _) = DataConCantHappen
mkFieldOcc :: LocatedN RdrName -> FieldOcc GhcPs
mkFieldOcc rdr = FieldOcc noExtField rdr
@@ -821,7 +821,7 @@ type instance XAmbiguous GhcPs = NoExtField
type instance XAmbiguous GhcRn = NoExtField
type instance XAmbiguous GhcTc = Id
-type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon
+type instance XXAmbiguousFieldOcc (GhcPass _) = DataConCantHappen
instance Outputable (AmbiguousFieldOcc (GhcPass p)) where
ppr = ppr . rdrNameAmbiguousFieldOcc
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index c32ec443af..d53fc51786 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -1235,7 +1235,7 @@ class UnXRec p => CollectPass p where
instance IsPass p => CollectPass (GhcPass p) where
collectXXPat _ flag ext =
case ghcPass @p of
- GhcPs -> noExtCon ext
+ GhcPs -> dataConCantHappen ext
GhcRn
| HsPatExpanded _ pat <- ext
-> collect_pat flag pat
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 9c71235a98..0c74db385d 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1890,7 +1890,7 @@ instance HiePass p => ToHie (LocatedA (HsSplice (GhcPass p))) where
[]
XSplice x -> case hiePass @p of
#if __GLASGOW_HASKELL__ < 811
- HieRn -> noExtCon x
+ HieRn -> dataConCantHappen x
#endif
HieTc -> case x of
HsSplicedT _ -> []
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 1e24c1bb3d..c4f12cf243 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -2190,7 +2190,7 @@ isStrictPattern (L loc pat) =
SplicePat{} -> True
XPat ext -> case ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
- GhcPs -> noExtCon ext
+ GhcPs -> dataConCantHappen ext
#endif
GhcRn
| HsPatExpanded _ p <- ext
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 6739e9a375..b6573897e2 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -881,7 +881,7 @@ tcExpr e@(HsRnBracketOut _ brack ps) res_ty = tcUntypedBracket e brack ps res_ty
tcExpr (HsOverLabel {}) ty = pprPanic "tcExpr:HsOverLabel" (ppr ty)
tcExpr (SectionL {}) ty = pprPanic "tcExpr:SectionL" (ppr ty)
tcExpr (SectionR {}) ty = pprPanic "tcExpr:SectionR" (ppr ty)
-tcExpr (HsTcBracketOut {}) ty = pprPanic "tcExpr:HsTcBracketOut" (ppr ty)
+tcExpr (HsTcBracketOut x _ _ _) _ = dataConCantHappen x
{-
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index 8d8eadf135..9c0cc0408b 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -65,7 +65,7 @@ See also Note [IsPass] and Note [NoGhcTc] in GHC.Hs.Extension.
-- | A placeholder type for TTG extension points that are not currently
-- unused to represent any particular value.
--
--- This should not be confused with 'NoExtCon', which are found in unused
+-- This should not be confused with 'DataConCantHappen', which are found in unused
-- extension /constructors/ and therefore should never be inhabited. In
-- contrast, 'NoExtField' is used in extension /points/ (e.g., as the field of
-- some constructor), so it must have an inhabitant to construct AST passes
@@ -80,24 +80,43 @@ instance Outputable NoExtField where
noExtField :: NoExtField
noExtField = NoExtField
--- | Used in TTG extension constructors that have yet to be extended with
--- anything. If an extension constructor has 'NoExtCon' as its field, it is
--- not intended to ever be constructed anywhere, and any function that consumes
--- the extension constructor can eliminate it by way of 'noExtCon'.
---
--- This should not be confused with 'NoExtField', which are found in unused
--- extension /points/ (not /constructors/) and therefore can be inhabited.
+{-
+Note [Constructor cannot occur]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Some data constructors can't occur in certain phases; e.g. the output
+of the type checker never has OverLabel. We signal this by
+* setting the extension field to DataConCantHappen
+* using dataConCantHappen in the cases that can't happen
+
+For example:
+
+ type instance XOverLabel GhcTc = DataConCantHappen
--- See also [NoExtCon and strict fields].
-data NoExtCon
+ dsExpr :: HsExpr GhcTc -> blah
+ dsExpr (HsOverLabel x _) = dataConCantHappen x
+
+The function dataConCantHappen is defined thus:
+ dataConCantHappen :: DataConCantHappen -> a
+ dataConCantHappen x = case x of {}
+(i.e. identically to Data.Void.absurd, but more helpfully named).
+Remember DataConCantHappen is a type whose only element is bottom.
+
+This should not be confused with 'NoExtField', which are found in unused
+extension /points/ (not /constructors/) and therefore can be inhabited.
+
+It would be better to omit the pattern match altogether, but we
+can only do that if the extension field was strict (#18764).
+See also [DataConCantHappen and strict fields].
+-}
+data DataConCantHappen
deriving (Data,Eq,Ord)
-instance Outputable NoExtCon where
- ppr = noExtCon
+instance Outputable DataConCantHappen where
+ ppr = dataConCantHappen
--- | Eliminate a 'NoExtCon'. Much like 'Data.Void.absurd'.
-noExtCon :: NoExtCon -> a
-noExtCon x = case x of {}
+-- | Eliminate a 'DataConCantHappen'. See Note [Constructor cannot happen].
+dataConCantHappen :: DataConCantHappen -> a
+dataConCantHappen x = case x of {}
-- | GHC's L prefixed variants wrap their vanilla variant in this type family,
-- to add 'SrcLoc' info via 'Located'. Other passes than 'GhcPass' not
diff --git a/utils/haddock b/utils/haddock
-Subproject f7bfa0013f2bc3934a63ea7af21fe41a4e91058
+Subproject 8a73a5babd07530326f1ba06bdfe95f49f66b96
View Lorry Controller Status