summaryrefslogtreecommitdiff
path: root/compiler/hsSyn
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2019-03-19 17:47:55 -0400
committerBen Gamari <ben@well-typed.com>2019-07-09 11:52:45 -0400
commit6a03d77b9a9915e4b37fe1ea6688c135e7b00654 (patch)
tree4154abaa768adbfadc4eb17db620c3ed08b82c5f /compiler/hsSyn
parent5af815f2e43e9f1b5ca9ec0803f9fccabb49e2fe (diff)
downloadhaskell-6a03d77b9a9915e4b37fe1ea6688c135e7b00654.tar.gz
Use an empty data type in TTG extension constructors (#15247)
To avoid having to `panic` any time a TTG extension constructor is consumed, this MR introduces an uninhabited 'NoExtCon' type and uses that in every extension constructor's type family instance where it is appropriate. This also introduces a 'noExtCon' function which eliminates a 'NoExtCon', much like 'Data.Void.absurd' eliminates a 'Void'. I also renamed the existing `NoExt` type to `NoExtField` to better distinguish it from `NoExtCon`. Unsurprisingly, there is a lot of code churn resulting from this. Bumps the Haddock submodule. Fixes #15247.
Diffstat (limited to 'compiler/hsSyn')
-rw-r--r--compiler/hsSyn/Convert.hs376
-rw-r--r--compiler/hsSyn/HsBinds.hs74
-rw-r--r--compiler/hsSyn/HsDecls.hs182
-rw-r--r--compiler/hsSyn/HsExpr.hs249
-rw-r--r--compiler/hsSyn/HsExtension.hs79
-rw-r--r--compiler/hsSyn/HsImpExp.hs30
-rw-r--r--compiler/hsSyn/HsLit.hs16
-rw-r--r--compiler/hsSyn/HsPat.hs54
-rw-r--r--compiler/hsSyn/HsTypes.hs154
-rw-r--r--compiler/hsSyn/HsUtils.hs216
10 files changed, 749 insertions, 681 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 97329aaa55..ee6553ce04 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -147,16 +147,16 @@ cvtDec (TH.ValD pat body ds)
| TH.VarP s <- pat
= do { s' <- vNameL s
; cl' <- cvtClause (mkPrefixFunRhs s') (Clause [] body ds)
- ; returnJustL $ Hs.ValD noExt $ mkFunBind s' [cl'] }
+ ; returnJustL $ Hs.ValD noExtField $ mkFunBind s' [cl'] }
| otherwise
= do { pat' <- cvtPat pat
; body' <- cvtGuard body
; ds' <- cvtLocalDecs (text "a where clause") ds
- ; returnJustL $ Hs.ValD noExt $
+ ; returnJustL $ Hs.ValD noExtField $
PatBind { pat_lhs = pat'
- , pat_rhs = GRHSs noExt body' (noLoc ds')
- , pat_ext = noExt
+ , pat_rhs = GRHSs noExtField body' (noLoc ds')
+ , pat_ext = noExtField
, pat_ticks = ([],[]) } }
cvtDec (TH.FunD nm cls)
@@ -167,13 +167,13 @@ cvtDec (TH.FunD nm cls)
| otherwise
= do { nm' <- vNameL nm
; cls' <- mapM (cvtClause (mkPrefixFunRhs nm')) cls
- ; returnJustL $ Hs.ValD noExt $ mkFunBind nm' cls' }
+ ; returnJustL $ Hs.ValD noExtField $ mkFunBind nm' cls' }
cvtDec (TH.SigD nm typ)
= do { nm' <- vNameL nm
; ty' <- cvtType typ
- ; returnJustL $ Hs.SigD noExt
- (TypeSig noExt [nm'] (mkLHsSigWcType ty')) }
+ ; returnJustL $ Hs.SigD noExtField
+ (TypeSig noExtField [nm'] (mkLHsSigWcType ty')) }
cvtDec (TH.InfixD fx nm)
-- Fixity signatures are allowed for variables, constructors, and types
@@ -181,8 +181,8 @@ cvtDec (TH.InfixD fx nm)
-- the RdrName says it's a variable or a constructor. So, just assume
-- it's a variable or constructor and proceed.
= do { nm' <- vcNameL nm
- ; returnJustL (Hs.SigD noExt (FixSig noExt
- (FixitySig noExt [nm'] (cvtFixity fx)))) }
+ ; returnJustL (Hs.SigD noExtField (FixSig noExtField
+ (FixitySig noExtField [nm'] (cvtFixity fx)))) }
cvtDec (PragmaD prag)
= cvtPragmaD prag
@@ -190,8 +190,8 @@ cvtDec (PragmaD prag)
cvtDec (TySynD tc tvs rhs)
= do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
; rhs' <- cvtType rhs
- ; returnJustL $ TyClD noExt $
- SynDecl { tcdSExt = noExt, tcdLName = tc', tcdTyVars = tvs'
+ ; returnJustL $ TyClD noExtField $
+ SynDecl { tcdSExt = noExtField, tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdRhs = rhs' } }
@@ -211,33 +211,33 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs)
; ksig' <- cvtKind `traverse` ksig
; cons' <- mapM cvtConstr constrs
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExt
+ ; let defn = HsDataDefn { dd_ext = noExtField
, dd_ND = DataType, dd_cType = Nothing
, dd_ctxt = ctxt'
, dd_kindSig = ksig'
, dd_cons = cons', dd_derivs = derivs' }
- ; returnJustL $ TyClD noExt (DataDecl
- { tcdDExt = noExt
- , tcdLName = tc', tcdTyVars = tvs'
- , tcdFixity = Prefix
- , tcdDataDefn = defn }) }
+ ; returnJustL $ TyClD noExtField $
+ DataDecl { tcdDExt = noExtField
+ , tcdLName = tc', tcdTyVars = tvs'
+ , tcdFixity = Prefix
+ , tcdDataDefn = defn } }
cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
= do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
; ksig' <- cvtKind `traverse` ksig
; con' <- cvtConstr constr
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExt
+ ; let defn = HsDataDefn { dd_ext = noExtField
, dd_ND = NewType, dd_cType = Nothing
, dd_ctxt = ctxt'
, dd_kindSig = ksig'
, dd_cons = [con']
, dd_derivs = derivs' }
- ; returnJustL $ TyClD noExt (DataDecl
- { tcdDExt = noExt
- , tcdLName = tc', tcdTyVars = tvs'
- , tcdFixity = Prefix
- , tcdDataDefn = defn }) }
+ ; returnJustL $ TyClD noExtField $
+ DataDecl { tcdDExt = noExtField
+ , tcdLName = tc', tcdTyVars = tvs'
+ , tcdFixity = Prefix
+ , tcdDataDefn = defn } }
cvtDec (ClassD ctxt cl tvs fds decs)
= do { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs
@@ -247,8 +247,8 @@ cvtDec (ClassD ctxt cl tvs fds decs)
(failWith $ (text "Default data instance declarations"
<+> text "are not allowed:")
$$ (Outputable.ppr adts'))
- ; returnJustL $ TyClD noExt $
- ClassDecl { tcdCExt = noExt
+ ; returnJustL $ TyClD noExtField $
+ ClassDecl { tcdCExt = noExtField
, tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs'
@@ -264,8 +264,8 @@ cvtDec (InstanceD o ctxt ty decs)
; ctxt' <- cvtContext funPrec ctxt
; (dL->L loc ty') <- cvtType ty
; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty'
- ; returnJustL $ InstD noExt $ ClsInstD noExt $
- ClsInstDecl { cid_ext = noExt, cid_poly_ty = mkLHsSigType inst_ty'
+ ; returnJustL $ InstD noExtField $ ClsInstD noExtField $
+ ClsInstDecl { cid_ext = noExtField, cid_poly_ty = mkLHsSigType inst_ty'
, cid_binds = binds'
, cid_sigs = Hs.mkClassOpSigs sigs'
, cid_tyfam_insts = ats', cid_datafam_insts = adts'
@@ -283,29 +283,29 @@ cvtDec (InstanceD o ctxt ty decs)
cvtDec (ForeignD ford)
= do { ford' <- cvtForD ford
- ; returnJustL $ ForD noExt ford' }
+ ; returnJustL $ ForD noExtField ford' }
cvtDec (DataFamilyD tc tvs kind)
= do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
; result <- cvtMaybeKindToFamilyResultSig kind
- ; returnJustL $ TyClD noExt $ FamDecl noExt $
- FamilyDecl noExt DataFamily tc' tvs' Prefix result Nothing }
+ ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+ FamilyDecl noExtField DataFamily tc' tvs' Prefix result Nothing }
cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
= do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
; ksig' <- cvtKind `traverse` ksig
; cons' <- mapM cvtConstr constrs
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExt
+ ; let defn = HsDataDefn { dd_ext = noExtField
, dd_ND = DataType, dd_cType = Nothing
, dd_ctxt = ctxt'
, dd_kindSig = ksig'
, dd_cons = cons', dd_derivs = derivs' }
- ; returnJustL $ InstD noExt $ DataFamInstD
- { dfid_ext = noExt
+ ; returnJustL $ InstD noExtField $ DataFamInstD
+ { dfid_ext = noExtField
, dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
- FamEqn { feqn_ext = noExt
+ FamEqn { feqn_ext = noExtField
, feqn_tycon = tc'
, feqn_bndrs = bndrs'
, feqn_pats = typats'
@@ -317,15 +317,15 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
; ksig' <- cvtKind `traverse` ksig
; con' <- cvtConstr constr
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExt
+ ; let defn = HsDataDefn { dd_ext = noExtField
, dd_ND = NewType, dd_cType = Nothing
, dd_ctxt = ctxt'
, dd_kindSig = ksig'
, dd_cons = [con'], dd_derivs = derivs' }
- ; returnJustL $ InstD noExt $ DataFamInstD
- { dfid_ext = noExt
+ ; returnJustL $ InstD noExtField $ DataFamInstD
+ { dfid_ext = noExtField
, dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
- FamEqn { feqn_ext = noExt
+ FamEqn { feqn_ext = noExtField
, feqn_tycon = tc'
, feqn_bndrs = bndrs'
, feqn_pats = typats'
@@ -334,35 +334,35 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
cvtDec (TySynInstD eqn)
= do { (dL->L _ eqn') <- cvtTySynEqn eqn
- ; returnJustL $ InstD noExt $ TyFamInstD
- { tfid_ext = noExt
+ ; returnJustL $ InstD noExtField $ TyFamInstD
+ { tfid_ext = noExtField
, tfid_inst = TyFamInstDecl { tfid_eqn = eqn' } } }
cvtDec (OpenTypeFamilyD head)
= do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
- ; returnJustL $ TyClD noExt $ FamDecl noExt $
- FamilyDecl noExt OpenTypeFamily tc' tyvars' Prefix result' injectivity'
+ ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+ FamilyDecl noExtField OpenTypeFamily tc' tyvars' Prefix result' injectivity'
}
cvtDec (ClosedTypeFamilyD head eqns)
= do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
; eqns' <- mapM cvtTySynEqn eqns
- ; returnJustL $ TyClD noExt $ FamDecl noExt $
- FamilyDecl noExt (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix
+ ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+ FamilyDecl noExtField (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix
result' injectivity' }
cvtDec (TH.RoleAnnotD tc roles)
= do { tc' <- tconNameL tc
; let roles' = map (noLoc . cvtRole) roles
- ; returnJustL $ Hs.RoleAnnotD noExt (RoleAnnotDecl noExt tc' roles') }
+ ; returnJustL $ Hs.RoleAnnotD noExtField (RoleAnnotDecl noExtField tc' roles') }
cvtDec (TH.StandaloneDerivD ds cxt ty)
= do { cxt' <- cvtContext funPrec cxt
; ds' <- traverse cvtDerivStrategy ds
; (dL->L loc ty') <- cvtType ty
; let inst_ty' = mkHsQualTy cxt loc cxt' $ cL loc ty'
- ; returnJustL $ DerivD noExt $
- DerivDecl { deriv_ext =noExt
+ ; returnJustL $ DerivD noExtField $
+ DerivDecl { deriv_ext =noExtField
, deriv_strategy = ds'
, deriv_type = mkLHsSigWcType inst_ty'
, deriv_overlap_mode = Nothing } }
@@ -370,16 +370,16 @@ cvtDec (TH.StandaloneDerivD ds cxt ty)
cvtDec (TH.DefaultSigD nm typ)
= do { nm' <- vNameL nm
; ty' <- cvtType typ
- ; returnJustL $ Hs.SigD noExt
- $ ClassOpSig noExt True [nm'] (mkLHsSigType ty')}
+ ; returnJustL $ Hs.SigD noExtField
+ $ ClassOpSig noExtField True [nm'] (mkLHsSigType ty')}
cvtDec (TH.PatSynD nm args dir pat)
= do { nm' <- cNameL nm
; args' <- cvtArgs args
; dir' <- cvtDir nm' dir
; pat' <- cvtPat pat
- ; returnJustL $ Hs.ValD noExt $ PatSynBind noExt $
- PSB noExt nm' args' pat' dir' }
+ ; returnJustL $ Hs.ValD noExtField $ PatSynBind noExtField $
+ PSB noExtField nm' args' pat' dir' }
where
cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon <$> mapM vNameL args
cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixCon <$> vNameL a1 <*> vNameL a2
@@ -397,7 +397,7 @@ cvtDec (TH.PatSynD nm args dir pat)
cvtDec (TH.PatSynSigD nm ty)
= do { nm' <- cNameL nm
; ty' <- cvtPatSynSigTy ty
- ; returnJustL $ Hs.SigD noExt $ PatSynSig noExt [nm'] (mkLHsSigType ty')}
+ ; returnJustL $ Hs.SigD noExtField $ PatSynSig noExtField [nm'] (mkLHsSigType ty')}
-- Implicit parameter bindings are handled in cvtLocalDecs and
-- cvtImplicitParamBind. They are not allowed in any other scope, so
@@ -415,7 +415,7 @@ cvtTySynEqn (TySynEqn mb_bndrs lhs rhs)
; rhs' <- cvtType rhs
; let args' = map wrap_tyarg args
; returnL $ mkHsImplicitBndrs
- $ FamEqn { feqn_ext = noExt
+ $ FamEqn { feqn_ext = noExtField
, feqn_tycon = nm'
, feqn_bndrs = mb_bndrs'
, feqn_pats = args'
@@ -425,7 +425,7 @@ cvtTySynEqn (TySynEqn mb_bndrs lhs rhs)
; args' <- mapM cvtType [t1,t2]
; rhs' <- cvtType rhs
; returnL $ mkHsImplicitBndrs
- $ FamEqn { feqn_ext = noExt
+ $ FamEqn { feqn_ext = noExtField
, feqn_tycon = nm'
, feqn_bndrs = mb_bndrs'
, feqn_pats =
@@ -587,7 +587,7 @@ cvtConstr (ForallC tvs ctxt con)
where
all_tvs = hsQTvExplicit tvs' ++ ex_tvs
- add_forall _ _ (XConDecl _) = panic "cvtConstr"
+ add_forall _ _ (XConDecl nec) = noExtCon nec
cvtConstr (GadtC c strtys ty)
= do { c' <- mapM cNameL c
@@ -600,8 +600,8 @@ cvtConstr (RecGadtC c varstrtys ty)
= do { c' <- mapM cNameL c
; ty' <- cvtType ty
; rec_flds <- mapM cvt_id_arg varstrtys
- ; let rec_ty = noLoc (HsFunTy noExt
- (noLoc $ HsRecTy noExt rec_flds) ty')
+ ; let rec_ty = noLoc (HsFunTy noExtField
+ (noLoc $ HsRecTy noExtField rec_flds) ty')
; returnL $ fst $ mkGadtDecl c' rec_ty }
cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness
@@ -620,16 +620,16 @@ cvt_arg (Bang su ss, ty)
; let ty' = parenthesizeHsType appPrec ty''
su' = cvtSrcUnpackedness su
ss' = cvtSrcStrictness ss
- ; returnL $ HsBangTy noExt (HsSrcBang NoSourceText su' ss') ty' }
+ ; returnL $ HsBangTy noExtField (HsSrcBang NoSourceText su' ss') ty' }
cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)
cvt_id_arg (i, str, ty)
= do { (dL->L li i') <- vNameL i
; ty' <- cvt_arg (str,ty)
; return $ noLoc (ConDeclField
- { cd_fld_ext = noExt
+ { cd_fld_ext = noExtField
, cd_fld_names
- = [cL li $ FieldOcc noExt (cL li i')]
+ = [cL li $ FieldOcc noExtField (cL li i')]
, cd_fld_type = ty'
, cd_fld_doc = Nothing}) }
@@ -667,7 +667,7 @@ cvtForD (ImportF callconv safety from nm ty)
mk_imp impspec
= do { nm' <- vNameL nm
; ty' <- cvtType ty
- ; return (ForeignImport { fd_i_ext = noExt
+ ; return (ForeignImport { fd_i_ext = noExtField
, fd_name = nm'
, fd_sig_ty = mkLHsSigType ty'
, fd_fi = impspec })
@@ -684,7 +684,7 @@ cvtForD (ExportF callconv as nm ty)
(mkFastString as)
(cvt_conv callconv)))
(noLoc (SourceText as))
- ; return $ ForeignExport { fd_e_ext = noExt
+ ; return $ ForeignExport { fd_e_ext = noExtField
, fd_name = nm'
, fd_sig_ty = mkLHsSigType ty'
, fd_fe = e } }
@@ -712,7 +712,7 @@ cvtPragmaD (InlineP nm inline rm phases)
, inl_rule = cvtRuleMatch rm
, inl_act = cvtPhases phases dflt
, inl_sat = Nothing }
- ; returnJustL $ Hs.SigD noExt $ InlineSig noExt nm' ip }
+ ; returnJustL $ Hs.SigD noExtField $ InlineSig noExtField nm' ip }
cvtPragmaD (SpecialiseP nm ty inline phases)
= do { nm' <- vNameL nm
@@ -730,12 +730,12 @@ cvtPragmaD (SpecialiseP nm ty inline phases)
, inl_rule = Hs.FunLike
, inl_act = cvtPhases phases dflt
, inl_sat = Nothing }
- ; returnJustL $ Hs.SigD noExt $ SpecSig noExt nm' [mkLHsSigType ty'] ip }
+ ; returnJustL $ Hs.SigD noExtField $ SpecSig noExtField nm' [mkLHsSigType ty'] ip }
cvtPragmaD (SpecialiseInstP ty)
= do { ty' <- cvtType ty
- ; returnJustL $ Hs.SigD noExt $
- SpecInstSig noExt (SourceText "{-# SPECIALISE") (mkLHsSigType ty') }
+ ; returnJustL $ Hs.SigD noExtField $
+ SpecInstSig noExtField (SourceText "{-# SPECIALISE") (mkLHsSigType ty') }
cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)
= do { let nm' = mkFastString nm
@@ -744,11 +744,11 @@ cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)
; tm_bndrs' <- mapM cvtRuleBndr tm_bndrs
; lhs' <- cvtl lhs
; rhs' <- cvtl rhs
- ; returnJustL $ Hs.RuleD noExt
- $ HsRules { rds_ext = noExt
+ ; returnJustL $ Hs.RuleD noExtField
+ $ HsRules { rds_ext = noExtField
, rds_src = SourceText "{-# RULES"
, rds_rules = [noLoc $
- HsRule { rd_ext = noExt
+ HsRule { rd_ext = noExtField
, rd_name = (noLoc (quotedSourceText nm,nm'))
, rd_act = act
, rd_tyvs = ty_bndrs'
@@ -768,8 +768,8 @@ cvtPragmaD (AnnP target exp)
ValueAnnotation n -> do
n' <- vcName n
return (ValueAnnProvenance (noLoc n'))
- ; returnJustL $ Hs.AnnD noExt
- $ HsAnnotation noExt (SourceText "{-# ANN") target' exp'
+ ; returnJustL $ Hs.AnnD noExtField
+ $ HsAnnotation noExtField (SourceText "{-# ANN") target' exp'
}
cvtPragmaD (LineP line file)
@@ -779,8 +779,8 @@ cvtPragmaD (LineP line file)
cvtPragmaD (CompleteP cls mty)
= do { cls' <- noLoc <$> mapM cNameL cls
; mty' <- traverse tconNameL mty
- ; returnJustL $ Hs.SigD noExt
- $ CompleteMatchSig noExt NoSourceText cls' mty' }
+ ; returnJustL $ Hs.SigD noExtField
+ $ CompleteMatchSig noExtField NoSourceText cls' mty' }
dfltActivation :: TH.Inline -> Activation
dfltActivation TH.NoInline = NeverActive
@@ -803,11 +803,11 @@ cvtPhases (BeforePhase i) _ = ActiveBefore NoSourceText i
cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)
cvtRuleBndr (RuleVar n)
= do { n' <- vNameL n
- ; return $ noLoc $ Hs.RuleBndr noExt n' }
+ ; return $ noLoc $ Hs.RuleBndr noExtField n' }
cvtRuleBndr (TypedRuleVar n ty)
= do { n' <- vNameL n
; ty' <- cvtType ty
- ; return $ noLoc $ Hs.RuleBndrSig noExt n' $ mkLHsSigWcType ty' }
+ ; return $ noLoc $ Hs.RuleBndrSig noExtField n' $ mkLHsSigWcType ty' }
---------------------------------------------------
-- Declarations
@@ -816,16 +816,16 @@ cvtRuleBndr (TypedRuleVar n ty)
cvtLocalDecs :: MsgDoc -> [TH.Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs doc ds
= case partitionWith is_ip_bind ds of
- ([], []) -> return (EmptyLocalBinds noExt)
+ ([], []) -> return (EmptyLocalBinds noExtField)
([], _) -> do
ds' <- cvtDecs ds
let (binds, prob_sigs) = partitionWith is_bind ds'
let (sigs, bads) = partitionWith is_sig prob_sigs
unless (null bads) (failWith (mkBadDecMsg doc bads))
- return (HsValBinds noExt (ValBinds noExt (listToBag binds) sigs))
+ return (HsValBinds noExtField (ValBinds noExtField (listToBag binds) sigs))
(ip_binds, []) -> do
binds <- mapM (uncurry cvtImplicitParamBind) ip_binds
- return (HsIPBinds noExt (IPBinds noExt binds))
+ return (HsIPBinds noExtField (IPBinds noExtField binds))
((_:_), (_:_)) ->
failWith (text "Implicit parameters mixed with other bindings")
@@ -836,13 +836,13 @@ cvtClause ctxt (Clause ps body wheres)
; let pps = map (parenthesizePat appPrec) ps'
; g' <- cvtGuard body
; ds' <- cvtLocalDecs (text "a where clause") wheres
- ; returnL $ Hs.Match noExt ctxt pps (GRHSs noExt g' (noLoc ds')) }
+ ; returnL $ Hs.Match noExtField ctxt pps (GRHSs noExtField g' (noLoc ds')) }
cvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs)
cvtImplicitParamBind n e = do
n' <- wrapL (ipName n)
e' <- cvtl e
- returnL (IPBind noExt (Left n') e')
+ returnL (IPBind noExtField (Left n') e')
-------------------------------------------------------------------
-- Expressions
@@ -851,12 +851,12 @@ cvtImplicitParamBind n e = do
cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)
cvtl e = wrapL (cvt e)
where
- cvt (VarE s) = do { s' <- vName s; return $ HsVar noExt (noLoc s') }
- cvt (ConE s) = do { s' <- cName s; return $ HsVar noExt (noLoc s') }
+ cvt (VarE s) = do { s' <- vName s; return $ HsVar noExtField (noLoc s') }
+ cvt (ConE s) = do { s' <- cName s; return $ HsVar noExtField (noLoc s') }
cvt (LitE l)
- | overloadedLit l = go cvtOverLit (HsOverLit noExt)
+ | overloadedLit l = go cvtOverLit (HsOverLit noExtField)
(hsOverLitNeedsParens appPrec)
- | otherwise = go cvtLit (HsLit noExt)
+ | otherwise = go cvtLit (HsLit noExtField)
(hsLitNeedsParens appPrec)
where
go :: (Lit -> CvtM (l GhcPs))
@@ -866,17 +866,17 @@ cvtl e = wrapL (cvt e)
go cvt_lit mk_expr is_compound_lit = do
l' <- cvt_lit l
let e' = mk_expr l'
- return $ if is_compound_lit l' then HsPar noExt (noLoc e') else e'
+ return $ if is_compound_lit l' then HsPar noExtField (noLoc e') else e'
cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y
- ; return $ HsApp noExt (mkLHsPar x')
+ ; return $ HsApp noExtField (mkLHsPar x')
(mkLHsPar y')}
cvt (AppE x y) = do { x' <- cvtl x; y' <- cvtl y
- ; return $ HsApp noExt (mkLHsPar x')
+ ; return $ HsApp noExtField (mkLHsPar x')
(mkLHsPar y')}
cvt (AppTypeE e t) = do { e' <- cvtl e
; t' <- cvtType t
; let tp = parenthesizeHsType appPrec t'
- ; return $ HsAppType noExt e'
+ ; return $ HsAppType noExtField e'
$ mkHsWildCardBndrs tp }
cvt (LamE [] e) = cvt e -- Degenerate case. We convert the body as its
-- own expression to avoid pretty-printing
@@ -884,44 +884,44 @@ cvtl e = wrapL (cvt e)
-- lambda expressions. See #13856.
cvt (LamE ps e) = do { ps' <- cvtPats ps; e' <- cvtl e
; let pats = map (parenthesizePat appPrec) ps'
- ; return $ HsLam noExt (mkMatchGroup FromSource
+ ; return $ HsLam noExtField (mkMatchGroup FromSource
[mkSimpleMatch LambdaExpr
pats e'])}
cvt (LamCaseE ms) = do { ms' <- mapM (cvtMatch CaseAlt) ms
- ; return $ HsLamCase noExt
+ ; return $ HsLamCase noExtField
(mkMatchGroup FromSource ms')
}
- cvt (TupE [Just e]) = do { e' <- cvtl e; return $ HsPar noExt e' }
+ cvt (TupE [Just e]) = do { e' <- cvtl e; return $ HsPar noExtField e' }
-- Note [Dropping constructors]
-- Singleton tuples treated like nothing (just parens)
cvt (TupE es) = cvt_tup es Boxed
cvt (UnboxedTupE es) = cvt_tup es Unboxed
cvt (UnboxedSumE e alt arity) = do { e' <- cvtl e
; unboxedSumChecks alt arity
- ; return $ ExplicitSum noExt
+ ; return $ ExplicitSum noExtField
alt arity e'}
cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
- ; return $ HsIf noExt (Just noSyntaxExpr) x' y' z' }
+ ; return $ HsIf noExtField (Just noSyntaxExpr) x' y' z' }
cvt (MultiIfE alts)
| null alts = failWith (text "Multi-way if-expression with no alternatives")
| otherwise = do { alts' <- mapM cvtpair alts
- ; return $ HsMultiIf noExt alts' }
+ ; return $ HsMultiIf noExtField alts' }
cvt (LetE ds e) = do { ds' <- cvtLocalDecs (text "a let expression") ds
- ; e' <- cvtl e; return $ HsLet noExt (noLoc ds') e'}
+ ; e' <- cvtl e; return $ HsLet noExtField (noLoc ds') e'}
cvt (CaseE e ms) = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms
- ; return $ HsCase noExt e'
+ ; return $ HsCase noExtField e'
(mkMatchGroup FromSource ms') }
cvt (DoE ss) = cvtHsDo DoExpr ss
cvt (MDoE ss) = cvtHsDo MDoExpr ss
cvt (CompE ss) = cvtHsDo ListComp ss
cvt (ArithSeqE dd) = do { dd' <- cvtDD dd
- ; return $ ArithSeq noExt Nothing dd' }
+ ; return $ ArithSeq noExtField Nothing dd' }
cvt (ListE xs)
| Just s <- allCharLs xs = do { l' <- cvtLit (StringL s)
- ; return (HsLit noExt l') }
+ ; return (HsLit noExtField l') }
-- Note [Converting strings]
| otherwise = do { xs' <- mapM cvtl xs
- ; return $ ExplicitList noExt Nothing xs'
+ ; return $ ExplicitList noExtField Nothing xs'
}
-- Infix expressions
@@ -931,25 +931,25 @@ cvtl e = wrapL (cvt e)
; y' <- cvtl y
; let px = parenthesizeHsExpr opPrec x'
py = parenthesizeHsExpr opPrec y'
- ; wrapParL (HsPar noExt)
- $ OpApp noExt px s' py }
+ ; wrapParL (HsPar noExtField)
+ $ OpApp noExtField px s' py }
-- Parenthesise both arguments and result,
-- to ensure this operator application does
-- does not get re-associated
-- See Note [Operator association]
cvt (InfixE Nothing s (Just y)) = ensureValidOpExp s $
do { s' <- cvtl s; y' <- cvtl y
- ; wrapParL (HsPar noExt) $
- SectionR noExt s' y' }
+ ; wrapParL (HsPar noExtField) $
+ SectionR noExtField s' y' }
-- See Note [Sections in HsSyn] in HsExpr
cvt (InfixE (Just x) s Nothing ) = ensureValidOpExp s $
do { x' <- cvtl x; s' <- cvtl s
- ; wrapParL (HsPar noExt) $
- SectionL noExt x' s' }
+ ; wrapParL (HsPar noExtField) $
+ SectionL noExtField x' s' }
cvt (InfixE Nothing s Nothing ) = ensureValidOpExp s $
do { s' <- cvtl s
- ; return $ HsPar noExt s' }
+ ; return $ HsPar noExtField s' }
-- Can I indicate this is an infix thing?
-- Note [Dropping constructors]
@@ -960,10 +960,10 @@ cvtl e = wrapL (cvt e)
_ -> mkLHsPar x'
; cvtOpApp x'' s y } -- Note [Converting UInfix]
- cvt (ParensE e) = do { e' <- cvtl e; return $ HsPar noExt e' }
+ cvt (ParensE e) = do { e' <- cvtl e; return $ HsPar noExtField e' }
cvt (SigE e t) = do { e' <- cvtl e; t' <- cvtType t
; let pe = parenthesizeHsExpr sigPrec e'
- ; return $ ExprWithTySig noExt pe (mkLHsSigWcType t') }
+ ; return $ ExprWithTySig noExtField pe (mkLHsSigWcType t') }
cvt (RecConE c flds) = do { c' <- cNameL c
; flds' <- mapM (cvtFld (mkFieldOcc . noLoc)) flds
; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) }
@@ -972,14 +972,14 @@ cvtl e = wrapL (cvt e)
<- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))
flds
; return $ mkRdrRecordUpd e' flds' }
- cvt (StaticE e) = fmap (HsStatic noExt) $ cvtl e
+ cvt (StaticE e) = fmap (HsStatic noExtField) $ cvtl e
cvt (UnboundVarE s) = do -- Use of 'vcName' here instead of 'vName' is
-- important, because UnboundVarE may contain
-- constructor names - see #14627.
{ s' <- vcName s
- ; return $ HsVar noExt (noLoc s') }
- cvt (LabelE s) = do { return $ HsOverLabel noExt Nothing (fsLit s) }
- cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExt n' }
+ ; return $ HsVar noExtField (noLoc s') }
+ cvt (LabelE s) = do { return $ HsOverLabel noExtField Nothing (fsLit s) }
+ cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExtField n' }
{- | #16895 Ensure an infix expression's operator is a variable/constructor.
Consider this example:
@@ -1031,10 +1031,10 @@ cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; retur
cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
cvt_tup es boxity = do { let cvtl_maybe Nothing = return missingTupArg
- cvtl_maybe (Just e) = fmap (Present noExt) (cvtl e)
+ cvtl_maybe (Just e) = fmap (Present noExtField) (cvtl e)
; es' <- mapM cvtl_maybe es
; return $ ExplicitTuple
- noExt
+ noExtField
(map noLoc es')
boxity }
@@ -1097,7 +1097,7 @@ cvtOpApp x op1 (UInfixE y op2 z)
cvtOpApp x op y
= do { op' <- cvtl op
; y' <- cvtl y
- ; return (OpApp noExt x op' y') }
+ ; return (OpApp noExtField x op' y') }
-------------------------------------
-- Do notation and statements
@@ -1115,7 +1115,7 @@ cvtHsDo do_or_lc stmts
-> return (cL loc (mkLastStmt body))
_ -> failWith (bad_last last')
- ; return $ HsDo noExt do_or_lc (noLoc (stmts'' ++ [last''])) }
+ ; return $ HsDo noExtField do_or_lc (noLoc (stmts'' ++ [last''])) }
where
bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAStmtContext do_or_lc <> colon
, nest 2 $ Outputable.ppr stmt
@@ -1128,12 +1128,12 @@ cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))
cvtStmt (NoBindS e) = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
cvtStmt (TH.LetS ds) = do { ds' <- cvtLocalDecs (text "a let binding") ds
- ; returnL $ LetStmt noExt (noLoc ds') }
+ ; returnL $ LetStmt noExtField (noLoc ds') }
cvtStmt (TH.ParS dss) = do { dss' <- mapM cvt_one dss
- ; returnL $ ParStmt noExt dss' noExpr noSyntaxExpr }
+ ; returnL $ ParStmt noExtField dss' noExpr noSyntaxExpr }
where
cvt_one ds = do { ds' <- cvtStmts ds
- ; return (ParStmtBlock noExt ds' undefined noSyntaxExpr) }
+ ; return (ParStmtBlock noExtField ds' undefined noSyntaxExpr) }
cvtStmt (TH.RecS ss) = do { ss' <- mapM cvtStmt ss; returnL (mkRecStmt ss') }
cvtMatch :: HsMatchContext RdrName
@@ -1141,23 +1141,23 @@ cvtMatch :: HsMatchContext RdrName
cvtMatch ctxt (TH.Match p body decs)
= do { p' <- cvtPat p
; let lp = case p' of
- (dL->L loc SigPat{}) -> cL loc (ParPat NoExt p') -- #14875
+ (dL->L loc SigPat{}) -> cL loc (ParPat noExtField p') -- #14875
_ -> p'
; g' <- cvtGuard body
; decs' <- cvtLocalDecs (text "a where clause") decs
- ; returnL $ Hs.Match noExt ctxt [lp] (GRHSs noExt g' (noLoc decs')) }
+ ; returnL $ Hs.Match noExtField ctxt [lp] (GRHSs noExtField g' (noLoc decs')) }
cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
cvtGuard (GuardedB pairs) = mapM cvtpair pairs
cvtGuard (NormalB e) = do { e' <- cvtl e
- ; g' <- returnL $ GRHS noExt [] e'; return [g'] }
+ ; g' <- returnL $ GRHS noExtField [] e'; return [g'] }
cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
cvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs
; g' <- returnL $ mkBodyStmt ge'
- ; returnL $ GRHS noExt [g'] rhs' }
+ ; returnL $ GRHS noExtField [g'] rhs' }
cvtpair (PatG gs,rhs) = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
- ; returnL $ GRHS noExt gs' rhs' }
+ ; returnL $ GRHS noExtField gs' rhs' }
cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
cvtOverLit (IntegerL i)
@@ -1198,9 +1198,9 @@ cvtLit :: Lit -> CvtM (HsLit GhcPs)
cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim NoSourceText i }
cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim NoSourceText w }
cvtLit (FloatPrimL f)
- = do { force f; return $ HsFloatPrim noExt (mkFractionalLit f) }
+ = do { force f; return $ HsFloatPrim noExtField (mkFractionalLit f) }
cvtLit (DoublePrimL f)
- = do { force f; return $ HsDoublePrim noExt (mkFractionalLit f) }
+ = do { force f; return $ HsDoublePrim noExtField (mkFractionalLit f) }
cvtLit (CharL c) = do { force c; return $ HsChar NoSourceText c }
cvtLit (CharPrimL c) = do { force c; return $ HsCharPrim NoSourceText c }
cvtLit (StringL s) = do { let { s' = mkFastString s }
@@ -1234,24 +1234,24 @@ cvtp (TH.LitP l)
; return (mkNPat (noLoc l') Nothing) }
-- Not right for negative patterns;
-- need to think about that!
- | otherwise = do { l' <- cvtLit l; return $ Hs.LitPat noExt l' }
+ | otherwise = do { l' <- cvtLit l; return $ Hs.LitPat noExtField l' }
cvtp (TH.VarP s) = do { s' <- vName s
- ; return $ Hs.VarPat noExt (noLoc s') }
-cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat noExt p' }
+ ; return $ Hs.VarPat noExtField (noLoc s') }
+cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat noExtField p' }
-- Note [Dropping constructors]
cvtp (TupP ps) = do { ps' <- cvtPats ps
- ; return $ TuplePat noExt ps' Boxed }
+ ; return $ TuplePat noExtField ps' Boxed }
cvtp (UnboxedTupP ps) = do { ps' <- cvtPats ps
- ; return $ TuplePat noExt ps' Unboxed }
+ ; return $ TuplePat noExtField ps' Unboxed }
cvtp (UnboxedSumP p alt arity)
= do { p' <- cvtPat p
; unboxedSumChecks alt arity
- ; return $ SumPat noExt p' alt arity }
+ ; return $ SumPat noExtField p' alt arity }
cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps
; let pps = map (parenthesizePat appPrec) ps'
; return $ ConPatIn s' (PrefixCon pps) }
cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
- ; wrapParL (ParPat noExt) $
+ ; wrapParL (ParPat noExtField) $
ConPatIn s' $
InfixCon (parenthesizePat opPrec p1')
(parenthesizePat opPrec p2') }
@@ -1260,22 +1260,22 @@ cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Co
cvtp (ParensP p) = do { p' <- cvtPat p;
; case unLoc p' of -- may be wrapped ConPatIn
ParPat {} -> return $ unLoc p'
- _ -> return $ ParPat noExt p' }
-cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat noExt p' }
-cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat noExt p' }
+ _ -> return $ ParPat noExtField p' }
+cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat noExtField p' }
+cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat noExtField p' }
cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p
- ; return $ AsPat noExt s' p' }
-cvtp TH.WildP = return $ WildPat noExt
+ ; return $ AsPat noExtField s' p' }
+cvtp TH.WildP = return $ WildPat noExtField
cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
; return $ ConPatIn c'
$ Hs.RecCon (HsRecFields fs' Nothing) }
cvtp (ListP ps) = do { ps' <- cvtPats ps
; return
- $ ListPat noExt ps'}
+ $ ListPat noExtField ps'}
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
- ; return $ SigPat noExt p' (mkLHsSigWcType t') }
+ ; return $ SigPat noExtField p' (mkLHsSigWcType t') }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
- ; return $ ViewPat noExt e' p'}
+ ; return $ ViewPat noExtField e' p'}
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
cvtPatFld (s,p)
@@ -1309,11 +1309,11 @@ cvtTvs tvs = do { tvs' <- mapM cvt_tv tvs; return (mkHsQTvs tvs') }
cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr GhcPs)
cvt_tv (TH.PlainTV nm)
= do { nm' <- tNameL nm
- ; returnL $ UserTyVar noExt nm' }
+ ; returnL $ UserTyVar noExtField nm' }
cvt_tv (TH.KindedTV nm ki)
= do { nm' <- tNameL nm
; ki' <- cvtKind ki
- ; returnL $ KindedTyVar noExt nm' ki' }
+ ; returnL $ KindedTyVar noExtField nm' ki' }
cvtRole :: TH.Role -> Maybe Coercion.Role
cvtRole TH.NominalR = Just Coercion.Nominal
@@ -1333,7 +1333,7 @@ cvtDerivClause :: TH.DerivClause
cvtDerivClause (TH.DerivClause ds ctxt)
= do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt
; ds' <- traverse cvtDerivStrategy ds
- ; returnL $ HsDerivingClause noExt ds' ctxt' }
+ ; returnL $ HsDerivingClause noExtField ds' ctxt' }
cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs)
cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy
@@ -1359,21 +1359,21 @@ cvtTypeKind ty_str ty
, normals `lengthIs` n -- Saturated
-> if n==1 then return (head normals) -- Singleton tuples treated
-- like nothing (ie just parens)
- else returnL (HsTupleTy noExt
+ else returnL (HsTupleTy noExtField
HsBoxedOrConstraintTuple normals)
| n == 1
-> failWith (ptext (sLit ("Illegal 1-tuple " ++ ty_str ++ " constructor")))
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName (tupleTyCon Boxed n))))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName (tupleTyCon Boxed n))))
tys'
UnboxedTupleT n
| Just normals <- m_normals
, normals `lengthIs` n -- Saturated
- -> returnL (HsTupleTy noExt HsUnboxedTuple normals)
+ -> returnL (HsTupleTy noExtField HsUnboxedTuple normals)
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName (tupleTyCon Unboxed n))))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName (tupleTyCon Unboxed n))))
tys'
UnboxedSumT n
| n < 2
@@ -1383,37 +1383,37 @@ cvtTypeKind ty_str ty
text "Sums must have an arity of at least 2" ]
| Just normals <- m_normals
, normals `lengthIs` n -- Saturated
- -> returnL (HsSumTy noExt normals)
+ -> returnL (HsSumTy noExtField normals)
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName (sumTyCon n))))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName (sumTyCon n))))
tys'
ArrowT
| Just normals <- m_normals
, [x',y'] <- normals -> do
x'' <- case unLoc x' of
- HsFunTy{} -> returnL (HsParTy noExt x')
- HsForAllTy{} -> returnL (HsParTy noExt x') -- #14646
- HsQualTy{} -> returnL (HsParTy noExt x') -- #15324
+ HsFunTy{} -> returnL (HsParTy noExtField x')
+ HsForAllTy{} -> returnL (HsParTy noExtField x') -- #14646
+ HsQualTy{} -> returnL (HsParTy noExtField x') -- #15324
_ -> return $
parenthesizeHsType sigPrec x'
let y'' = parenthesizeHsType sigPrec y'
- returnL (HsFunTy noExt x'' y'')
+ returnL (HsFunTy noExtField x'' y'')
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName funTyCon)))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName funTyCon)))
tys'
ListT
| Just normals <- m_normals
, [x'] <- normals -> do
- returnL (HsListTy noExt x')
+ returnL (HsListTy noExtField x')
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName listTyCon)))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName listTyCon)))
tys'
VarT nm -> do { nm' <- tNameL nm
- ; mk_apps (HsTyVar noExt NotPromoted nm') tys' }
+ ; mk_apps (HsTyVar noExtField NotPromoted nm') tys' }
ConT nm -> do { nm' <- tconName nm
; -- ConT can contain both data constructor (i.e.,
-- promoted) names and other (i.e, unpromoted)
@@ -1422,7 +1422,7 @@ cvtTypeKind ty_str ty
let prom = if isRdrDataCon nm'
then IsPromoted
else NotPromoted
- ; mk_apps (HsTyVar noExt prom (noLoc nm')) tys'}
+ ; mk_apps (HsTyVar noExtField prom (noLoc nm')) tys'}
ForallT tvs cxt ty
| null tys'
@@ -1445,11 +1445,11 @@ cvtTypeKind ty_str ty
SigT ty ki
-> do { ty' <- cvtType ty
; ki' <- cvtKind ki
- ; mk_apps (HsKindSig noExt ty' ki') tys'
+ ; mk_apps (HsKindSig noExtField ty' ki') tys'
}
LitT lit
- -> mk_apps (HsTyLit noExt (cvtTyLit lit)) tys'
+ -> mk_apps (HsTyLit noExtField (cvtTyLit lit)) tys'
WildCardT
-> mk_apps mkAnonWildCardTy tys'
@@ -1459,7 +1459,7 @@ cvtTypeKind ty_str ty
; t1' <- cvtType t1
; t2' <- cvtType t2
; mk_apps
- (HsTyVar noExt NotPromoted (noLoc s'))
+ (HsTyVar noExtField NotPromoted (noLoc s'))
([HsValArg t1', HsValArg t2'] ++ tys')
}
@@ -1471,11 +1471,11 @@ cvtTypeKind ty_str ty
ParensT t
-> do { t' <- cvtType t
- ; mk_apps (HsParTy noExt t') tys'
+ ; mk_apps (HsParTy noExtField t') tys'
}
PromotedT nm -> do { nm' <- cName nm
- ; mk_apps (HsTyVar noExt IsPromoted (noLoc nm'))
+ ; mk_apps (HsTyVar noExtField IsPromoted (noLoc nm'))
tys' }
-- Promoted data constructor; hence cName
@@ -1484,34 +1484,34 @@ cvtTypeKind ty_str ty
-> failWith (ptext (sLit ("Illegal promoted 1-tuple " ++ ty_str)))
| Just normals <- m_normals
, normals `lengthIs` n -- Saturated
- -> returnL (HsExplicitTupleTy noExt normals)
+ -> returnL (HsExplicitTupleTy noExtField normals)
| otherwise
-> mk_apps
- (HsTyVar noExt IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n))))
+ (HsTyVar noExtField IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n))))
tys'
PromotedNilT
- -> mk_apps (HsExplicitListTy noExt IsPromoted []) tys'
+ -> mk_apps (HsExplicitListTy noExtField IsPromoted []) tys'
PromotedConsT -- See Note [Representing concrete syntax in types]
-- in Language.Haskell.TH.Syntax
| Just normals <- m_normals
, [ty1, dL->L _ (HsExplicitListTy _ ip tys2)] <- normals
-> do
- returnL (HsExplicitListTy noExt ip (ty1:tys2))
+ returnL (HsExplicitListTy noExtField ip (ty1:tys2))
| otherwise
-> mk_apps
- (HsTyVar noExt IsPromoted (noLoc (getRdrName consDataCon)))
+ (HsTyVar noExtField IsPromoted (noLoc (getRdrName consDataCon)))
tys'
StarT
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName liftedTypeKindTyCon)))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName liftedTypeKindTyCon)))
tys'
ConstraintT
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName constraintKindTyCon)))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName constraintKindTyCon)))
tys'
EqualityT
@@ -1519,18 +1519,18 @@ cvtTypeKind ty_str ty
, [x',y'] <- normals ->
let px = parenthesizeHsType opPrec x'
py = parenthesizeHsType opPrec y'
- in returnL (HsOpTy noExt px (noLoc eqTyCon_RDR) py)
+ in returnL (HsOpTy noExtField px (noLoc eqTyCon_RDR) py)
-- The long-term goal is to remove the above case entirely and
-- subsume it under the case for InfixT. See #15815, comment:6,
-- for more details.
| otherwise ->
- mk_apps (HsTyVar noExt NotPromoted
+ mk_apps (HsTyVar noExtField NotPromoted
(noLoc eqTyCon_RDR)) tys'
ImplicitParamT n t
-> do { n' <- wrapL $ ipName n
; t' <- cvtType t
- ; returnL (HsIParamTy noExt n' t')
+ ; returnL (HsIParamTy noExtField n' t')
}
_ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty))
@@ -1551,16 +1551,16 @@ mk_apps head_ty type_args = do
go (arg:args) =
case arg of
HsValArg ty -> do p_ty <- add_parens ty
- mk_apps (HsAppTy noExt phead_ty p_ty) args
+ mk_apps (HsAppTy noExtField phead_ty p_ty) args
HsTypeArg l ki -> do p_ki <- add_parens ki
mk_apps (HsAppKindTy l phead_ty p_ki) args
- HsArgPar _ -> mk_apps (HsParTy noExt phead_ty) args
+ HsArgPar _ -> mk_apps (HsParTy noExtField phead_ty) args
go type_args
where
-- See Note [Adding parens for splices]
add_parens lt@(dL->L _ t)
- | hsTypeNeedsParens appPrec t = returnL (HsParTy noExt lt)
+ | hsTypeNeedsParens appPrec t = returnL (HsParTy noExtField lt)
| otherwise = return lt
wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs
@@ -1596,7 +1596,7 @@ mk_arr_apps :: [LHsType GhcPs] -> HsType GhcPs -> CvtM (LHsType GhcPs)
mk_arr_apps tys return_ty = foldrM go return_ty tys >>= returnL
where go :: LHsType GhcPs -> HsType GhcPs -> CvtM (HsType GhcPs)
go arg ret_ty = do { ret_ty_l <- returnL ret_ty
- ; return (HsFunTy noExt arg ret_ty_l) }
+ ; return (HsFunTy noExtField arg ret_ty_l) }
split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs])
split_ty_app ty = go ty []
@@ -1634,18 +1634,18 @@ cvtKind = cvtTypeKind "kind"
-- signature is possible).
cvtMaybeKindToFamilyResultSig :: Maybe TH.Kind
-> CvtM (LFamilyResultSig GhcPs)
-cvtMaybeKindToFamilyResultSig Nothing = returnL (Hs.NoSig noExt)
+cvtMaybeKindToFamilyResultSig Nothing = returnL (Hs.NoSig noExtField)
cvtMaybeKindToFamilyResultSig (Just ki) = do { ki' <- cvtKind ki
- ; returnL (Hs.KindSig noExt ki') }
+ ; returnL (Hs.KindSig noExtField ki') }
-- | Convert type family result signature. Used with both open and closed type
-- families.
cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs)
-cvtFamilyResultSig TH.NoSig = returnL (Hs.NoSig noExt)
+cvtFamilyResultSig TH.NoSig = returnL (Hs.NoSig noExtField)
cvtFamilyResultSig (TH.KindSig ki) = do { ki' <- cvtKind ki
- ; returnL (Hs.KindSig noExt ki') }
+ ; returnL (Hs.KindSig noExtField ki') }
cvtFamilyResultSig (TH.TyVarSig bndr) = do { tv <- cvt_tv bndr
- ; returnL (Hs.TyVarSig noExt tv) }
+ ; returnL (Hs.TyVarSig noExtField tv) }
-- | Convert injectivity annotation of a type family.
cvtInjectivityAnnotation :: TH.InjectivityAnn
@@ -1664,7 +1664,7 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
| null univs, null reqs = do { l <- getL
; ty' <- cvtType (ForallT exis provs ty)
; return $ cL l (HsQualTy { hst_ctxt = cL l []
- , hst_xqual = noExt
+ , hst_xqual = noExtField
, hst_body = ty' }) }
| null reqs = do { l <- getL
; univs' <- hsQTvExplicit <$> cvtTvs univs
@@ -1672,10 +1672,10 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
; let forTy = HsForAllTy
{ hst_fvf = ForallInvis
, hst_bndrs = univs'
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = cL l cxtTy }
cxtTy = HsQualTy { hst_ctxt = cL l []
- , hst_xqual = noExt
+ , hst_xqual = noExtField
, hst_body = ty' }
; return $ cL l forTy }
| otherwise = cvtType (ForallT univs reqs (ForallT exis provs ty))
@@ -1738,7 +1738,7 @@ mkHsForAllTy tvs loc fvf tvs' rho_ty
| null tvs = rho_ty
| otherwise = cL loc $ HsForAllTy { hst_fvf = fvf
, hst_bndrs = hsQTvExplicit tvs'
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = rho_ty }
-- | If passed an empty 'TH.Cxt', this simply returns the third argument
@@ -1761,7 +1761,7 @@ mkHsQualTy :: TH.Cxt
-- ^ The complete type, qualified with a context if necessary
mkHsQualTy ctxt loc ctxt' ty
| null ctxt = ty
- | otherwise = cL loc $ HsQualTy { hst_xqual = noExt
+ | otherwise = cL loc $ HsQualTy { hst_xqual = noExtField
, hst_ctxt = ctxt'
, hst_body = ty }
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index 1763c3f2de..c5fadc0b4a 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -94,10 +94,10 @@ data HsLocalBindsLR idL idR
| XHsLocalBindsLR
(XXHsLocalBindsLR idL idR)
-type instance XHsValBinds (GhcPass pL) (GhcPass pR) = NoExt
-type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = NoExt
-type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExt
-type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExt
+type instance XHsValBinds (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)
@@ -135,7 +135,7 @@ data NHsValBindsLR idL
[(RecFlag, LHsBinds idL)]
[LSig GhcRn]
-type instance XValBinds (GhcPass pL) (GhcPass pR) = NoExt
+type instance XValBinds (GhcPass pL) (GhcPass pR) = NoExtField
type instance XXValBindsLR (GhcPass pL) (GhcPass pR)
= NHsValBindsLR (GhcPass pL)
@@ -319,18 +319,18 @@ data NPatBindTc = NPatBindTc {
pat_rhs_ty :: Type -- ^ Type of the GRHSs
} deriving Data
-type instance XFunBind (GhcPass pL) GhcPs = NoExt
+type instance XFunBind (GhcPass pL) GhcPs = NoExtField
type instance XFunBind (GhcPass pL) GhcRn = NameSet -- Free variables
type instance XFunBind (GhcPass pL) GhcTc = NameSet -- Free variables
-type instance XPatBind GhcPs (GhcPass pR) = NoExt
+type instance XPatBind GhcPs (GhcPass pR) = NoExtField
type instance XPatBind GhcRn (GhcPass pR) = NameSet -- Free variables
type instance XPatBind GhcTc (GhcPass pR) = NPatBindTc
-type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExt
-type instance XAbsBinds (GhcPass pL) (GhcPass pR) = NoExt
-type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExt
-type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExt
+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
-- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
@@ -356,8 +356,8 @@ data ABExport p
}
| XABExport (XXABExport p)
-type instance XABE (GhcPass p) = NoExt
-type instance XXABExport (GhcPass p) = NoExt
+type instance XABE (GhcPass p) = NoExtField
+type instance XXABExport (GhcPass p) = NoExtCon
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
@@ -379,11 +379,11 @@ data PatSynBind idL idR
}
| XPatSynBind (XXPatSynBind idL idR)
-type instance XPSB (GhcPass idL) GhcPs = NoExt
+type instance XPSB (GhcPass idL) GhcPs = NoExtField
type instance XPSB (GhcPass idL) GhcRn = NameSet
type instance XPSB (GhcPass idL) GhcTc = NameSet
-type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExt
+type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExtCon
{-
Note [AbsBinds]
@@ -682,7 +682,7 @@ pprDeclList ds = pprDeeperList vcat ds
------------
emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)
-emptyLocalBinds = EmptyLocalBinds noExt
+emptyLocalBinds = EmptyLocalBinds noExtField
-- AZ:These functions do not seem to be used at all?
isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool
@@ -706,7 +706,7 @@ isEmptyValBinds (ValBinds _ ds sigs) = isEmptyLHsBinds ds && null sigs
isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs
emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
-emptyValBindsIn = ValBinds noExt emptyBag []
+emptyValBindsIn = ValBinds noExtField emptyBag []
emptyValBindsOut = XValBindsLR (NValBinds [] [])
emptyLHsBinds :: LHsBindsLR idL idR
@@ -719,7 +719,7 @@ isEmptyLHsBinds = isEmptyBag
plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
-> HsValBinds(GhcPass a)
plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)
- = ValBinds noExt (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
+ = ValBinds noExtField (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
(XValBindsLR (NValBinds ds2 sigs2))
= XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))
@@ -824,13 +824,13 @@ data HsIPBinds id
-- -- uses of the implicit parameters
| XHsIPBinds (XXHsIPBinds id)
-type instance XIPBinds GhcPs = NoExt
-type instance XIPBinds GhcRn = NoExt
+type instance XIPBinds GhcPs = NoExtField
+type instance XIPBinds GhcRn = NoExtField
type instance XIPBinds GhcTc = TcEvBinds -- binds uses of the
-- implicit parameters
-type instance XXHsIPBinds (GhcPass p) = NoExt
+type instance XXHsIPBinds (GhcPass p) = NoExtCon
isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
isEmptyIPBindsPR (IPBinds _ is) = null is
@@ -864,8 +864,8 @@ data IPBind id
(LHsExpr id)
| XIPBind (XXIPBind id)
-type instance XCIPBind (GhcPass p) = NoExt
-type instance XXIPBind (GhcPass p) = NoExt
+type instance XCIPBind (GhcPass p) = NoExtField
+type instance XXIPBind (GhcPass p) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsIPBinds p) where
@@ -1047,18 +1047,18 @@ data Sig pass
(Maybe (Located (IdP pass)))
| XSig (XXSig pass)
-type instance XTypeSig (GhcPass p) = NoExt
-type instance XPatSynSig (GhcPass p) = NoExt
-type instance XClassOpSig (GhcPass p) = NoExt
-type instance XIdSig (GhcPass p) = NoExt
-type instance XFixSig (GhcPass p) = NoExt
-type instance XInlineSig (GhcPass p) = NoExt
-type instance XSpecSig (GhcPass p) = NoExt
-type instance XSpecInstSig (GhcPass p) = NoExt
-type instance XMinimalSig (GhcPass p) = NoExt
-type instance XSCCFunSig (GhcPass p) = NoExt
-type instance XCompleteMatchSig (GhcPass p) = NoExt
-type instance XXSig (GhcPass p) = NoExt
+type instance XTypeSig (GhcPass p) = NoExtField
+type instance XPatSynSig (GhcPass p) = NoExtField
+type instance XClassOpSig (GhcPass p) = NoExtField
+type instance XIdSig (GhcPass p) = NoExtField
+type instance XFixSig (GhcPass p) = NoExtField
+type instance XInlineSig (GhcPass p) = NoExtField
+type instance XSpecSig (GhcPass p) = NoExtField
+type instance XSpecInstSig (GhcPass p) = NoExtField
+type instance XMinimalSig (GhcPass p) = NoExtField
+type instance XSCCFunSig (GhcPass p) = NoExtField
+type instance XCompleteMatchSig (GhcPass p) = NoExtField
+type instance XXSig (GhcPass p) = NoExtCon
-- | Located Fixity Signature
type LFixitySig pass = Located (FixitySig pass)
@@ -1067,8 +1067,8 @@ type LFixitySig pass = Located (FixitySig pass)
data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity
| XFixitySig (XXFixitySig pass)
-type instance XFixitySig (GhcPass p) = NoExt
-type instance XXFixitySig (GhcPass p) = NoExt
+type instance XFixitySig (GhcPass p) = NoExtField
+type instance XXFixitySig (GhcPass p) = NoExtCon
-- | Type checker Specialisation Pragmas
--
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 7adfb01b2d..5a6d927ab9 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -146,20 +146,20 @@ data HsDecl p
| RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration
| XHsDecl (XXHsDecl p)
-type instance XTyClD (GhcPass _) = NoExt
-type instance XInstD (GhcPass _) = NoExt
-type instance XDerivD (GhcPass _) = NoExt
-type instance XValD (GhcPass _) = NoExt
-type instance XSigD (GhcPass _) = NoExt
-type instance XDefD (GhcPass _) = NoExt
-type instance XForD (GhcPass _) = NoExt
-type instance XWarningD (GhcPass _) = NoExt
-type instance XAnnD (GhcPass _) = NoExt
-type instance XRuleD (GhcPass _) = NoExt
-type instance XSpliceD (GhcPass _) = NoExt
-type instance XDocD (GhcPass _) = NoExt
-type instance XRoleAnnotD (GhcPass _) = NoExt
-type instance XXHsDecl (GhcPass _) = NoExt
+type instance XTyClD (GhcPass _) = NoExtField
+type instance XInstD (GhcPass _) = NoExtField
+type instance XDerivD (GhcPass _) = NoExtField
+type instance XValD (GhcPass _) = NoExtField
+type instance XSigD (GhcPass _) = NoExtField
+type instance XDefD (GhcPass _) = NoExtField
+type instance XForD (GhcPass _) = NoExtField
+type instance XWarningD (GhcPass _) = NoExtField
+type instance XAnnD (GhcPass _) = NoExtField
+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
-- NB: all top-level fixity decls are contained EITHER
-- EITHER SigDs
@@ -206,8 +206,8 @@ data HsGroup p
}
| XHsGroup (XXHsGroup p)
-type instance XCHsGroup (GhcPass _) = NoExt
-type instance XXHsGroup (GhcPass _) = NoExt
+type instance XCHsGroup (GhcPass _) = NoExtField
+type instance XXHsGroup (GhcPass _) = NoExtCon
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
@@ -217,7 +217,7 @@ emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
hsGroupInstDecls = (=<<) group_instds . hs_tyclds
-emptyGroup = HsGroup { hs_ext = noExt,
+emptyGroup = HsGroup { hs_ext = noExtField,
hs_tyclds = [],
hs_derivds = [],
hs_fixds = [], hs_defds = [], hs_annds = [],
@@ -255,7 +255,7 @@ appendGroups
hs_docs = docs2 }
=
HsGroup {
- hs_ext = noExt,
+ hs_ext = noExtField,
hs_valds = val_groups1 `plusHsValBinds` val_groups2,
hs_splcds = spliceds1 ++ spliceds2,
hs_tyclds = tyclds1 ++ tyclds2,
@@ -330,8 +330,8 @@ data SpliceDecl p
SpliceExplicitFlag
| XSpliceDecl (XXSpliceDecl p)
-type instance XSpliceDecl (GhcPass _) = NoExt
-type instance XXSpliceDecl (GhcPass _) = NoExt
+type instance XSpliceDecl (GhcPass _) = NoExtField
+type instance XXSpliceDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (SpliceDecl p) where
@@ -576,21 +576,21 @@ c.f. Note [Associated type tyvar names] in Class.hs
Note [Family instance declaration binders]
-}
-type instance XFamDecl (GhcPass _) = NoExt
+type instance XFamDecl (GhcPass _) = NoExtField
-type instance XSynDecl GhcPs = NoExt
+type instance XSynDecl GhcPs = NoExtField
type instance XSynDecl GhcRn = NameSet -- FVs
type instance XSynDecl GhcTc = NameSet -- FVs
-type instance XDataDecl GhcPs = NoExt
+type instance XDataDecl GhcPs = NoExtField
type instance XDataDecl GhcRn = DataDeclRn
type instance XDataDecl GhcTc = DataDeclRn
-type instance XClassDecl GhcPs = NoExt
+type instance XClassDecl GhcPs = NoExtField
type instance XClassDecl GhcRn = NameSet -- FVs
type instance XClassDecl GhcTc = NameSet -- FVs
-type instance XXTyClDecl (GhcPass _) = NoExt
+type instance XXTyClDecl (GhcPass _) = NoExtCon
-- Simple classifiers for TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -641,17 +641,17 @@ isDataFamilyDecl _other = False
-- Dealing with names
-tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
+tyFamInstDeclName :: TyFamInstDecl (GhcPass p) -> IdP (GhcPass p)
tyFamInstDeclName = unLoc . tyFamInstDeclLName
-tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
+tyFamInstDeclLName :: TyFamInstDecl (GhcPass p) -> Located (IdP (GhcPass p))
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
(HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
= ln
-tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))
- = panic "tyFamInstDeclLName"
-tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))
- = panic "tyFamInstDeclLName"
+tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn nec)))
+ = noExtCon nec
+tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs nec))
+ = noExtCon nec
tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
@@ -699,7 +699,7 @@ hsDeclHasCusk _cusks_enabled@True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
_ -> False
hsDeclHasCusk _cusks_enabled@True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
hsDeclHasCusk _cusks_enabled@True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
-hsDeclHasCusk _ (XTyClDecl _) = panic "hsDeclHasCusk"
+hsDeclHasCusk _ (XTyClDecl nec) = noExtCon nec
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
@@ -912,12 +912,12 @@ data TyClGroup pass -- See Note [TyClGroups and dependency analysis]
, group_instds :: [LInstDecl pass] }
| XTyClGroup (XXTyClGroup pass)
-type instance XCTyClGroup (GhcPass _) = NoExt
-type instance XXTyClGroup (GhcPass _) = NoExt
+type instance XCTyClGroup (GhcPass _) = NoExtField
+type instance XXTyClGroup (GhcPass _) = NoExtCon
emptyTyClGroup :: TyClGroup (GhcPass p)
-emptyTyClGroup = TyClGroup noExt [] [] []
+emptyTyClGroup = TyClGroup noExtField [] [] []
tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls = concatMap group_tyclds
@@ -931,7 +931,7 @@ tyClGroupRoleDecls = concatMap group_roles
mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]
-> TyClGroup (GhcPass p)
mkTyClGroup decls instds = TyClGroup
- { group_ext = noExt
+ { group_ext = noExtField
, group_tyclds = decls
, group_roles = []
, group_instds = instds
@@ -1033,10 +1033,10 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XNoSig (GhcPass _) = NoExt
-type instance XCKindSig (GhcPass _) = NoExt
-type instance XTyVarSig (GhcPass _) = NoExt
-type instance XXFamilyResultSig (GhcPass _) = NoExt
+type instance XNoSig (GhcPass _) = NoExtField
+type instance XCKindSig (GhcPass _) = NoExtField
+type instance XTyVarSig (GhcPass _) = NoExtField
+type instance XXFamilyResultSig (GhcPass _) = NoExtCon
-- | Located type Family Declaration
@@ -1063,8 +1063,8 @@ data FamilyDecl pass = FamilyDecl
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XCFamilyDecl (GhcPass _) = NoExt
-type instance XXFamilyDecl (GhcPass _) = NoExt
+type instance XCFamilyDecl (GhcPass _) = NoExtField
+type instance XXFamilyDecl (GhcPass _) = NoExtCon
-- | Located Injectivity Annotation
@@ -1097,7 +1097,7 @@ data FamilyInfo pass
famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled
-> Bool -- ^ True <=> this is an associated type family,
-- and the parent class has /no/ CUSK
- -> FamilyDecl pass
+ -> FamilyDecl (GhcPass pass)
-> Bool
famDeclHasCusk _cusks_enabled@False _ _ = False
famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk
@@ -1111,7 +1111,7 @@ famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk
-- Un-associated open type/data families have CUSKs
-- Associated type families have CUSKs iff the parent class does
-famDeclHasCusk _ _ (XFamilyDecl {}) = panic "famDeclHasCusk"
+famDeclHasCusk _ _ (XFamilyDecl nec) = noExtCon nec
-- | Does this family declaration have user-supplied return kind signature?
hasReturnKindSignature :: FamilyResultSig a -> Bool
@@ -1120,7 +1120,7 @@ hasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False
hasReturnKindSignature _ = True
-- | Maybe return name of the result type variable
-resultVariableName :: FamilyResultSig a -> Maybe (IdP a)
+resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig
resultVariableName _ = Nothing
@@ -1213,8 +1213,8 @@ data HsDataDefn pass -- The payload of a data type defn
}
| XHsDataDefn (XXHsDataDefn pass)
-type instance XCHsDataDefn (GhcPass _) = NoExt
-type instance XXHsDataDefn (GhcPass _) = NoExt
+type instance XCHsDataDefn (GhcPass _) = NoExtField
+type instance XXHsDataDefn (GhcPass _) = NoExtCon
-- | Haskell Deriving clause
type HsDeriving pass = Located [LHsDerivingClause pass]
@@ -1253,8 +1253,8 @@ data HsDerivingClause pass
}
| XHsDerivingClause (XXHsDerivingClause pass)
-type instance XCHsDerivingClause (GhcPass _) = NoExt
-type instance XXHsDerivingClause (GhcPass _) = NoExt
+type instance XCHsDerivingClause (GhcPass _) = NoExtField
+type instance XXHsDerivingClause (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsDerivingClause p) where
@@ -1363,9 +1363,9 @@ data ConDecl pass
}
| XConDecl (XXConDecl pass)
-type instance XConDeclGADT (GhcPass _) = NoExt
-type instance XConDeclH98 (GhcPass _) = NoExt
-type instance XXConDecl (GhcPass _) = NoExt
+type instance XConDeclGADT (GhcPass _) = NoExtField
+type instance XConDeclH98 (GhcPass _) = NoExtField
+type instance XXConDecl (GhcPass _) = NoExtCon
{- Note [GADT abstract syntax]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1408,10 +1408,10 @@ There's a wrinkle in ConDeclGADT
type HsConDeclDetails pass
= HsConDetails (LBangType pass) (Located [LConDeclField pass])
-getConNames :: ConDecl pass -> [Located (IdP pass)]
+getConNames :: ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames ConDeclH98 {con_name = name} = [name]
getConNames ConDeclGADT {con_names = names} = names
-getConNames XConDecl {} = panic "getConNames"
+getConNames (XConDecl nec) = noExtCon nec
getConArgs :: ConDecl pass -> HsConDeclDetails pass
getConArgs d = con_args d
@@ -1648,8 +1648,8 @@ data FamEqn pass rhs
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XCFamEqn (GhcPass _) r = NoExt
-type instance XXFamEqn (GhcPass _) r = NoExt
+type instance XCFamEqn (GhcPass _) r = NoExtField
+type instance XXFamEqn (GhcPass _) r = NoExtCon
----------------- Class instances -------------
@@ -1681,8 +1681,8 @@ data ClsInstDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
| XClsInstDecl (XXClsInstDecl pass)
-type instance XCClsInstDecl (GhcPass _) = NoExt
-type instance XXClsInstDecl (GhcPass _) = NoExt
+type instance XCClsInstDecl (GhcPass _) = NoExtField
+type instance XXClsInstDecl (GhcPass _) = NoExtCon
----------------- Instances of all kinds -------------
@@ -1702,10 +1702,10 @@ data InstDecl pass -- Both class and family instances
, tfid_inst :: TyFamInstDecl pass }
| XInstDecl (XXInstDecl pass)
-type instance XClsInstD (GhcPass _) = NoExt
-type instance XDataFamInstD (GhcPass _) = NoExt
-type instance XTyFamInstD (GhcPass _) = NoExt
-type instance XXInstDecl (GhcPass _) = NoExt
+type instance XClsInstD (GhcPass _) = NoExtField
+type instance XDataFamInstD (GhcPass _) = NoExtField
+type instance XTyFamInstD (GhcPass _) = NoExtField
+type instance XXInstDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (TyFamInstDecl p) where
@@ -1841,7 +1841,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where
-- Extract the declarations of associated data types from an instance
-instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass]
+instDeclDataFamInsts :: [LInstDecl (GhcPass p)] -> [DataFamInstDecl (GhcPass p)]
instDeclDataFamInsts inst_decls
= concatMap do_one inst_decls
where
@@ -1849,8 +1849,8 @@ instDeclDataFamInsts inst_decls
= map unLoc fam_insts
do_one (L _ (DataFamInstD { dfid_inst = fam_inst })) = [fam_inst]
do_one (L _ (TyFamInstD {})) = []
- do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic "instDeclDataFamInsts"
- do_one (L _ (XInstDecl _)) = panic "instDeclDataFamInsts"
+ do_one (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec
+ do_one (L _ (XInstDecl nec)) = noExtCon nec
{-
************************************************************************
@@ -1889,8 +1889,8 @@ data DerivDecl pass = DerivDecl
}
| XDerivDecl (XXDerivDecl pass)
-type instance XCDerivDecl (GhcPass _) = NoExt
-type instance XXDerivDecl (GhcPass _) = NoExt
+type instance XCDerivDecl (GhcPass _) = NoExtField
+type instance XXDerivDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (DerivDecl p) where
@@ -1972,8 +1972,8 @@ data DefaultDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
| XDefaultDecl (XXDefaultDecl pass)
-type instance XCDefaultDecl (GhcPass _) = NoExt
-type instance XXDefaultDecl (GhcPass _) = NoExt
+type instance XCDefaultDecl (GhcPass _) = NoExtField
+type instance XXDefaultDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (DefaultDecl p) where
@@ -2028,15 +2028,15 @@ data ForeignDecl pass
such as Int and IO that we know how to make foreign calls with.
-}
-type instance XForeignImport GhcPs = NoExt
-type instance XForeignImport GhcRn = NoExt
+type instance XForeignImport GhcPs = NoExtField
+type instance XForeignImport GhcRn = NoExtField
type instance XForeignImport GhcTc = Coercion
-type instance XForeignExport GhcPs = NoExt
-type instance XForeignExport GhcRn = NoExt
+type instance XForeignExport GhcPs = NoExtField
+type instance XForeignExport GhcRn = NoExtField
type instance XForeignExport GhcTc = Coercion
-type instance XXForeignDecl (GhcPass _) = NoExt
+type instance XXForeignDecl (GhcPass _) = NoExtCon
-- Specification Of an imported external entity in dependence on the calling
-- convention
@@ -2143,8 +2143,8 @@ data RuleDecls pass = HsRules { rds_ext :: XCRuleDecls pass
, rds_rules :: [LRuleDecl pass] }
| XRuleDecls (XXRuleDecls pass)
-type instance XCRuleDecls (GhcPass _) = NoExt
-type instance XXRuleDecls (GhcPass _) = NoExt
+type instance XCRuleDecls (GhcPass _) = NoExtField
+type instance XXRuleDecls (GhcPass _) = NoExtCon
-- | Located Rule Declaration
type LRuleDecl pass = Located (RuleDecl pass)
@@ -2177,11 +2177,11 @@ data RuleDecl pass
data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS
deriving Data
-type instance XHsRule GhcPs = NoExt
+type instance XHsRule GhcPs = NoExtField
type instance XHsRule GhcRn = HsRuleRn
type instance XHsRule GhcTc = HsRuleRn
-type instance XXRuleDecl (GhcPass _) = NoExt
+type instance XXRuleDecl (GhcPass _) = NoExtCon
flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
@@ -2200,9 +2200,9 @@ data RuleBndr pass
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XCRuleBndr (GhcPass _) = NoExt
-type instance XRuleBndrSig (GhcPass _) = NoExt
-type instance XXRuleBndr (GhcPass _) = NoExt
+type instance XCRuleBndr (GhcPass _) = NoExtField
+type instance XRuleBndrSig (GhcPass _) = NoExtField
+type instance XXRuleBndr (GhcPass _) = NoExtCon
collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
@@ -2290,8 +2290,8 @@ data WarnDecls pass = Warnings { wd_ext :: XWarnings pass
}
| XWarnDecls (XXWarnDecls pass)
-type instance XWarnings (GhcPass _) = NoExt
-type instance XXWarnDecls (GhcPass _) = NoExt
+type instance XWarnings (GhcPass _) = NoExtField
+type instance XXWarnDecls (GhcPass _) = NoExtCon
-- | Located Warning pragma Declaration
type LWarnDecl pass = Located (WarnDecl pass)
@@ -2300,8 +2300,8 @@ type LWarnDecl pass = Located (WarnDecl pass)
data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt
| XWarnDecl (XXWarnDecl pass)
-type instance XWarning (GhcPass _) = NoExt
-type instance XXWarnDecl (GhcPass _) = NoExt
+type instance XWarning (GhcPass _) = NoExtField
+type instance XXWarnDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass,OutputableBndr (IdP p))
@@ -2342,8 +2342,8 @@ data AnnDecl pass = HsAnnotation
-- For details on above see note [Api annotations] in ApiAnnotation
| XAnnDecl (XXAnnDecl pass)
-type instance XHsAnnotation (GhcPass _) = NoExt
-type instance XXAnnDecl (GhcPass _) = NoExt
+type instance XHsAnnotation (GhcPass _) = NoExtField
+type instance XXAnnDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where
ppr (HsAnnotation _ _ provenance expr)
@@ -2395,8 +2395,8 @@ data RoleAnnotDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
| XRoleAnnotDecl (XXRoleAnnotDecl pass)
-type instance XCRoleAnnotDecl (GhcPass _) = NoExt
-type instance XXRoleAnnotDecl (GhcPass _) = NoExt
+type instance XCRoleAnnotDecl (GhcPass _) = NoExtField
+type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndr (IdP p))
=> Outputable (RoleAnnotDecl p) where
@@ -2408,6 +2408,6 @@ instance (p ~ GhcPass pass, OutputableBndr (IdP p))
pp_role (Just r) = ppr r
ppr (XRoleAnnotDecl x) = ppr x
-roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)
+roleAnnotDeclName :: RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p)
roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name
-roleAnnotDeclName (XRoleAnnotDecl _) = panic "roleAnnotDeclName"
+roleAnnotDeclName (XRoleAnnotDecl nec) = noExtCon nec
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 9052855c69..6bfdad1600 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -110,13 +110,14 @@ data SyntaxExpr p = SyntaxExpr { syn_expr :: HsExpr p
-- | This is used for rebindable-syntax pieces that are too polymorphic
-- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
noExpr :: HsExpr (GhcPass p)
-noExpr = HsLit noExt (HsString (SourceText "noExpr") (fsLit "noExpr"))
+noExpr = HsLit noExtField (HsString (SourceText "noExpr") (fsLit "noExpr"))
noSyntaxExpr :: SyntaxExpr (GhcPass p)
-- Before renaming, and sometimes after,
-- (if the syntax slot makes no sense)
-noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExt (HsString NoSourceText
- (fsLit "noSyntaxExpr"))
+noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExtField
+ (HsString NoSourceText
+ (fsLit "noSyntaxExpr"))
, syn_arg_wraps = []
, syn_res_wrap = WpHole }
@@ -129,7 +130,7 @@ mkSyntaxExpr expr = SyntaxExpr { syn_expr = expr
-- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
-- renamer), missing its HsWrappers.
mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn
-mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExt $ noLoc name
+mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExtField $ noLoc name
-- don't care about filling in syn_arg_wraps because we're clearly
-- not past the typechecker
@@ -659,84 +660,84 @@ data RecordUpdTc = RecordUpdTc
-- ---------------------------------------------------------------------
-type instance XVar (GhcPass _) = NoExt
-type instance XUnboundVar (GhcPass _) = NoExt
-type instance XConLikeOut (GhcPass _) = NoExt
-type instance XRecFld (GhcPass _) = NoExt
-type instance XOverLabel (GhcPass _) = NoExt
-type instance XIPVar (GhcPass _) = NoExt
-type instance XOverLitE (GhcPass _) = NoExt
-type instance XLitE (GhcPass _) = NoExt
-type instance XLam (GhcPass _) = NoExt
-type instance XLamCase (GhcPass _) = NoExt
-type instance XApp (GhcPass _) = NoExt
-
-type instance XAppTypeE (GhcPass _) = NoExt
-
-type instance XOpApp GhcPs = NoExt
+type instance XVar (GhcPass _) = NoExtField
+type instance XUnboundVar (GhcPass _) = NoExtField
+type instance XConLikeOut (GhcPass _) = NoExtField
+type instance XRecFld (GhcPass _) = NoExtField
+type instance XOverLabel (GhcPass _) = NoExtField
+type instance XIPVar (GhcPass _) = NoExtField
+type instance XOverLitE (GhcPass _) = NoExtField
+type instance XLitE (GhcPass _) = NoExtField
+type instance XLam (GhcPass _) = NoExtField
+type instance XLamCase (GhcPass _) = NoExtField
+type instance XApp (GhcPass _) = NoExtField
+
+type instance XAppTypeE (GhcPass _) = NoExtField
+
+type instance XOpApp GhcPs = NoExtField
type instance XOpApp GhcRn = Fixity
type instance XOpApp GhcTc = Fixity
-type instance XNegApp (GhcPass _) = NoExt
-type instance XPar (GhcPass _) = NoExt
-type instance XSectionL (GhcPass _) = NoExt
-type instance XSectionR (GhcPass _) = NoExt
-type instance XExplicitTuple (GhcPass _) = NoExt
+type instance XNegApp (GhcPass _) = NoExtField
+type instance XPar (GhcPass _) = NoExtField
+type instance XSectionL (GhcPass _) = NoExtField
+type instance XSectionR (GhcPass _) = NoExtField
+type instance XExplicitTuple (GhcPass _) = NoExtField
-type instance XExplicitSum GhcPs = NoExt
-type instance XExplicitSum GhcRn = NoExt
+type instance XExplicitSum GhcPs = NoExtField
+type instance XExplicitSum GhcRn = NoExtField
type instance XExplicitSum GhcTc = [Type]
-type instance XCase (GhcPass _) = NoExt
-type instance XIf (GhcPass _) = NoExt
+type instance XCase (GhcPass _) = NoExtField
+type instance XIf (GhcPass _) = NoExtField
-type instance XMultiIf GhcPs = NoExt
-type instance XMultiIf GhcRn = NoExt
+type instance XMultiIf GhcPs = NoExtField
+type instance XMultiIf GhcRn = NoExtField
type instance XMultiIf GhcTc = Type
-type instance XLet (GhcPass _) = NoExt
+type instance XLet (GhcPass _) = NoExtField
-type instance XDo GhcPs = NoExt
-type instance XDo GhcRn = NoExt
+type instance XDo GhcPs = NoExtField
+type instance XDo GhcRn = NoExtField
type instance XDo GhcTc = Type
-type instance XExplicitList GhcPs = NoExt
-type instance XExplicitList GhcRn = NoExt
+type instance XExplicitList GhcPs = NoExtField
+type instance XExplicitList GhcRn = NoExtField
type instance XExplicitList GhcTc = Type
-type instance XRecordCon GhcPs = NoExt
-type instance XRecordCon GhcRn = NoExt
+type instance XRecordCon GhcPs = NoExtField
+type instance XRecordCon GhcRn = NoExtField
type instance XRecordCon GhcTc = RecordConTc
-type instance XRecordUpd GhcPs = NoExt
-type instance XRecordUpd GhcRn = NoExt
+type instance XRecordUpd GhcPs = NoExtField
+type instance XRecordUpd GhcRn = NoExtField
type instance XRecordUpd GhcTc = RecordUpdTc
-type instance XExprWithTySig (GhcPass _) = NoExt
+type instance XExprWithTySig (GhcPass _) = NoExtField
-type instance XArithSeq GhcPs = NoExt
-type instance XArithSeq GhcRn = NoExt
+type instance XArithSeq GhcPs = NoExtField
+type instance XArithSeq GhcRn = NoExtField
type instance XArithSeq GhcTc = PostTcExpr
-type instance XSCC (GhcPass _) = NoExt
-type instance XCoreAnn (GhcPass _) = NoExt
-type instance XBracket (GhcPass _) = NoExt
+type instance XSCC (GhcPass _) = NoExtField
+type instance XCoreAnn (GhcPass _) = NoExtField
+type instance XBracket (GhcPass _) = NoExtField
-type instance XRnBracketOut (GhcPass _) = NoExt
-type instance XTcBracketOut (GhcPass _) = NoExt
+type instance XRnBracketOut (GhcPass _) = NoExtField
+type instance XTcBracketOut (GhcPass _) = NoExtField
-type instance XSpliceE (GhcPass _) = NoExt
-type instance XProc (GhcPass _) = NoExt
+type instance XSpliceE (GhcPass _) = NoExtField
+type instance XProc (GhcPass _) = NoExtField
-type instance XStatic GhcPs = NoExt
+type instance XStatic GhcPs = NoExtField
type instance XStatic GhcRn = NameSet
type instance XStatic GhcTc = NameSet
-type instance XTick (GhcPass _) = NoExt
-type instance XBinTick (GhcPass _) = NoExt
-type instance XTickPragma (GhcPass _) = NoExt
-type instance XWrap (GhcPass _) = NoExt
-type instance XXExpr (GhcPass _) = NoExt
+type instance XTick (GhcPass _) = NoExtField
+type instance XBinTick (GhcPass _) = NoExtField
+type instance XTickPragma (GhcPass _) = NoExtField
+type instance XWrap (GhcPass _) = NoExtField
+type instance XXExpr (GhcPass _) = NoExtCon
-- ---------------------------------------------------------------------
@@ -757,13 +758,13 @@ data HsTupArg id
| Missing (XMissing id) -- ^ The argument is missing, but this is its type
| XTupArg (XXTupArg id) -- ^ Note [Trees that Grow] extension point
-type instance XPresent (GhcPass _) = NoExt
+type instance XPresent (GhcPass _) = NoExtField
-type instance XMissing GhcPs = NoExt
-type instance XMissing GhcRn = NoExt
+type instance XMissing GhcPs = NoExtField
+type instance XMissing GhcRn = NoExtField
type instance XMissing GhcTc = Type
-type instance XXTupArg (GhcPass _) = NoExt
+type instance XXTupArg (GhcPass _) = NoExtCon
tupArgPresent :: LHsTupArg id -> Bool
tupArgPresent (L _ (Present {})) = True
@@ -1173,7 +1174,7 @@ hsExprNeedsParens p = go
-- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.
parenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr p le@(L loc e)
- | hsExprNeedsParens p e = L loc (HsPar NoExt le)
+ | hsExprNeedsParens p e = L loc (HsPar noExtField le)
| otherwise = le
isAtomicHsExpr :: HsExpr id -> Bool
@@ -1298,24 +1299,24 @@ data HsCmd id
-- Then (HsCmdWrap wrap cmd) :: arg2 --> res
| XCmd (XXCmd id) -- Note [Trees that Grow] extension point
-type instance XCmdArrApp GhcPs = NoExt
-type instance XCmdArrApp GhcRn = NoExt
+type instance XCmdArrApp GhcPs = NoExtField
+type instance XCmdArrApp GhcRn = NoExtField
type instance XCmdArrApp GhcTc = Type
-type instance XCmdArrForm (GhcPass _) = NoExt
-type instance XCmdApp (GhcPass _) = NoExt
-type instance XCmdLam (GhcPass _) = NoExt
-type instance XCmdPar (GhcPass _) = NoExt
-type instance XCmdCase (GhcPass _) = NoExt
-type instance XCmdIf (GhcPass _) = NoExt
-type instance XCmdLet (GhcPass _) = NoExt
+type instance XCmdArrForm (GhcPass _) = NoExtField
+type instance XCmdApp (GhcPass _) = NoExtField
+type instance XCmdLam (GhcPass _) = NoExtField
+type instance XCmdPar (GhcPass _) = NoExtField
+type instance XCmdCase (GhcPass _) = NoExtField
+type instance XCmdIf (GhcPass _) = NoExtField
+type instance XCmdLet (GhcPass _) = NoExtField
-type instance XCmdDo GhcPs = NoExt
-type instance XCmdDo GhcRn = NoExt
+type instance XCmdDo GhcPs = NoExtField
+type instance XCmdDo GhcRn = NoExtField
type instance XCmdDo GhcTc = Type
-type instance XCmdWrap (GhcPass _) = NoExt
-type instance XXCmd (GhcPass _) = NoExt
+type instance XCmdWrap (GhcPass _) = NoExtField
+type instance XXCmd (GhcPass _) = NoExtCon
-- | Haskell Array Application Type
data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
@@ -1341,11 +1342,11 @@ data CmdTopTc
Type -- return type of the command
(CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable]
-type instance XCmdTop GhcPs = NoExt
+type instance XCmdTop GhcPs = NoExtField
type instance XCmdTop GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]
type instance XCmdTop GhcTc = CmdTopTc
-type instance XXCmdTop (GhcPass _) = NoExt
+type instance XXCmdTop (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where
ppr cmd = pprCmd cmd
@@ -1491,11 +1492,11 @@ data MatchGroupTc
, mg_res_ty :: Type -- Type of the result, tr
} deriving Data
-type instance XMG GhcPs b = NoExt
-type instance XMG GhcRn b = NoExt
+type instance XMG GhcPs b = NoExtField
+type instance XMG GhcRn b = NoExtField
type instance XMG GhcTc b = MatchGroupTc
-type instance XXMatchGroup (GhcPass _) b = NoExt
+type instance XXMatchGroup (GhcPass _) b = NoExtCon
-- | Located Match
type LMatch id body = Located (Match id body)
@@ -1513,8 +1514,8 @@ data Match p body
}
| XMatch (XXMatch p body)
-type instance XCMatch (GhcPass _) b = NoExt
-type instance XXMatch (GhcPass _) b = NoExt
+type instance XCMatch (GhcPass _) b = NoExtField
+type instance XXMatch (GhcPass _) b = NoExtCon
instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)
=> Outputable (Match idR body) where
@@ -1564,7 +1565,7 @@ isInfixMatch match = case m_ctxt match of
isEmptyMatchGroup :: MatchGroup id body -> Bool
isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms
-isEmptyMatchGroup (XMatchGroup{}) = panic "isEmptyMatchGroup"
+isEmptyMatchGroup (XMatchGroup {}) = False
-- | Is there only one RHS in this list of matches?
isSingletonMatchGroup :: [LMatch id body] -> Bool
@@ -1575,17 +1576,17 @@ isSingletonMatchGroup matches
| otherwise
= False
-matchGroupArity :: MatchGroup id body -> Arity
+matchGroupArity :: MatchGroup (GhcPass id) body -> Arity
-- Precondition: MatchGroup is non-empty
-- This is called before type checking, when mg_arg_tys is not set
matchGroupArity (MG { mg_alts = alts })
| L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
| otherwise = panic "matchGroupArity"
-matchGroupArity (XMatchGroup{}) = panic "matchGroupArity"
+matchGroupArity (XMatchGroup nec) = noExtCon nec
-hsLMatchPats :: LMatch id body -> [LPat id]
+hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)]
hsLMatchPats (L _ (Match { m_pats = pats })) = pats
-hsLMatchPats (L _ (XMatch _)) = panic "hsLMatchPats"
+hsLMatchPats (L _ (XMatch nec)) = noExtCon nec
-- | Guarded Right-Hand Sides
--
@@ -1605,8 +1606,8 @@ data GRHSs p body
}
| XGRHSs (XXGRHSs p body)
-type instance XCGRHSs (GhcPass _) b = NoExt
-type instance XXGRHSs (GhcPass _) b = NoExt
+type instance XCGRHSs (GhcPass _) b = NoExtField
+type instance XXGRHSs (GhcPass _) b = NoExtCon
-- | Located Guarded Right-Hand Side
type LGRHS id body = Located (GRHS id body)
@@ -1617,8 +1618,8 @@ data GRHS p body = GRHS (XCGRHS p body)
body -- Right hand side
| XGRHS (XXGRHS p body)
-type instance XCGRHS (GhcPass _) b = NoExt
-type instance XXGRHS (GhcPass _) b = NoExt
+type instance XCGRHS (GhcPass _) b = NoExtField
+type instance XXGRHS (GhcPass _) b = NoExtCon
-- We know the list must have at least one @Match@ in it.
@@ -1887,35 +1888,35 @@ data RecStmtTc =
}
-type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExt
+type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExtField
-type instance XBindStmt (GhcPass _) GhcPs b = NoExt
-type instance XBindStmt (GhcPass _) GhcRn b = NoExt
+type instance XBindStmt (GhcPass _) GhcPs b = NoExtField
+type instance XBindStmt (GhcPass _) GhcRn b = NoExtField
type instance XBindStmt (GhcPass _) GhcTc b = Type
-type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt
-type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt
+type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExtField
+type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExtField
type instance XApplicativeStmt (GhcPass _) GhcTc b = Type
-type instance XBodyStmt (GhcPass _) GhcPs b = NoExt
-type instance XBodyStmt (GhcPass _) GhcRn b = NoExt
+type instance XBodyStmt (GhcPass _) GhcPs b = NoExtField
+type instance XBodyStmt (GhcPass _) GhcRn b = NoExtField
type instance XBodyStmt (GhcPass _) GhcTc b = Type
-type instance XLetStmt (GhcPass _) (GhcPass _) b = NoExt
+type instance XLetStmt (GhcPass _) (GhcPass _) b = NoExtField
-type instance XParStmt (GhcPass _) GhcPs b = NoExt
-type instance XParStmt (GhcPass _) GhcRn b = NoExt
+type instance XParStmt (GhcPass _) GhcPs b = NoExtField
+type instance XParStmt (GhcPass _) GhcRn b = NoExtField
type instance XParStmt (GhcPass _) GhcTc b = Type
-type instance XTransStmt (GhcPass _) GhcPs b = NoExt
-type instance XTransStmt (GhcPass _) GhcRn b = NoExt
+type instance XTransStmt (GhcPass _) GhcPs b = NoExtField
+type instance XTransStmt (GhcPass _) GhcRn b = NoExtField
type instance XTransStmt (GhcPass _) GhcTc b = Type
-type instance XRecStmt (GhcPass _) GhcPs b = NoExt
-type instance XRecStmt (GhcPass _) GhcRn b = NoExt
+type instance XRecStmt (GhcPass _) GhcPs b = NoExtField
+type instance XRecStmt (GhcPass _) GhcRn b = NoExtField
type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc
-type instance XXStmtLR (GhcPass _) (GhcPass _) b = NoExt
+type instance XXStmtLR (GhcPass _) (GhcPass _) b = NoExtCon
data TransForm -- The 'f' below is the 'using' function, 'e' is the by function
= ThenForm -- then f or then f by e (depending on trS_by)
@@ -1931,8 +1932,8 @@ data ParStmtBlock idL idR
(SyntaxExpr idR) -- The return operator
| XParStmtBlock (XXParStmtBlock idL idR)
-type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
-type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
+type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtCon
-- | Applicative Argument
data ApplicativeArg idL
@@ -1951,9 +1952,9 @@ data ApplicativeArg idL
(LPat idL) -- (v1,...,vn)
| XApplicativeArg (XXApplicativeArg idL)
-type instance XApplicativeArgOne (GhcPass _) = NoExt
-type instance XApplicativeArgMany (GhcPass _) = NoExt
-type instance XXApplicativeArg (GhcPass _) = NoExt
+type instance XApplicativeArgOne (GhcPass _) = NoExtField
+type instance XApplicativeArgMany (GhcPass _) = NoExtField
+type instance XXApplicativeArg (GhcPass _) = NoExtCon
{-
Note [The type of bind in Stmts]
@@ -2184,7 +2185,7 @@ pprStmt (ApplicativeStmt _ args mb_join)
:: ExprStmt (GhcPass idL))]
flattenArg (_, ApplicativeArgMany _ stmts _ _) =
concatMap flattenStmt stmts
- flattenArg (_, XApplicativeArg _) = panic "flattenArg"
+ flattenArg (_, XApplicativeArg nec) = noExtCon nec
pp_debug =
let
@@ -2207,7 +2208,7 @@ pprStmt (ApplicativeStmt _ args mb_join)
text "<-" <+>
ppr (HsDo (panic "pprStmt") DoExpr (noLoc
(stmts ++
- [noLoc (LastStmt noExt (noLoc return) False noSyntaxExpr)])))
+ [noLoc (LastStmt noExtField (noLoc return) False noSyntaxExpr)])))
pp_arg (_, XApplicativeArg x) = ppr x
pprStmt (XStmtLR x) = ppr x
@@ -2308,11 +2309,11 @@ data HsSplice id
DelayedSplice
| XSplice (XXSplice id) -- Note [Trees that Grow] extension point
-type instance XTypedSplice (GhcPass _) = NoExt
-type instance XUntypedSplice (GhcPass _) = NoExt
-type instance XQuasiQuote (GhcPass _) = NoExt
-type instance XSpliced (GhcPass _) = NoExt
-type instance XXSplice (GhcPass _) = NoExt
+type instance XTypedSplice (GhcPass _) = NoExtField
+type instance XUntypedSplice (GhcPass _) = NoExtField
+type instance XQuasiQuote (GhcPass _) = NoExtField
+type instance XSpliced (GhcPass _) = NoExtField
+type instance XXSplice (GhcPass _) = NoExtCon
-- | A splice can appear with various decorations wrapped around it. This data
-- type captures explicitly how it was originally written, for use in the pretty
@@ -2515,14 +2516,14 @@ data HsBracket p
| TExpBr (XTExpBr p) (LHsExpr p) -- [|| expr ||]
| XBracket (XXBracket p) -- Note [Trees that Grow] extension point
-type instance XExpBr (GhcPass _) = NoExt
-type instance XPatBr (GhcPass _) = NoExt
-type instance XDecBrL (GhcPass _) = NoExt
-type instance XDecBrG (GhcPass _) = NoExt
-type instance XTypBr (GhcPass _) = NoExt
-type instance XVarBr (GhcPass _) = NoExt
-type instance XTExpBr (GhcPass _) = NoExt
-type instance XXBracket (GhcPass _) = NoExt
+type instance XExpBr (GhcPass _) = NoExtField
+type instance XPatBr (GhcPass _) = NoExtField
+type instance XDecBrL (GhcPass _) = NoExtField
+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
isTypedBracket :: HsBracket id -> Bool
isTypedBracket (TExpBr {}) = True
diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs
index 0ae0dd01e3..c486ad8a11 100644
--- a/compiler/hsSyn/HsExtension.hs
+++ b/compiler/hsSyn/HsExtension.hs
@@ -1,5 +1,7 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
@@ -53,16 +55,79 @@ haskell-src-exts ASTs as well.
-}
--- | used as place holder in TTG values
-data NoExt = NoExt
+-- | 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
+-- 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
+-- that manipulate fields with that extension point as their type.
+data NoExtField = NoExtField
deriving (Data,Eq,Ord)
-instance Outputable NoExt where
- ppr _ = text "NoExt"
+instance Outputable NoExtField where
+ ppr _ = text "NoExtField"
-- | Used when constructing a term with an unused extension point.
-noExt :: NoExt
-noExt = NoExt
+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.
+
+-- See also [NoExtCon and strict fields].
+data NoExtCon
+ deriving (Data,Eq,Ord)
+
+instance Outputable NoExtCon where
+ ppr = noExtCon
+
+-- | Eliminate a 'NoExtCon'. Much like 'Data.Void.absurd'.
+noExtCon :: NoExtCon -> a
+noExtCon x = case x of {}
+
+{-
+Note [NoExtCon and strict fields]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Currently, any unused TTG extension constructor will generally look like the
+following:
+
+ type instance XXHsDecl (GhcPass _) = NoExtCon
+ data HsDecl p
+ = ...
+ | XHsDecl (XXHsDecl p)
+
+This means that any function that wishes to consume an HsDecl will need to
+have a case for XHsDecl. This might look like this:
+
+ ex :: HsDecl GhcPs -> HsDecl GhcRn
+ ...
+ ex (XHsDecl nec) = noExtCon nec
+
+Ideally, we wouldn't need a case for XHsDecl at all (it /is/ supposed to be
+an unused extension constructor, after all). There is a way to achieve this
+on GHC 8.8 or later: make the field of XHsDecl strict:
+
+ data HsDecl p
+ = ...
+ | XHsDecl !(XXHsDecl p)
+
+If this is done, GHC's pattern-match coverage checker is clever enough to
+figure out that the XHsDecl case of `ex` is unreachable, so it can simply be
+omitted. (See Note [Extensions to GADTs Meet Their Match] in Check for more on
+how this works.)
+
+When GHC drops support for bootstrapping with GHC 8.6 and earlier, we can make
+the strict field changes described above and delete gobs of code involving
+`noExtCon`. Until then, it is necessary to use, so be aware of it when writing
+code that consumes unused extension constructors.
+-}
-- | Used as a data type index for the hsSyn AST
data GhcPass (c :: Pass)
@@ -1068,7 +1133,7 @@ type ConvertIdX a b =
--
-- So
--
--- type instance XXHsIPBinds (GhcPass p) = NoExt
+-- type instance XXHsIPBinds (GhcPass p) = NoExtCon
--
-- will correctly deduce Outputable for (GhcPass p), but
--
diff --git a/compiler/hsSyn/HsImpExp.hs b/compiler/hsSyn/HsImpExp.hs
index 1d487565e2..bedb74e05d 100644
--- a/compiler/hsSyn/HsImpExp.hs
+++ b/compiler/hsSyn/HsImpExp.hs
@@ -108,12 +108,12 @@ data ImportDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XCImportDecl (GhcPass _) = NoExt
-type instance XXImportDecl (GhcPass _) = NoExt
+type instance XCImportDecl (GhcPass _) = NoExtField
+type instance XXImportDecl (GhcPass _) = NoExtCon
simpleImportDecl :: ModuleName -> ImportDecl (GhcPass p)
simpleImportDecl mn = ImportDecl {
- ideclExt = noExt,
+ ideclExt = noExtField,
ideclSourceSrc = NoSourceText,
ideclName = noLoc mn,
ideclPkgQual = Nothing,
@@ -254,15 +254,15 @@ data IE pass
| IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc
| XIE (XXIE pass)
-type instance XIEVar (GhcPass _) = NoExt
-type instance XIEThingAbs (GhcPass _) = NoExt
-type instance XIEThingAll (GhcPass _) = NoExt
-type instance XIEThingWith (GhcPass _) = NoExt
-type instance XIEModuleContents (GhcPass _) = NoExt
-type instance XIEGroup (GhcPass _) = NoExt
-type instance XIEDoc (GhcPass _) = NoExt
-type instance XIEDocNamed (GhcPass _) = NoExt
-type instance XXIE (GhcPass _) = NoExt
+type instance XIEVar (GhcPass _) = NoExtField
+type instance XIEThingAbs (GhcPass _) = NoExtField
+type instance XIEThingAll (GhcPass _) = NoExtField
+type instance XIEThingWith (GhcPass _) = NoExtField
+type instance XIEModuleContents (GhcPass _) = NoExtField
+type instance XIEGroup (GhcPass _) = NoExtField
+type instance XIEDoc (GhcPass _) = NoExtField
+type instance XIEDocNamed (GhcPass _) = NoExtField
+type instance XXIE (GhcPass _) = NoExtCon
-- | Imported or Exported Wildcard
data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)
@@ -284,14 +284,14 @@ gives rise to
See Note [Representing fields in AvailInfo] in Avail for more details.
-}
-ieName :: IE pass -> IdP pass
+ieName :: IE (GhcPass p) -> IdP (GhcPass p)
ieName (IEVar _ (L _ n)) = ieWrappedName n
ieName (IEThingAbs _ (L _ n)) = ieWrappedName n
ieName (IEThingWith _ (L _ n) _ _ _) = ieWrappedName n
ieName (IEThingAll _ (L _ n)) = ieWrappedName n
ieName _ = panic "ieName failed pattern match!"
-ieNames :: IE pass -> [IdP pass]
+ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)]
ieNames (IEVar _ (L _ n) ) = [ieWrappedName n]
ieNames (IEThingAbs _ (L _ n) ) = [ieWrappedName n]
ieNames (IEThingAll _ (L _ n) ) = [ieWrappedName n]
@@ -301,7 +301,7 @@ ieNames (IEModuleContents {}) = []
ieNames (IEGroup {}) = []
ieNames (IEDoc {}) = []
ieNames (IEDocNamed {}) = []
-ieNames (XIE {}) = panic "ieNames"
+ieNames (XIE nec) = noExtCon nec
ieWrappedName :: IEWrappedName name -> name
ieWrappedName (IEName (L _ n)) = n
diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs
index d1411bd750..074c7295af 100644
--- a/compiler/hsSyn/HsLit.hs
+++ b/compiler/hsSyn/HsLit.hs
@@ -82,16 +82,16 @@ type instance XHsChar (GhcPass _) = SourceText
type instance XHsCharPrim (GhcPass _) = SourceText
type instance XHsString (GhcPass _) = SourceText
type instance XHsStringPrim (GhcPass _) = SourceText
-type instance XHsInt (GhcPass _) = NoExt
+type instance XHsInt (GhcPass _) = NoExtField
type instance XHsIntPrim (GhcPass _) = SourceText
type instance XHsWordPrim (GhcPass _) = SourceText
type instance XHsInt64Prim (GhcPass _) = SourceText
type instance XHsWord64Prim (GhcPass _) = SourceText
type instance XHsInteger (GhcPass _) = SourceText
-type instance XHsRat (GhcPass _) = NoExt
-type instance XHsFloatPrim (GhcPass _) = NoExt
-type instance XHsDoublePrim (GhcPass _) = NoExt
-type instance XXLit (GhcPass _) = NoExt
+type instance XHsRat (GhcPass _) = NoExtField
+type instance XHsFloatPrim (GhcPass _) = NoExtField
+type instance XHsDoublePrim (GhcPass _) = NoExtField
+type instance XXLit (GhcPass _) = NoExtCon
instance Eq (HsLit x) where
(HsChar _ x1) == (HsChar _ x2) = x1==x2
@@ -125,11 +125,11 @@ data OverLitTc
ol_type :: Type }
deriving Data
-type instance XOverLit GhcPs = NoExt
+type instance XOverLit GhcPs = NoExtField
type instance XOverLit GhcRn = Bool -- Note [ol_rebindable]
type instance XOverLit GhcTc = OverLitTc
-type instance XXOverLit (GhcPass _) = NoExt
+type instance XXOverLit (GhcPass _) = NoExtCon
-- Note [Literal source text] in BasicTypes for SourceText fields in
-- the following
@@ -147,7 +147,7 @@ negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
overLitType :: HsOverLit GhcTc -> Type
overLitType (OverLit (OverLitTc _ ty) _ _) = ty
-overLitType XOverLit{} = panic "overLitType"
+overLitType (XOverLit nec) = noExtCon nec
-- | Convert a literal from one index type to another, updating the annotations
-- according to the relevant 'Convertable' instance
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index bce65ba25a..9f8d2a5ed4 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -281,51 +281,51 @@ data ListPatTc
Type -- The type of the elements
(Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax
-type instance XWildPat GhcPs = NoExt
-type instance XWildPat GhcRn = NoExt
+type instance XWildPat GhcPs = NoExtField
+type instance XWildPat GhcRn = NoExtField
type instance XWildPat GhcTc = Type
-type instance XVarPat (GhcPass _) = NoExt
-type instance XLazyPat (GhcPass _) = NoExt
-type instance XAsPat (GhcPass _) = NoExt
-type instance XParPat (GhcPass _) = NoExt
-type instance XBangPat (GhcPass _) = NoExt
+type instance XVarPat (GhcPass _) = NoExtField
+type instance XLazyPat (GhcPass _) = NoExtField
+type instance XAsPat (GhcPass _) = NoExtField
+type instance XParPat (GhcPass _) = NoExtField
+type instance XBangPat (GhcPass _) = NoExtField
-- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap
-- compiler, as it triggers https://gitlab.haskell.org/ghc/ghc/issues/14396 for
-- `SyntaxExpr`
-type instance XListPat GhcPs = NoExt
+type instance XListPat GhcPs = NoExtField
type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)
type instance XListPat GhcTc = ListPatTc
-type instance XTuplePat GhcPs = NoExt
-type instance XTuplePat GhcRn = NoExt
+type instance XTuplePat GhcPs = NoExtField
+type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]
-type instance XSumPat GhcPs = NoExt
-type instance XSumPat GhcRn = NoExt
+type instance XSumPat GhcPs = NoExtField
+type instance XSumPat GhcRn = NoExtField
type instance XSumPat GhcTc = [Type]
-type instance XViewPat GhcPs = NoExt
-type instance XViewPat GhcRn = NoExt
+type instance XViewPat GhcPs = NoExtField
+type instance XViewPat GhcRn = NoExtField
type instance XViewPat GhcTc = Type
-type instance XSplicePat (GhcPass _) = NoExt
-type instance XLitPat (GhcPass _) = NoExt
+type instance XSplicePat (GhcPass _) = NoExtField
+type instance XLitPat (GhcPass _) = NoExtField
-type instance XNPat GhcPs = NoExt
-type instance XNPat GhcRn = NoExt
+type instance XNPat GhcPs = NoExtField
+type instance XNPat GhcRn = NoExtField
type instance XNPat GhcTc = Type
-type instance XNPlusKPat GhcPs = NoExt
-type instance XNPlusKPat GhcRn = NoExt
+type instance XNPlusKPat GhcPs = NoExtField
+type instance XNPlusKPat GhcRn = NoExtField
type instance XNPlusKPat GhcTc = Type
-type instance XSigPat GhcPs = NoExt
-type instance XSigPat GhcRn = NoExt
+type instance XSigPat GhcPs = NoExtField
+type instance XSigPat GhcRn = NoExtField
type instance XSigPat GhcTc = Type
-type instance XCoPat (GhcPass _) = NoExt
+type instance XCoPat (GhcPass _) = NoExtField
type instance XXPat (GhcPass p) = Located (Pat (GhcPass p))
@@ -460,11 +460,11 @@ data HsRecField' id arg = HsRecField {
--
-- The parsed HsRecUpdField corresponding to the record update will have:
--
--- hsRecFieldLbl = Unambiguous "x" NoExt :: AmbiguousFieldOcc RdrName
+-- hsRecFieldLbl = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName
--
-- After the renamer, this will become:
--
--- hsRecFieldLbl = Ambiguous "x" NoExt :: AmbiguousFieldOcc Name
+-- hsRecFieldLbl = Ambiguous "x" noExtField :: AmbiguousFieldOcc Name
--
-- (note that the Unambiguous constructor is not type-correct here).
-- The typechecker will determine the particular selector:
@@ -630,7 +630,7 @@ mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)
mkCharLitPat src c = mkPrefixConPat charDataCon
- [noLoc $ LitPat NoExt (HsCharPrim src c)] []
+ [noLoc $ LitPat noExtField (HsCharPrim src c)] []
{-
************************************************************************
@@ -811,7 +811,7 @@ conPatNeedsParens p = go
-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
parenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat p lpat@(dL->L loc pat)
- | patNeedsParens p pat = cL loc (ParPat NoExt lpat)
+ | patNeedsParens p pat = cL loc (ParPat noExtField lpat)
| otherwise = lpat
{-
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 130e39efab..b9b140bf45 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -334,14 +334,14 @@ type HsQTvsRn = [Name] -- Implicit variables
-- For example, in data T (a :: k1 -> k2) = ...
-- the 'a' is explicit while 'k1', 'k2' are implicit
-type instance XHsQTvs GhcPs = NoExt
+type instance XHsQTvs GhcPs = NoExtField
type instance XHsQTvs GhcRn = HsQTvsRn
type instance XHsQTvs GhcTc = HsQTvsRn
-type instance XXLHsQTyVars (GhcPass _) = NoExt
+type instance XXLHsQTyVars (GhcPass _) = NoExtCon
mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs
-mkHsQTvs tvs = HsQTvs { hsq_ext = noExt, hsq_explicit = tvs }
+mkHsQTvs tvs = HsQTvs { hsq_ext = noExtField, hsq_explicit = tvs }
hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit = hsq_explicit
@@ -372,11 +372,11 @@ data HsImplicitBndrs pass thing -- See Note [HsType binders]
}
| XHsImplicitBndrs (XXHsImplicitBndrs pass thing)
-type instance XHsIB GhcPs _ = NoExt
+type instance XHsIB GhcPs _ = NoExtField
type instance XHsIB GhcRn _ = [Name]
type instance XHsIB GhcTc _ = [Name]
-type instance XXHsImplicitBndrs (GhcPass _) _ = NoExt
+type instance XXHsImplicitBndrs (GhcPass _) _ = NoExtCon
-- | Haskell Wildcard Binders
data HsWildCardBndrs pass thing
@@ -394,11 +394,11 @@ data HsWildCardBndrs pass thing
}
| XHsWildCardBndrs (XXHsWildCardBndrs pass thing)
-type instance XHsWC GhcPs b = NoExt
+type instance XHsWC GhcPs b = NoExtField
type instance XHsWC GhcRn b = [Name]
type instance XHsWC GhcTc b = [Name]
-type instance XXHsWildCardBndrs (GhcPass _) b = NoExt
+type instance XXHsWildCardBndrs (GhcPass _) b = NoExtCon
-- | Located Haskell Signature Type
type LHsSigType pass = HsImplicitBndrs pass (LHsType pass) -- Implicit only
@@ -411,11 +411,11 @@ type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both
-- See Note [Representing type signatures]
-hsImplicitBody :: HsImplicitBndrs pass thing -> thing
+hsImplicitBody :: HsImplicitBndrs (GhcPass p) thing -> thing
hsImplicitBody (HsIB { hsib_body = body }) = body
-hsImplicitBody (XHsImplicitBndrs _) = panic "hsImplicitBody"
+hsImplicitBody (XHsImplicitBndrs nec) = noExtCon nec
-hsSigType :: LHsSigType pass -> LHsType pass
+hsSigType :: LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType = hsImplicitBody
hsSigWcType :: LHsSigWcType pass -> LHsType pass
@@ -446,12 +446,12 @@ the explicitly forall'd tyvar 'a' is bound by the HsForAllTy
-}
mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing
-mkHsImplicitBndrs x = HsIB { hsib_ext = noExt
+mkHsImplicitBndrs x = HsIB { hsib_ext = noExtField
, hsib_body = x }
mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs x = HsWC { hswc_body = x
- , hswc_ext = noExt }
+ , hswc_ext = noExtField }
-- Add empty binders. This is a bit suspicious; what if
-- the wrapped thing had free type variables?
@@ -502,15 +502,15 @@ data HsTyVarBndr pass
| XTyVarBndr
(XXTyVarBndr pass)
-type instance XUserTyVar (GhcPass _) = NoExt
-type instance XKindedTyVar (GhcPass _) = NoExt
-type instance XXTyVarBndr (GhcPass _) = NoExt
+type instance XUserTyVar (GhcPass _) = NoExtField
+type instance XKindedTyVar (GhcPass _) = NoExtField
+type instance XXTyVarBndr (GhcPass _) = NoExtCon
-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
isHsKindedTyVar :: HsTyVarBndr pass -> Bool
isHsKindedTyVar (UserTyVar {}) = False
isHsKindedTyVar (KindedTyVar {}) = True
-isHsKindedTyVar (XTyVarBndr{}) = panic "isHsKindedTyVar"
+isHsKindedTyVar (XTyVarBndr {}) = False
-- | Do all type variables in this 'LHsQTyVars' come with kind annotations?
hsTvbAllKinded :: LHsQTyVars pass -> Bool
@@ -704,41 +704,41 @@ data NewHsTypeX
instance Outputable NewHsTypeX where
ppr (NHsCoreTy ty) = ppr ty
-type instance XForAllTy (GhcPass _) = NoExt
-type instance XQualTy (GhcPass _) = NoExt
-type instance XTyVar (GhcPass _) = NoExt
-type instance XAppTy (GhcPass _) = NoExt
-type instance XFunTy (GhcPass _) = NoExt
-type instance XListTy (GhcPass _) = NoExt
-type instance XTupleTy (GhcPass _) = NoExt
-type instance XSumTy (GhcPass _) = NoExt
-type instance XOpTy (GhcPass _) = NoExt
-type instance XParTy (GhcPass _) = NoExt
-type instance XIParamTy (GhcPass _) = NoExt
-type instance XStarTy (GhcPass _) = NoExt
-type instance XKindSig (GhcPass _) = NoExt
+type instance XForAllTy (GhcPass _) = NoExtField
+type instance XQualTy (GhcPass _) = NoExtField
+type instance XTyVar (GhcPass _) = NoExtField
+type instance XAppTy (GhcPass _) = NoExtField
+type instance XFunTy (GhcPass _) = NoExtField
+type instance XListTy (GhcPass _) = NoExtField
+type instance XTupleTy (GhcPass _) = NoExtField
+type instance XSumTy (GhcPass _) = NoExtField
+type instance XOpTy (GhcPass _) = NoExtField
+type instance XParTy (GhcPass _) = NoExtField
+type instance XIParamTy (GhcPass _) = NoExtField
+type instance XStarTy (GhcPass _) = NoExtField
+type instance XKindSig (GhcPass _) = NoExtField
type instance XAppKindTy (GhcPass _) = SrcSpan -- Where the `@` lives
-type instance XSpliceTy GhcPs = NoExt
-type instance XSpliceTy GhcRn = NoExt
+type instance XSpliceTy GhcPs = NoExtField
+type instance XSpliceTy GhcRn = NoExtField
type instance XSpliceTy GhcTc = Kind
-type instance XDocTy (GhcPass _) = NoExt
-type instance XBangTy (GhcPass _) = NoExt
-type instance XRecTy (GhcPass _) = NoExt
+type instance XDocTy (GhcPass _) = NoExtField
+type instance XBangTy (GhcPass _) = NoExtField
+type instance XRecTy (GhcPass _) = NoExtField
-type instance XExplicitListTy GhcPs = NoExt
-type instance XExplicitListTy GhcRn = NoExt
+type instance XExplicitListTy GhcPs = NoExtField
+type instance XExplicitListTy GhcRn = NoExtField
type instance XExplicitListTy GhcTc = Kind
-type instance XExplicitTupleTy GhcPs = NoExt
-type instance XExplicitTupleTy GhcRn = NoExt
+type instance XExplicitTupleTy GhcPs = NoExtField
+type instance XExplicitTupleTy GhcRn = NoExtField
type instance XExplicitTupleTy GhcTc = [Kind]
-type instance XTyLit (GhcPass _) = NoExt
+type instance XTyLit (GhcPass _) = NoExtField
-type instance XWildCardTy (GhcPass _) = NoExt
+type instance XWildCardTy (GhcPass _) = NoExtField
type instance XXType (GhcPass _) = NewHsTypeX
@@ -890,8 +890,8 @@ data ConDeclField pass -- Record fields have Haddoc docs on them
-- For details on above see note [Api annotations] in ApiAnnotation
| XConDeclField (XXConDeclField pass)
-type instance XConDeclField (GhcPass _) = NoExt
-type instance XXConDeclField (GhcPass _) = NoExt
+type instance XConDeclField (GhcPass _) = NoExtField
+type instance XXConDeclField (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (ConDeclField p) where
@@ -962,8 +962,8 @@ hsWcScopedTvs sig_ty
-- include kind variables only if the type is headed by forall
-- (this is consistent with GHC 7 behaviour)
_ -> nwcs
-hsWcScopedTvs (HsWC _ (XHsImplicitBndrs _)) = panic "hsWcScopedTvs"
-hsWcScopedTvs (XHsWildCardBndrs _) = panic "hsWcScopedTvs"
+hsWcScopedTvs (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec
+hsWcScopedTvs (XHsWildCardBndrs nec) = noExtCon nec
hsScopedTvs :: LHsSigType GhcRn -> [Name]
-- Same as hsWcScopedTvs, but for a LHsSigType
@@ -989,18 +989,18 @@ I don't know if this is a good idea, but there it is.
-}
---------------------
-hsTyVarName :: HsTyVarBndr pass -> IdP pass
+hsTyVarName :: HsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
hsTyVarName (UserTyVar _ (L _ n)) = n
hsTyVarName (KindedTyVar _ (L _ n) _) = n
-hsTyVarName (XTyVarBndr{}) = panic "hsTyVarName"
+hsTyVarName (XTyVarBndr nec) = noExtCon nec
-hsLTyVarName :: LHsTyVarBndr pass -> IdP pass
+hsLTyVarName :: LHsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName = hsTyVarName . unLoc
-hsLTyVarNames :: [LHsTyVarBndr pass] -> [IdP pass]
+hsLTyVarNames :: [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames = map hsLTyVarName
-hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass]
+hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)]
-- Explicit variables only
hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)
@@ -1009,28 +1009,28 @@ hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
hsAllLTyVarNames (HsQTvs { hsq_ext = kvs
, hsq_explicit = tvs })
= kvs ++ hsLTyVarNames tvs
-hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames"
+hsAllLTyVarNames (XLHsQTyVars nec) = noExtCon nec
-hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass)
+hsLTyVarLocName :: LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p))
hsLTyVarLocName = onHasSrcSpan hsTyVarName
-hsLTyVarLocNames :: LHsQTyVars pass -> [Located (IdP pass)]
+hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [Located (IdP (GhcPass p))]
hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)
-- | Convert a LHsTyVarBndr to an equivalent LHsType.
hsLTyVarBndrToType :: LHsTyVarBndr (GhcPass p) -> LHsType (GhcPass p)
hsLTyVarBndrToType = onHasSrcSpan cvt
- where cvt (UserTyVar _ n) = HsTyVar noExt NotPromoted n
+ where cvt (UserTyVar _ n) = HsTyVar noExtField NotPromoted n
cvt (KindedTyVar _ (L name_loc n) kind)
- = HsKindSig noExt
- (L name_loc (HsTyVar noExt NotPromoted (L name_loc n))) kind
- cvt (XTyVarBndr{}) = panic "hsLTyVarBndrToType"
+ = HsKindSig noExtField
+ (L name_loc (HsTyVar noExtField NotPromoted (L name_loc n))) kind
+ cvt (XTyVarBndr nec) = noExtCon nec
-- | Convert a LHsTyVarBndrs to a list of types.
-- Works on *type* variable only, no kind vars.
hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)]
hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs
-hsLTyVarBndrsToTypes (XLHsQTyVars _) = panic "hsLTyVarBndrsToTypes"
+hsLTyVarBndrsToTypes (XLHsQTyVars nec) = noExtCon nec
---------------------
ignoreParens :: LHsType pass -> LHsType pass
@@ -1050,15 +1050,15 @@ isLHsForAllTy _ = False
-}
mkAnonWildCardTy :: HsType GhcPs
-mkAnonWildCardTy = HsWildCardTy noExt
+mkAnonWildCardTy = HsWildCardTy noExtField
mkHsOpTy :: LHsType (GhcPass p) -> Located (IdP (GhcPass p))
-> LHsType (GhcPass p) -> HsType (GhcPass p)
-mkHsOpTy ty1 op ty2 = HsOpTy noExt ty1 op ty2
+mkHsOpTy ty1 op ty2 = HsOpTy noExtField ty1 op ty2
mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy t1 t2
- = addCLoc t1 t2 (HsAppTy noExt t1 (parenthesizeHsType appPrec t2))
+ = addCLoc t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))
mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
-> LHsType (GhcPass p)
@@ -1270,9 +1270,9 @@ splitLHsInstDeclTy (HsIB { hsib_ext = itkvs
= (itkvs ++ hsLTyVarNames tvs, cxt, body_ty)
-- Return implicitly bound type and kind vars
-- For an instance decl, all of them are in scope
-splitLHsInstDeclTy (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy"
+splitLHsInstDeclTy (XHsImplicitBndrs nec) = noExtCon nec
-getLHsInstDeclHead :: LHsSigType pass -> LHsType pass
+getLHsInstDeclHead :: LHsSigType (GhcPass p) -> LHsType (GhcPass p)
getLHsInstDeclHead inst_ty
| (_tvs, _cxt, body_ty) <- splitLHsSigmaTyInvis (hsSigType inst_ty)
= body_ty
@@ -1311,17 +1311,17 @@ data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass
deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq (FieldOcc p)
deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p)
-type instance XCFieldOcc GhcPs = NoExt
+type instance XCFieldOcc GhcPs = NoExtField
type instance XCFieldOcc GhcRn = Name
type instance XCFieldOcc GhcTc = Id
-type instance XXFieldOcc (GhcPass _) = NoExt
+type instance XXFieldOcc (GhcPass _) = NoExtCon
instance Outputable (FieldOcc pass) where
ppr = ppr . rdrNameFieldOcc
mkFieldOcc :: Located RdrName -> FieldOcc GhcPs
-mkFieldOcc rdr = FieldOcc noExt rdr
+mkFieldOcc rdr = FieldOcc noExtField rdr
-- | Ambiguous Field Occurrence
@@ -1341,15 +1341,15 @@ data AmbiguousFieldOcc pass
| Ambiguous (XAmbiguous pass) (Located RdrName)
| XAmbiguousFieldOcc (XXAmbiguousFieldOcc pass)
-type instance XUnambiguous GhcPs = NoExt
+type instance XUnambiguous GhcPs = NoExtField
type instance XUnambiguous GhcRn = Name
type instance XUnambiguous GhcTc = Id
-type instance XAmbiguous GhcPs = NoExt
-type instance XAmbiguous GhcRn = NoExt
+type instance XAmbiguous GhcPs = NoExtField
+type instance XAmbiguous GhcRn = NoExtField
type instance XAmbiguous GhcTc = Id
-type instance XXAmbiguousFieldOcc (GhcPass _) = NoExt
+type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon
instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where
ppr = ppr . rdrNameAmbiguousFieldOcc
@@ -1359,28 +1359,28 @@ instance p ~ GhcPass pass => OutputableBndr (AmbiguousFieldOcc p) where
pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc
mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc GhcPs
-mkAmbiguousFieldOcc rdr = Unambiguous noExt rdr
+mkAmbiguousFieldOcc rdr = Unambiguous noExtField rdr
rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr
rdrNameAmbiguousFieldOcc (Ambiguous _ (L _ rdr)) = rdr
-rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc _)
- = panic "rdrNameAmbiguousFieldOcc"
+rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc nec)
+ = noExtCon nec
selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id
selectorAmbiguousFieldOcc (Unambiguous sel _) = sel
selectorAmbiguousFieldOcc (Ambiguous sel _) = sel
-selectorAmbiguousFieldOcc (XAmbiguousFieldOcc _)
- = panic "selectorAmbiguousFieldOcc"
+selectorAmbiguousFieldOcc (XAmbiguousFieldOcc nec)
+ = noExtCon nec
unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel
unambiguousFieldOcc (Ambiguous rdr sel) = FieldOcc rdr sel
-unambiguousFieldOcc (XAmbiguousFieldOcc _) = panic "unambiguousFieldOcc"
+unambiguousFieldOcc (XAmbiguousFieldOcc nec) = noExtCon nec
ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr
-ambiguousFieldOcc (XFieldOcc _) = panic "ambiguousFieldOcc"
+ambiguousFieldOcc (XFieldOcc nec) = noExtCon nec
{-
************************************************************************
@@ -1664,7 +1664,7 @@ lhsTypeHasLeadingPromotionQuote ty
-- returns @ty@.
parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType p lty@(L loc ty)
- | hsTypeNeedsParens p ty = L loc (HsParTy NoExt lty)
+ | hsTypeNeedsParens p ty = L loc (HsParTy noExtField lty)
| otherwise = lty
-- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 531ff46ee4..93e7cf5f81 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -140,14 +140,14 @@ just attach noSrcSpan to everything.
-}
mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkHsPar e = cL (getLoc e) (HsPar noExt e)
+mkHsPar e = cL (getLoc e) (HsPar noExtField e)
mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)] -> Located (body (GhcPass p))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
mkSimpleMatch ctxt pats rhs
= cL loc $
- Match { m_ext = noExt, m_ctxt = ctxt, m_pats = pats
+ Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = pats
, m_grhss = unguardedGRHSs rhs }
where
loc = case pats of
@@ -157,16 +157,16 @@ mkSimpleMatch ctxt pats rhs
unguardedGRHSs :: Located (body (GhcPass p))
-> GRHSs (GhcPass p) (Located (body (GhcPass p)))
unguardedGRHSs rhs@(dL->L loc _)
- = GRHSs noExt (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
+ = GRHSs noExtField (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
unguardedRHS :: SrcSpan -> Located (body (GhcPass p))
-> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
-unguardedRHS loc rhs = [cL loc (GRHS noExt [] rhs)]
+unguardedRHS loc rhs = [cL loc (GRHS noExtField [] rhs)]
-mkMatchGroup :: (XMG name (Located (body name)) ~ NoExt)
+mkMatchGroup :: (XMG name (Located (body name)) ~ NoExtField)
=> Origin -> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
-mkMatchGroup origin matches = MG { mg_ext = noExt
+mkMatchGroup origin matches = MG { mg_ext = noExtField
, mg_alts = mkLocatedList matches
, mg_origin = origin }
@@ -175,11 +175,11 @@ mkLocatedList [] = noLoc []
mkLocatedList ms = cL (combineLocs (head ms) (last ms)) ms
mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2)
+mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExtField e1 e2)
mkHsAppType :: (NoGhcTc (GhcPass id) ~ GhcRn)
=> LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)
-mkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct)
+mkHsAppType e t = addCLoc e t_body (HsAppType noExtField e paren_wct)
where
t_body = hswc_body t
paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }
@@ -187,9 +187,9 @@ mkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct)
mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
mkHsAppTypes = foldl' mkHsAppType
-mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExt) =>
+mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
-mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExt matches))
+mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExtField matches))
where
matches = mkMatchGroup Generated
[mkSimpleMatch LambdaExpr pats' body]
@@ -208,7 +208,7 @@ mkHsCaseAlt pat expr
nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)
nlHsTyApp fun_id tys
- = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id)))
+ = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExtField (noLoc fun_id)))
nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
@@ -219,16 +219,16 @@ mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-- Wrap in parens if (hsExprNeedsParens appPrec) says it needs them
-- So 'f x' becomes '(f x)', but '3' stays as '3'
mkLHsPar le@(dL->L loc e)
- | hsExprNeedsParens appPrec e = cL loc (HsPar noExt le)
+ | hsExprNeedsParens appPrec e = cL loc (HsPar noExtField le)
| otherwise = le
mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
mkParPat lp@(dL->L loc p)
- | patNeedsParens appPrec p = cL loc (ParPat noExt lp)
+ | patNeedsParens appPrec p = cL loc (ParPat noExtField lp)
| otherwise = lp
nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
-nlParPat p = noLoc (ParPat noExt p)
+nlParPat p = noLoc (ParPat noExtField p)
-------------------------------
-- These are the bits of syntax that contain rebindable names
@@ -250,7 +250,7 @@ mkLastStmt :: Located (bodyR (GhcPass idR))
mkBodyStmt :: Located (bodyR GhcPs)
-> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))
mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)
- (Located (bodyR (GhcPass idR))) ~ NoExt)
+ (Located (bodyR (GhcPass idR))) ~ NoExtField)
=> LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))
-> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)
@@ -263,26 +263,26 @@ mkRecStmt :: [LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
-mkHsIntegral i = OverLit noExt (HsIntegral i) noExpr
-mkHsFractional f = OverLit noExt (HsFractional f) noExpr
-mkHsIsString src s = OverLit noExt (HsIsString src s) noExpr
+mkHsIntegral i = OverLit noExtField (HsIntegral i) noExpr
+mkHsFractional f = OverLit noExtField (HsFractional f) noExpr
+mkHsIsString src s = OverLit noExtField (HsIsString src s) noExpr
-mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts)
+mkHsDo ctxt stmts = HsDo noExtField ctxt (mkLocatedList stmts)
mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
where
last_stmt = cL (getLoc expr) $ mkLastStmt expr
mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
-> HsExpr (GhcPass p)
-mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b
+mkHsIf c a b = HsIf noExtField (Just noSyntaxExpr) c a b
mkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
-> HsCmd (GhcPass p)
-mkHsCmdIf c a b = HsCmdIf noExt (Just noSyntaxExpr) c a b
+mkHsCmdIf c a b = HsCmdIf noExtField (Just noSyntaxExpr) c a b
-mkNPat lit neg = NPat noExt lit neg noSyntaxExpr
+mkNPat lit neg = NPat noExtField lit neg noSyntaxExpr
mkNPlusKPat id lit
- = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr
+ = NPlusKPat noExtField id lit (unLoc lit) noSyntaxExpr noSyntaxExpr
mkTransformStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
@@ -295,7 +295,7 @@ mkGroupByUsingStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-emptyTransStmt = TransStmt { trS_ext = noExt
+emptyTransStmt = TransStmt { trS_ext = noExtField
, trS_form = panic "emptyTransStmt: form"
, trS_stmts = [], trS_bndrs = []
, trS_by = Nothing, trS_using = noLoc noExpr
@@ -306,11 +306,11 @@ mkTransformByStmt ss u b = emptyTransStmt { trS_form = ThenForm, trS_stmts = s
mkGroupUsingStmt ss u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u }
mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b }
-mkLastStmt body = LastStmt noExt body False noSyntaxExpr
+mkLastStmt body = LastStmt noExtField body False noSyntaxExpr
mkBodyStmt body
- = BodyStmt noExt body noSyntaxExpr noSyntaxExpr
+ = BodyStmt noExtField body noSyntaxExpr noSyntaxExpr
mkBindStmt pat body
- = BindStmt noExt pat body noSyntaxExpr noSyntaxExpr
+ = BindStmt noExtField pat body noSyntaxExpr noSyntaxExpr
mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr
-- don't use placeHolderTypeTc above, because that panics during zonking
@@ -332,8 +332,8 @@ unitRecStmtTc = RecStmtTc { recS_bind_ty = unitTy
, recS_rec_rets = []
, recS_ret_ty = unitTy }
-emptyRecStmt = emptyRecStmt' noExt
-emptyRecStmtName = emptyRecStmt' noExt
+emptyRecStmt = emptyRecStmt' noExtField
+emptyRecStmtName = emptyRecStmt' noExtField
emptyRecStmtId = emptyRecStmt' unitRecStmtTc
-- a panic might trigger during zonking
mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
@@ -342,20 +342,20 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
--- A useful function for building @OpApps@. The operator is always a
-- variable, and we don't know the fixity yet.
mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
-mkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2
+mkHsOpApp e1 op e2 = OpApp noExtField e1 (noLoc (HsVar noExtField (noLoc op))) e2
unqualSplice :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
-mkUntypedSplice hasParen e = HsUntypedSplice noExt hasParen unqualSplice e
+mkUntypedSplice hasParen e = HsUntypedSplice noExtField hasParen unqualSplice e
mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
-mkTypedSplice hasParen e = HsTypedSplice noExt hasParen unqualSplice e
+mkTypedSplice hasParen e = HsTypedSplice noExtField hasParen unqualSplice e
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote quoter span quote
- = HsQuasiQuote noExt unqualSplice quoter span quote
+ = HsQuasiQuote noExtField unqualSplice quoter span quote
unqualQuasiQuote :: RdrName
unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
@@ -372,11 +372,11 @@ mkHsStringPrimLit fs = HsStringPrim NoSourceText (bytesFS fs)
userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))]
-> [LHsTyVarBndr (GhcPass p)]
-- Caller sets location
-userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt v) | v <- bndrs ]
+userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExtField v) | v <- bndrs ]
userHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)]
-- Caller sets location
-userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v))
+userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExtField (cL loc v))
| v <- bndrs ]
@@ -389,26 +389,26 @@ userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v))
-}
nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)
-nlHsVar n = noLoc (HsVar noExt (noLoc n))
+nlHsVar n = noLoc (HsVar noExtField (noLoc n))
-- NB: Only for LHsExpr **Id**
nlHsDataCon :: DataCon -> LHsExpr GhcTc
-nlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con))
+nlHsDataCon con = noLoc (HsConLikeOut noExtField (RealDataCon con))
nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
-nlHsLit n = noLoc (HsLit noExt n)
+nlHsLit n = noLoc (HsLit noExtField n)
nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
-nlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n)))
+nlHsIntLit n = noLoc (HsLit noExtField (HsInt noExtField (mkIntegralLit n)))
nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id)
-nlVarPat n = noLoc (VarPat noExt (noLoc n))
+nlVarPat n = noLoc (VarPat noExtField (noLoc n))
nlLitPat :: HsLit GhcPs -> LPat GhcPs
-nlLitPat l = noLoc (LitPat noExt l)
+nlLitPat l = noLoc (LitPat noExtField l)
nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-nlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x))
+nlHsApp f x = noLoc (HsApp noExtField f (mkLHsPar x))
nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
@@ -427,10 +427,10 @@ nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
nlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs
nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
-nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExt (noLoc f))
- (map ((HsVar noExt) . noLoc) xs))
+nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExtField (noLoc f))
+ (map ((HsVar noExtField) . noLoc) xs))
where
- mk f a = HsApp noExt (noLoc f) (noLoc a)
+ mk f a = HsApp noExtField (noLoc f) (noLoc a)
nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs
nlConVarPat con vars = nlConPat con (map nlVarPat vars)
@@ -460,10 +460,10 @@ nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
nlWildPat)))
nlWildPat :: LPat GhcPs
-nlWildPat = noLoc (WildPat noExt ) -- Pre-typechecking
+nlWildPat = noLoc (WildPat noExtField ) -- Pre-typechecking
nlWildPatName :: LPat GhcRn
-nlWildPatName = noLoc (WildPat noExt ) -- Pre-typechecking
+nlWildPatName = noLoc (WildPat noExtField ) -- Pre-typechecking
nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]
-> LHsExpr GhcPs
@@ -480,27 +480,27 @@ nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsExpr GhcPs
nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs
-nlHsLam match = noLoc (HsLam noExt (mkMatchGroup Generated [match]))
-nlHsPar e = noLoc (HsPar noExt e)
+nlHsLam match = noLoc (HsLam noExtField (mkMatchGroup Generated [match]))
+nlHsPar e = noLoc (HsPar noExtField e)
-- Note [Rebindable nlHsIf]
-- nlHsIf should generate if-expressions which are NOT subject to
-- RebindableSyntax, so the first field of HsIf is Nothing. (#12080)
-nlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false)
+nlHsIf cond true false = noLoc (HsIf noExtField Nothing cond true false)
nlHsCase expr matches
- = noLoc (HsCase noExt expr (mkMatchGroup Generated matches))
-nlList exprs = noLoc (ExplicitList noExt Nothing exprs)
+ = noLoc (HsCase noExtField expr (mkMatchGroup Generated matches))
+nlList exprs = noLoc (ExplicitList noExtField Nothing exprs)
nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar :: IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p)
-nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t))
-nlHsTyVar x = noLoc (HsTyVar noExt NotPromoted (noLoc x))
-nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) b)
-nlHsParTy t = noLoc (HsParTy noExt t)
+nlHsAppTy f t = noLoc (HsAppTy noExtField f (parenthesizeHsType appPrec t))
+nlHsTyVar x = noLoc (HsTyVar noExtField NotPromoted (noLoc x))
+nlHsFunTy a b = noLoc (HsFunTy noExtField (parenthesizeHsType funPrec a) b)
+nlHsParTy t = noLoc (HsParTy noExtField t)
nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
nlHsTyConApp tycon tys = foldl' nlHsAppTy (nlHsTyVar tycon) tys
@@ -519,21 +519,21 @@ mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
-- Makes a pre-typechecker boxed tuple, deals with 1 case
mkLHsTupleExpr [e] = e
mkLHsTupleExpr es
- = noLoc $ ExplicitTuple noExt (map (noLoc . (Present noExt)) es) Boxed
+ = noLoc $ ExplicitTuple noExtField (map (noLoc . (Present noExtField)) es) Boxed
mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids)
nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs
-nlTuplePat pats box = noLoc (TuplePat noExt pats box)
+nlTuplePat pats box = noLoc (TuplePat noExtField pats box)
missingTupArg :: HsTupArg GhcPs
-missingTupArg = Missing noExt
+missingTupArg = Missing noExtField
mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
-mkLHsPatTup [] = noLoc $ TuplePat noExt [] Boxed
+mkLHsPatTup [] = noLoc $ TuplePat noExtField [] Boxed
mkLHsPatTup [lpat] = lpat
-mkLHsPatTup lpats = cL (getLoc (head lpats)) $ TuplePat noExt lpats Boxed
+mkLHsPatTup lpats = cL (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed
-- The Big equivalents for the source tuple expressions
mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
@@ -637,7 +637,7 @@ mkClassOpSigs sigs
= map fiddle sigs
where
fiddle (dL->L loc (TypeSig _ nms ty))
- = cL loc (ClassOpSig noExt False nms (dropWildCards ty))
+ = cL loc (ClassOpSig noExtField False nms (dropWildCards ty))
fiddle sig = sig
typeToLHsType :: Type -> LHsType GhcPs
@@ -655,25 +655,25 @@ typeToLHsType ty
VisArg -> nlHsFunTy (go arg) (go res)
InvisArg | (theta, tau) <- tcSplitPhiTy ty
-> noLoc (HsQualTy { hst_ctxt = noLoc (map go theta)
- , hst_xqual = noExt
+ , hst_xqual = noExtField
, hst_body = go tau })
go ty@(ForAllTy (Bndr _ argf) _)
| (tvs, tau) <- tcSplitForAllTysSameVis argf ty
= noLoc (HsForAllTy { hst_fvf = argToForallVisFlag argf
, hst_bndrs = map go_tv tvs
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = go tau })
go (TyVarTy tv) = nlHsTyVar (getRdrName tv)
go (LitTy (NumTyLit n))
- = noLoc $ HsTyLit NoExt (HsNumTy NoSourceText n)
+ = noLoc $ HsTyLit noExtField (HsNumTy NoSourceText n)
go (LitTy (StrTyLit s))
- = noLoc $ HsTyLit NoExt (HsStrTy NoSourceText s)
+ = noLoc $ HsTyLit noExtField (HsStrTy NoSourceText s)
go ty@(TyConApp tc args)
| tyConAppNeedsKindSig True tc (length args)
-- We must produce an explicit kind signature here to make certain
-- programs kind-check. See Note [Kind signatures in typeToLHsType].
- = nlHsParTy $ noLoc $ HsKindSig NoExt ty' (go (tcTypeKind ty))
+ = nlHsParTy $ noLoc $ HsKindSig noExtField ty' (go (tcTypeKind ty))
| otherwise = ty'
where
ty' :: LHsType GhcPs
@@ -703,7 +703,7 @@ typeToLHsType ty
head (zip args arg_flags)
go_tv :: TyVar -> LHsTyVarBndr GhcPs
- go_tv tv = noLoc $ KindedTyVar noExt (noLoc (getRdrName tv))
+ go_tv tv = noLoc $ KindedTyVar noExtField (noLoc (getRdrName tv))
(go (tyVarKind tv))
{-
@@ -762,7 +762,7 @@ mkLHsWrap co_fn (dL->L loc e) = cL loc (mkHsWrap co_fn e)
mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap co_fn e | isIdHsWrapper co_fn = e
mkHsWrap co_fn (HsWrap _ co_fn' e) = mkHsWrap (co_fn <.> co_fn') e
-mkHsWrap co_fn e = HsWrap noExt co_fn e
+mkHsWrap co_fn e = HsWrap noExtField co_fn e
mkHsWrapCo :: TcCoercionN -- A Nominal coercion a ~N b
-> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
@@ -777,18 +777,18 @@ mkLHsWrapCo co (dL->L loc e) = cL loc (mkHsWrapCo co e)
mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
mkHsCmdWrap w cmd | isIdHsWrapper w = cmd
- | otherwise = HsCmdWrap noExt w cmd
+ | otherwise = HsCmdWrap noExtField w cmd
mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
mkLHsCmdWrap w (dL->L loc c) = cL loc (mkHsCmdWrap w c)
mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
- | otherwise = CoPat noExt co_fn p ty
+ | otherwise = CoPat noExtField co_fn p ty
mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPatCo co pat ty | isTcReflCo co = pat
- | otherwise = CoPat noExt (mkWpCastN co) pat ty
+ | otherwise = CoPat noExtField (mkWpCastN co) pat ty
mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
@@ -808,7 +808,7 @@ mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
mkFunBind fn ms = FunBind { fun_id = fn
, fun_matches = mkMatchGroup Generated ms
, fun_co_fn = idHsWrapper
- , fun_ext = noExt
+ , fun_ext = noExtField
, fun_tick = [] }
mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)]
@@ -826,14 +826,14 @@ mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
mkVarBind var rhs = cL (getLoc rhs) $
- VarBind { var_ext = noExt,
+ VarBind { var_ext = noExtField,
var_id = var, var_rhs = rhs, var_inline = False }
mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName)
-> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs
-mkPatSynBind name details lpat dir = PatSynBind noExt psb
+mkPatSynBind name details lpat dir = PatSynBind noExtField psb
where
- psb = PSB{ psb_ext = noExt
+ psb = PSB{ psb_ext = noExtField
, psb_id = name
, psb_args = details
, psb_def = lpat
@@ -867,13 +867,13 @@ mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> Located (HsLocalBinds (GhcPass p))
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch ctxt pats expr lbinds
- = noLoc (Match { m_ext = noExt
+ = noLoc (Match { m_ext = noExtField
, m_ctxt = ctxt
, m_pats = map paren pats
- , m_grhss = GRHSs noExt (unguardedRHS noSrcSpan expr) lbinds })
+ , m_grhss = GRHSs noExtField (unguardedRHS noSrcSpan expr) lbinds })
where
paren lp@(dL->L l p)
- | patNeedsParens appPrec p = cL l (ParPat noExt lp)
+ | patNeedsParens appPrec p = cL l (ParPat noExtField lp)
| otherwise = lp
{-
@@ -1054,7 +1054,7 @@ collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args
collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat
collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat
collectArgBinders _ = []
-collectStmtBinders XStmtLR{} = panic "collectStmtBinders"
+collectStmtBinders (XStmtLR nec) = noExtCon nec
----------------- Patterns --------------------------
@@ -1130,7 +1130,7 @@ hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
hs_fords = foreign_decls })
= collectHsValBinders val_decls
++ hsTyClForeignBinders tycl_decls foreign_decls
-hsGroupBinders (XHsGroup {}) = panic "hsGroupBinders"
+hsGroupBinders (XHsGroup nec) = noExtCon nec
hsTyClForeignBinders :: [TyClGroup GhcRn]
-> [LForeignDecl GhcRn]
@@ -1148,8 +1148,8 @@ hsTyClForeignBinders tycl_decls foreign_decls
getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs
-------------------
-hsLTyClDeclBinders :: Located (TyClDecl pass)
- -> ([Located (IdP pass)], [LFieldOcc pass])
+hsLTyClDeclBinders :: Located (TyClDecl (GhcPass p))
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
-- ^ Returns all the /binding/ names of the decl. The first one is
-- guaranteed to be the name of the decl. The first component
-- represents all binding names except record fields; the second
@@ -1162,8 +1162,8 @@ hsLTyClDeclBinders :: Located (TyClDecl pass)
hsLTyClDeclBinders (dL->L loc (FamDecl { tcdFam = FamilyDecl
{ fdLName = (dL->L _ name) } }))
= ([cL loc name], [])
-hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl _ }))
- = panic "hsLTyClDeclBinders"
+hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl nec }))
+ = noExtCon nec
hsLTyClDeclBinders (dL->L loc (SynDecl
{ tcdLName = (dL->L _ name) }))
= ([cL loc name], [])
@@ -1181,7 +1181,7 @@ hsLTyClDeclBinders (dL->L loc (ClassDecl
hsLTyClDeclBinders (dL->L loc (DataDecl { tcdLName = (dL->L _ name)
, tcdDataDefn = defn }))
= (\ (xs, ys) -> (cL loc name : xs, ys)) $ hsDataDefnBinders defn
-hsLTyClDeclBinders (dL->L _ (XTyClDecl _)) = panic "hsLTyClDeclBinders"
+hsLTyClDeclBinders (dL->L _ (XTyClDecl nec)) = noExtCon nec
hsLTyClDeclBinders _ = panic "hsLTyClDeclBinders: Impossible Match"
-- due to #15884
@@ -1224,48 +1224,50 @@ hsLInstDeclBinders (dL->L _ (ClsInstD
hsLInstDeclBinders (dL->L _ (DataFamInstD { dfid_inst = fi }))
= hsDataFamInstBinders fi
hsLInstDeclBinders (dL->L _ (TyFamInstD {})) = mempty
-hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl {})))
- = panic "hsLInstDeclBinders"
-hsLInstDeclBinders (dL->L _ (XInstDecl _))
- = panic "hsLInstDeclBinders"
+hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl nec)))
+ = noExtCon nec
+hsLInstDeclBinders (dL->L _ (XInstDecl nec))
+ = noExtCon nec
hsLInstDeclBinders _ = panic "hsLInstDeclBinders: Impossible Match"
-- due to #15884
-------------------
-- the SrcLoc returned are for the whole declarations, not just the names
-hsDataFamInstBinders :: DataFamInstDecl pass
- -> ([Located (IdP pass)], [LFieldOcc pass])
+hsDataFamInstBinders :: DataFamInstDecl (GhcPass p)
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
FamEqn { feqn_rhs = defn }}})
= hsDataDefnBinders defn
-- There can't be repeated symbols because only data instances have binders
hsDataFamInstBinders (DataFamInstDecl
- { dfid_eqn = HsIB { hsib_body = XFamEqn _}})
- = panic "hsDataFamInstBinders"
-hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs _))
- = panic "hsDataFamInstBinders"
+ { dfid_eqn = HsIB { hsib_body = XFamEqn nec}})
+ = noExtCon nec
+hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs nec))
+ = noExtCon nec
-------------------
-- the SrcLoc returned are for the whole declarations, not just the names
-hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])
+hsDataDefnBinders :: HsDataDefn (GhcPass p)
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataDefnBinders (HsDataDefn { dd_cons = cons })
= hsConDeclsBinders cons
-- See Note [Binders in family instances]
-hsDataDefnBinders (XHsDataDefn _) = panic "hsDataDefnBinders"
+hsDataDefnBinders (XHsDataDefn nec) = noExtCon nec
-------------------
-type Seen pass = [LFieldOcc pass] -> [LFieldOcc pass]
+type Seen p = [LFieldOcc (GhcPass p)] -> [LFieldOcc (GhcPass p)]
-- Filters out ones that have already been seen
-hsConDeclsBinders :: [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
+hsConDeclsBinders :: [LConDecl (GhcPass p)]
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
-- See hsLTyClDeclBinders for what this does
-- The function is boringly complicated because of the records
-- And since we only have equality, we have to be a little careful
hsConDeclsBinders cons
= go id cons
where
- go :: Seen pass -> [LConDecl pass]
- -> ([Located (IdP pass)], [LFieldOcc pass])
+ go :: Seen p -> [LConDecl (GhcPass p)]
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
go _ [] = ([], [])
go remSeen (r:rs)
-- Don't re-mangle the location of field names, because we don't
@@ -1286,10 +1288,10 @@ hsConDeclsBinders cons
(remSeen', flds) = get_flds remSeen args
(ns, fs) = go remSeen' rs
- XConDecl _ -> panic "hsConDeclsBinders"
+ XConDecl nec -> noExtCon nec
- get_flds :: Seen pass -> HsConDeclDetails pass
- -> (Seen pass, [LFieldOcc pass])
+ get_flds :: Seen p -> HsConDeclDetails (GhcPass p)
+ -> (Seen p, [LFieldOcc (GhcPass p)])
get_flds remSeen (RecCon flds)
= (remSeen', fld_names)
where
@@ -1355,7 +1357,7 @@ lStmtsImplicits = hs_lstmts
hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args
where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat
do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts
- do_arg (_, XApplicativeArg _) = panic "lStmtsImplicits"
+ do_arg (_, XApplicativeArg nec) = noExtCon nec
hs_stmt (LetStmt _ binds) = hs_local_binds (unLoc binds)
hs_stmt (BodyStmt {}) = []
hs_stmt (LastStmt {}) = []
@@ -1363,7 +1365,7 @@ lStmtsImplicits = hs_lstmts
, s <- ss]
hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts
hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss
- hs_stmt (XStmtLR {}) = panic "lStmtsImplicits"
+ hs_stmt (XStmtLR nec) = noExtCon nec
hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds
hs_local_binds (HsIPBinds {}) = []
View Lorry Controller Status