diff options
Diffstat (limited to 'compiler/hsSyn')
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 376 | ||||
| -rw-r--r-- | compiler/hsSyn/HsBinds.hs | 74 | ||||
| -rw-r--r-- | compiler/hsSyn/HsDecls.hs | 182 | ||||
| -rw-r--r-- | compiler/hsSyn/HsExpr.hs | 249 | ||||
| -rw-r--r-- | compiler/hsSyn/HsExtension.hs | 79 | ||||
| -rw-r--r-- | compiler/hsSyn/HsImpExp.hs | 30 | ||||
| -rw-r--r-- | compiler/hsSyn/HsLit.hs | 16 | ||||
| -rw-r--r-- | compiler/hsSyn/HsPat.hs | 54 | ||||
| -rw-r--r-- | compiler/hsSyn/HsTypes.hs | 154 | ||||
| -rw-r--r-- | compiler/hsSyn/HsUtils.hs | 216 |
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 {}) = [] |