diff options
-rw-r--r-- | compiler/deSugar/DsMeta.hs | 6 | ||||
-rw-r--r-- | compiler/hsSyn/HsBinds.hs | 32 | ||||
-rw-r--r-- | compiler/hsSyn/HsDecls.hs | 65 | ||||
-rw-r--r-- | compiler/hsSyn/HsExpr.hs | 139 | ||||
-rw-r--r-- | compiler/hsSyn/HsExpr.hs-boot | 26 | ||||
-rw-r--r-- | compiler/hsSyn/HsExtension.hs | 51 | ||||
-rw-r--r-- | compiler/hsSyn/HsLit.hs | 37 | ||||
-rw-r--r-- | compiler/hsSyn/HsPat.hs | 25 | ||||
-rw-r--r-- | compiler/hsSyn/HsPat.hs-boot | 5 | ||||
-rw-r--r-- | compiler/hsSyn/HsSyn.hs | 2 | ||||
-rw-r--r-- | compiler/hsSyn/HsTypes.hs | 44 | ||||
-rw-r--r-- | compiler/hsSyn/HsUtils.hs | 38 | ||||
-rw-r--r-- | compiler/parser/Parser.y | 25 | ||||
-rw-r--r-- | compiler/typecheck/Inst.hs | 5 | ||||
-rw-r--r-- | compiler/typecheck/TcAnnotations.hs | 3 | ||||
-rw-r--r-- | compiler/typecheck/TcBinds.hs | 3 | ||||
-rw-r--r-- | compiler/typecheck/TcEnv.hs | 4 | ||||
-rw-r--r-- | compiler/typecheck/TcInstDcls.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcPatSyn.hs | 5 | ||||
-rw-r--r-- | compiler/typecheck/TcTypeable.hs | 8 | ||||
m--------- | utils/haddock | 0 |
21 files changed, 188 insertions, 337 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index c910fbf15b..4221ca3035 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -2362,16 +2362,16 @@ repLiteral lit mk_integer :: Integer -> DsM (HsLit GhcRn) mk_integer i = do integer_ty <- lookupType integerTyConName - return $ HsInteger noSourceText i integer_ty + return $ HsInteger NoSourceText i integer_ty mk_rational :: FractionalLit -> DsM (HsLit GhcRn) mk_rational r = do rat_ty <- lookupType rationalTyConName return $ HsRat noExt r rat_ty mk_string :: FastString -> DsM (HsLit GhcRn) -mk_string s = return $ HsString noSourceText s +mk_string s = return $ HsString NoSourceText s mk_char :: Char -> DsM (HsLit GhcRn) -mk_char c = return $ HsChar noSourceText c +mk_char c = return $ HsChar NoSourceText c repOverloadedLiteral :: HsOverLit GhcRn -> DsM (Core TH.Lit) repOverloadedLiteral (OverLit { ol_val = val}) diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index 10e1307367..5073a719ef 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -580,15 +580,13 @@ Specifically, it's just an error thunk -} -instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) +instance (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) => Outputable (HsLocalBindsLR (GhcPass idL) (GhcPass idR)) where ppr (HsValBinds bs) = ppr bs ppr (HsIPBinds bs) = ppr bs ppr EmptyLocalBinds = empty -instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) +instance (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) => Outputable (HsValBindsLR (GhcPass idL) (GhcPass idR)) where ppr (ValBinds _ binds sigs) = pprDeclList (pprLHsBindsForUser binds sigs) @@ -604,17 +602,14 @@ instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), pp_rec Recursive = text "rec" pp_rec NonRecursive = text "nonrec" -pprLHsBinds :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) +pprLHsBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc pprLHsBinds binds | isEmptyLHsBinds binds = empty | otherwise = pprDeclList (map ppr (bagToList binds)) -pprLHsBindsForUser :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), +pprLHsBindsForUser :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR), - SourceTextX (GhcPass id2), OutputableBndrId (GhcPass id2)) => LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc] -- pprLHsBindsForUser is different to pprLHsBinds because @@ -682,13 +677,11 @@ plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1)) plusHsValBinds _ _ = panic "HsBinds.plusHsValBinds" -instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) +instance (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) => Outputable (HsBindLR (GhcPass idL) (GhcPass idR)) where ppr mbind = ppr_monobind mbind -ppr_monobind :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) +ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss }) @@ -729,8 +722,7 @@ instance (OutputableBndrId p) => Outputable (ABExport p) where , nest 2 (pprTcSpecPrags prags) , nest 2 (text "wrap:" <+> ppr wrap)] -instance (SourceTextX (GhcPass idR), - OutputableBndrId idL, OutputableBndrId (GhcPass idR)) +instance (OutputableBndrId idL, OutputableBndrId (GhcPass idR)) => Outputable (PatSynBind idL (GhcPass idR)) where ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat, psb_dir = dir }) @@ -802,12 +794,12 @@ data IPBind id = IPBind (Either (Located HsIPName) (IdP id)) (LHsExpr id) deriving instance (DataIdLR id id) => Data (IPBind id) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsIPBinds (GhcPass p)) where ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs) $$ whenPprDebug (ppr ds) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p) ) +instance (OutputableBndrId (GhcPass p) ) => Outputable (IPBind (GhcPass p)) where ppr (IPBind lr rhs) = name <+> equals <+> pprExpr (unLoc rhs) where name = case lr of @@ -1081,12 +1073,10 @@ signatures. Since some of the signatures contain a list of names, testing for equality is not enough -- we have to check if they overlap. -} -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (Sig (GhcPass p)) where +instance (OutputableBndrId (GhcPass p)) => Outputable (Sig (GhcPass p)) where ppr sig = ppr_sig sig -ppr_sig :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p) ) - => Sig (GhcPass p) -> SDoc +ppr_sig :: (OutputableBndrId (GhcPass p)) => Sig (GhcPass p) -> SDoc ppr_sig (TypeSig vars ty) = pprVarSig (map unLoc vars) (ppr ty) ppr_sig (ClassOpSig is_deflt vars ty) | is_deflt = text "default" <+> pprVarSig (map unLoc vars) (ppr ty) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 9e05a3d1c1..a8e5403446 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -256,8 +256,7 @@ appendGroups hs_vects = vects1 ++ vects2, hs_docs = docs1 ++ docs2 } -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsDecl (GhcPass p)) where +instance (OutputableBndrId (GhcPass p)) => Outputable (HsDecl (GhcPass p)) where ppr (TyClD dcl) = ppr dcl ppr (ValD binds) = ppr binds ppr (DefD def) = ppr def @@ -273,7 +272,7 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) ppr (DocD doc) = ppr doc ppr (RoleAnnotD ra) = ppr ra -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsGroup (GhcPass p)) where ppr (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls, @@ -318,7 +317,7 @@ data SpliceDecl id SpliceExplicitFlag deriving instance (DataIdLR id id) => Data (SpliceDecl id) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (SpliceDecl (GhcPass p)) where ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f @@ -643,7 +642,7 @@ hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~ -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (TyClDecl (GhcPass p)) where ppr (FamDecl { tcdFam = decl }) = ppr decl @@ -675,7 +674,7 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context) <+> pprFundeps (map unLoc fds) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (TyClGroup (GhcPass p)) where ppr (TyClGroup { group_tyclds = tyclds , group_roles = roles @@ -686,7 +685,7 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) ppr roles $$ ppr instds -pp_vanilla_decl_head :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p)) => Located (IdP (GhcPass p)) -> LHsQTyVars (GhcPass p) -> LexicalFixity @@ -974,11 +973,11 @@ resultVariableName :: FamilyResultSig a -> Maybe (IdP a) resultVariableName (TyVarSig sig) = Just $ hsLTyVarName sig resultVariableName _ = Nothing -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (FamilyDecl (GhcPass p)) where ppr = pprFamilyDecl TopLevel -pprFamilyDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprFamilyDecl :: (OutputableBndrId (GhcPass p)) => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon , fdTyVars = tyvars @@ -1096,7 +1095,7 @@ data HsDerivingClause pass } deriving instance (DataIdLR id id) => Data (HsDerivingClause id) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsDerivingClause (GhcPass p)) where ppr (HsDerivingClause { deriv_clause_strategy = dcs , deriv_clause_tys = L _ dct }) @@ -1214,7 +1213,7 @@ hsConDeclArgTys (PrefixCon tys) = tys hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2] hsConDeclArgTys (RecCon flds) = map (cd_fld_type . unLoc) (unLoc flds) -pp_data_defn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pp_data_defn :: (OutputableBndrId (GhcPass p)) => (HsContext (GhcPass p) -> SDoc) -- Printing the header -> HsDataDefn (GhcPass p) -> SDoc @@ -1238,7 +1237,7 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context Just kind -> dcolon <+> ppr kind pp_derivings (L _ ds) = vcat (map ppr ds) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsDataDefn (GhcPass p)) where ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d @@ -1246,19 +1245,17 @@ instance Outputable NewOrData where ppr NewType = text "newtype" ppr DataType = text "data" -pp_condecls :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => [LConDecl (GhcPass p)] -> SDoc +pp_condecls :: (OutputableBndrId (GhcPass p)) => [LConDecl (GhcPass p)] -> SDoc pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax = hang (text "where") 2 (vcat (map ppr cs)) pp_condecls cs -- In H98 syntax = equals <+> sep (punctuate (text " |") (map ppr cs)) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (ConDecl (GhcPass p)) where ppr = pprConDecl -pprConDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => ConDecl (GhcPass p) -> SDoc +pprConDecl :: (OutputableBndrId (GhcPass p)) => ConDecl (GhcPass p) -> SDoc pprConDecl (ConDeclH98 { con_name = L _ con , con_qvars = mtvs , con_cxt = mcxt @@ -1479,11 +1476,11 @@ data InstDecl pass -- Both class and family instances { tfid_inst :: TyFamInstDecl pass } deriving instance (DataIdLR id id) => Data (InstDecl id) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (TyFamInstDecl (GhcPass p)) where ppr = pprTyFamInstDecl TopLevel -pprTyFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprTyFamInstDecl :: (OutputableBndrId (GhcPass p)) => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn }) = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn @@ -1492,7 +1489,7 @@ ppr_instance_keyword :: TopLevelFlag -> SDoc ppr_instance_keyword TopLevel = text "instance" ppr_instance_keyword NotTopLevel = empty -ppr_fam_inst_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +ppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p)) => TyFamInstEqn (GhcPass p) -> SDoc ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = tycon , feqn_pats = pats @@ -1500,7 +1497,7 @@ ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = tycon , feqn_rhs = rhs }}) = pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs -ppr_fam_deflt_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +ppr_fam_deflt_eqn :: (OutputableBndrId (GhcPass p)) => LTyFamDefltEqn (GhcPass p) -> SDoc ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon , feqn_pats = tvs @@ -1509,11 +1506,11 @@ ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon = text "type" <+> pp_vanilla_decl_head tycon tvs fixity [] <+> equals <+> ppr rhs -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (DataFamInstDecl (GhcPass p)) where ppr = pprDataFamInstDecl TopLevel -pprDataFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprDataFamInstDecl :: (OutputableBndrId (GhcPass p)) => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = tycon @@ -1530,7 +1527,7 @@ pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}}) = ppr nd -pprFamInstLHS :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprFamInstLHS :: (OutputableBndrId (GhcPass p)) => Located (IdP (GhcPass p)) -> HsTyPats (GhcPass p) -> LexicalFixity @@ -1555,7 +1552,7 @@ pprFamInstLHS thing typats fixity context mb_kind_sig | otherwise = empty -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (ClsInstDecl (GhcPass p)) where ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds , cid_sigs = sigs, cid_tyfam_insts = ats @@ -1594,7 +1591,7 @@ ppOverlapPragma mb = maybe_stext (SourceText src) _ = text src <+> text "#-}" -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (InstDecl (GhcPass p)) where ppr (ClsInstD { cid_inst = decl }) = ppr decl ppr (TyFamInstD { tfid_inst = decl }) = ppr decl @@ -1636,7 +1633,7 @@ data DerivDecl pass = DerivDecl } deriving instance (DataIdLR pass pass) => Data (DerivDecl pass) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (DerivDecl (GhcPass p)) where ppr (DerivDecl { deriv_type = ty , deriv_strategy = ds @@ -1671,7 +1668,7 @@ data DefaultDecl pass -- For details on above see note [Api annotations] in ApiAnnotation deriving instance (DataIdLR pass pass) => Data (DefaultDecl pass) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (DefaultDecl (GhcPass p)) where ppr (DefaultDecl tys) @@ -1775,7 +1772,7 @@ data ForeignExport = CExport (Located CExportSpec) -- contains the calling -- pretty printing of foreign declarations -- -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (ForeignDecl (GhcPass p)) where ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport }) = hang (text "foreign import" <+> ppr fimport <+> ppr n) @@ -1882,13 +1879,13 @@ collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs] pprFullRuleName :: Located (SourceText, RuleName) -> SDoc pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (RuleDecls (GhcPass p)) where ppr (HsRules st rules) = pprWithSourceText st (text "{-# RULES") <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}" -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (RuleDecl (GhcPass p)) where ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs) = sep [pprFullRuleName name <+> ppr act, @@ -1898,7 +1895,7 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) pp_forall | null ns = empty | otherwise = forAllLit <+> fsep (map ppr ns) <> dot -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (RuleBndr (GhcPass p)) where ppr (RuleBndr name) = ppr name ppr (RuleBndrSig name ty) = parens (ppr name <> dcolon <> ppr ty) @@ -1986,7 +1983,7 @@ lvectInstDecl (L _ (HsVectInstIn _)) = True lvectInstDecl (L _ (HsVectInstOut _)) = True lvectInstDecl _ = False -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (VectDecl (GhcPass p)) where ppr (HsVect _ v rhs) = sep [text "{-# VECTORISE" <+> ppr v, @@ -2108,7 +2105,7 @@ data AnnDecl pass = HsAnnotation -- For details on above see note [Api annotations] in ApiAnnotation deriving instance (DataIdLR pass pass) => Data (AnnDecl pass) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (AnnDecl (GhcPass p)) where ppr (HsAnnotation _ provenance expr) = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"] diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 6b3440ae8b..7fa12c408d 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -85,7 +85,7 @@ type PostTcExpr = HsExpr GhcTc type PostTcTable = [(Name, PostTcExpr)] noPostTcExpr :: PostTcExpr -noPostTcExpr = HsLit noExt (HsString noSourceText (fsLit "noPostTcExpr")) +noPostTcExpr = HsLit noExt (HsString NoSourceText (fsLit "noPostTcExpr")) noPostTcTable :: PostTcTable noPostTcTable = [] @@ -116,13 +116,13 @@ deriving instance (DataIdLR p p) => Data (SyntaxExpr p) -- | This is used for rebindable-syntax pieces that are too polymorphic -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt) -noExpr :: SourceTextX (GhcPass p) => HsExpr (GhcPass p) -noExpr = HsLit noExt (HsString (sourceText "noExpr") (fsLit "noExpr")) +noExpr :: HsExpr (GhcPass p) +noExpr = HsLit noExt (HsString (SourceText "noExpr") (fsLit "noExpr")) -noSyntaxExpr :: SourceTextX (GhcPass p) => SyntaxExpr (GhcPass p) +noSyntaxExpr :: SyntaxExpr (GhcPass p) -- Before renaming, and sometimes after, -- (if the syntax slot makes no sense) -noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExt (HsString noSourceText +noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExt (HsString NoSourceText (fsLit "noSyntaxExpr")) , syn_arg_wraps = [] , syn_res_wrap = WpHole } @@ -136,7 +136,7 @@ mkRnSyntaxExpr name = SyntaxExpr { syn_expr = HsVar noExt $ noLoc name -- don't care about filling in syn_arg_wraps because we're clearly -- not past the typechecker -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (SyntaxExpr (GhcPass p)) where ppr (SyntaxExpr { syn_expr = expr , syn_arg_wraps = arg_wraps @@ -950,19 +950,16 @@ RenamedSource that the API Annotations cannot be used directly with RenamedSource, so this allows a simple mapping to be used based on the location. -} -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsExpr (GhcPass p)) where +instance (OutputableBndrId (GhcPass p)) => Outputable (HsExpr (GhcPass p)) where ppr expr = pprExpr expr ----------------------- -- pprExpr, pprLExpr, pprBinds call pprDeeper; -- the underscore versions do not -pprLExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LHsExpr (GhcPass p) -> SDoc +pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc pprLExpr (L _ e) = pprExpr e -pprExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsExpr (GhcPass p) -> SDoc +pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc pprExpr e | isAtomicHsExpr e || isQuietHsExpr e = ppr_expr e | otherwise = pprDeeper (ppr_expr e) @@ -977,17 +974,15 @@ isQuietHsExpr (HsAppType {}) = True isQuietHsExpr (OpApp {}) = True isQuietHsExpr _ = False -pprBinds :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) +pprBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) => HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> SDoc pprBinds b = pprDeeper (ppr b) ----------------------- -ppr_lexpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LHsExpr (GhcPass p) -> SDoc +ppr_lexpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc ppr_lexpr e = ppr_expr (unLoc e) -ppr_expr :: forall p. (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +ppr_expr :: forall p. (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc ppr_expr (HsVar _ (L _ v)) = pprPrefixOcc v ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv) @@ -1206,16 +1201,8 @@ ppr_expr (HsArrForm _ op _ args) ppr_expr (HsRecFld _ f) = ppr f ppr_expr (XExpr x) = ppr x --- We must tiresomely make the "id" parameter to the LHsWcType existential --- because it's different in the HsAppType case and the HsAppTypeOut case --- | Located Haskell Wildcard Type Expression -data LHsWcTypeX = forall p. ( SourceTextX (GhcPass p) - , OutputableBndrId (GhcPass p)) - => LHsWcTypeX (LHsWcType (GhcPass p)) - -ppr_apps :: forall p. (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +ppr_apps :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) - -- -> [Either (LHsExpr (GhcPass p)) LHsWcTypeX] -> [Either (LHsExpr (GhcPass p)) (XAppTypeE (GhcPass p))] -> SDoc ppr_apps (HsApp _ (L _ fun) arg) args @@ -1247,19 +1234,17 @@ fixities should do the job, except in debug mode (-dppr-debug) so we can see the structure of the parse tree. -} -pprDebugParendExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprDebugParendExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc pprDebugParendExpr expr = getPprStyle (\sty -> if debugStyle sty then pprParendLExpr expr else pprLExpr expr) -pprParendLExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LHsExpr (GhcPass p) -> SDoc +pprParendLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc pprParendLExpr (L _ e) = pprParendExpr e -pprParendExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsExpr (GhcPass p) -> SDoc +pprParendExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc pprParendExpr expr | hsExprNeedsParens expr = parens (pprExpr expr) | otherwise = pprExpr expr @@ -1469,19 +1454,16 @@ type instance XCmdTop GhcTc = CmdTopTc type instance XXCmdTop (GhcPass _) = PlaceHolder -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsCmd (GhcPass p)) where +instance (OutputableBndrId (GhcPass p)) => Outputable (HsCmd (GhcPass p)) where ppr cmd = pprCmd cmd ----------------------- -- pprCmd and pprLCmd call pprDeeper; -- the underscore versions do not -pprLCmd :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LHsCmd (GhcPass p) -> SDoc +pprLCmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc pprLCmd (L _ c) = pprCmd c -pprCmd :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsCmd (GhcPass p) -> SDoc +pprCmd :: (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc pprCmd c | isQuietHsCmd c = ppr_cmd c | otherwise = pprDeeper (ppr_cmd c) @@ -1495,12 +1477,10 @@ isQuietHsCmd (HsCmdApp {}) = True isQuietHsCmd _ = False ----------------------- -ppr_lcmd :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LHsCmd (GhcPass p) -> SDoc +ppr_lcmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc ppr_lcmd c = ppr_cmd (unLoc c) -ppr_cmd :: forall p. (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsCmd (GhcPass p) -> SDoc +ppr_cmd :: forall p. (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc ppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c) ppr_cmd (HsCmdApp _ c e) @@ -1562,13 +1542,12 @@ ppr_cmd (HsCmdArrForm _ op _ _ args) 4 (sep (map (pprCmdArg.unLoc) args) <> text "|)") ppr_cmd (XCmd x) = ppr x -pprCmdArg :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsCmdTop (GhcPass p) -> SDoc +pprCmdArg :: (OutputableBndrId (GhcPass p)) => HsCmdTop (GhcPass p) -> SDoc pprCmdArg (HsCmdTop _ cmd) = ppr_lcmd cmd pprCmdArg (XCmdTop x) = ppr x -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsCmdTop (GhcPass p)) where ppr = pprCmdArg @@ -1632,8 +1611,7 @@ data Match p body } deriving instance (Data body,DataIdLR p p) => Data (Match p body) -instance (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR), - Outputable body) +instance (OutputableBndrId (GhcPass idR), Outputable body) => Outputable (Match (GhcPass idR) body) where ppr = pprMatch @@ -1730,23 +1708,19 @@ deriving instance (Data body,DataIdLR id id) => Data (GRHS id body) -- We know the list must have at least one @Match@ in it. -pprMatches :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR), - Outputable body) +pprMatches :: (OutputableBndrId (GhcPass idR), Outputable body) => MatchGroup (GhcPass idR) body -> SDoc pprMatches MG { mg_alts = matches } = vcat (map pprMatch (map unLoc (unLoc matches))) -- Don't print the type; it's only a place-holder before typechecking -- Exported to HsBinds, which can't see the defn of HsMatchContext -pprFunBind :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR), - Outputable body) +pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body) => MatchGroup (GhcPass idR) body -> SDoc pprFunBind matches = pprMatches matches -- Exported to HsBinds, which can't see the defn of HsMatchContext -pprPatBind :: forall bndr p body. (SourceTextX (GhcPass p), - SourceTextX (GhcPass bndr), - OutputableBndrId (GhcPass bndr), +pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr), OutputableBndrId (GhcPass p), Outputable body) => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc @@ -1754,8 +1728,7 @@ pprPatBind pat (grhss) = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (IdP (GhcPass p))) grhss)] -pprMatch :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR), - Outputable body) +pprMatch :: (OutputableBndrId (GhcPass idR), Outputable body) => Match (GhcPass idR) body -> SDoc pprMatch match = sep [ sep (herald : map (nest 2 . pprParendLPat) other_pats) @@ -1789,8 +1762,7 @@ pprMatch match (pat1:pats1) = m_pats match (pat2:pats2) = pats1 -pprGRHSs :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR), - Outputable body) +pprGRHSs :: (OutputableBndrId (GhcPass idR), Outputable body) => HsMatchContext idL -> GRHSs (GhcPass idR) body -> SDoc pprGRHSs ctxt (GRHSs grhss (L _ binds)) = vcat (map (pprGRHS ctxt . unLoc) grhss) @@ -1799,8 +1771,7 @@ pprGRHSs ctxt (GRHSs grhss (L _ binds)) $$ ppUnless (eqEmptyLocalBinds binds) (text "where" $$ nest 4 (pprBinds binds)) -pprGRHS :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR), - Outputable body) +pprGRHS :: (OutputableBndrId (GhcPass idR), Outputable body) => HsMatchContext idL -> GRHS (GhcPass idR) body -> SDoc pprGRHS ctxt (GRHS [] body) = pp_rhs ctxt body @@ -2185,21 +2156,18 @@ Bool flag that is True when the original statement was a BodyStmt, so that we can pretty-print it correctly. -} -instance (SourceTextX (GhcPass idL), OutputableBndrId (GhcPass idL), +instance (OutputableBndrId (GhcPass idL), Outputable (XXParStmtBlock (GhcPass idL) idR)) => Outputable (ParStmtBlock (GhcPass idL) idR) where ppr (ParStmtBlock _ stmts _ _) = interpp'SP stmts ppr (XParStmtBlock x) = ppr x -instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR), +instance (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR), Outputable body) => Outputable (StmtLR (GhcPass idL) (GhcPass idR) body) where ppr stmt = pprStmt stmt -pprStmt :: forall idL idR body . (SourceTextX (GhcPass idL), - SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), +pprStmt :: forall idL idR body . (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR), Outputable body) => (StmtLR (GhcPass idL) (GhcPass idR) body) -> SDoc @@ -2272,7 +2240,7 @@ pprStmt (ApplicativeStmt args mb_join _) ppr (HsDo (panic "pprStmt") DoExpr (noLoc (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)]))) -pprTransformStmt :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprTransformStmt :: (OutputableBndrId (GhcPass p)) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) -> Maybe (LHsExpr (GhcPass p)) -> SDoc pprTransformStmt bndrs using by @@ -2290,8 +2258,7 @@ pprBy :: Outputable body => Maybe body -> SDoc pprBy Nothing = empty pprBy (Just e) = text "by" <+> ppr e -pprDo :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p), - Outputable body) +pprDo :: (OutputableBndrId (GhcPass p), Outputable body) => HsStmtContext any -> [LStmt (GhcPass p) body] -> SDoc pprDo DoExpr stmts = text "do" <+> ppr_do_stmts stmts pprDo GhciStmtCtxt stmts = text "do" <+> ppr_do_stmts stmts @@ -2302,15 +2269,13 @@ pprDo PArrComp stmts = paBrackets $ pprComp stmts pprDo MonadComp stmts = brackets $ pprComp stmts pprDo _ _ = panic "pprDo" -- PatGuard, ParStmtCxt -ppr_do_stmts :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR), +ppr_do_stmts :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR), Outputable body) => [LStmtLR (GhcPass idL) (GhcPass idR) body] -> SDoc -- Print a bunch of do stmts ppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts) -pprComp :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p), - Outputable body) +pprComp :: (OutputableBndrId (GhcPass p), Outputable body) => [LStmt (GhcPass p) body] -> SDoc pprComp quals -- Prints: body | qual1, ..., qualn | Just (initStmts, L _ (LastStmt body _ _)) <- snocView quals @@ -2325,8 +2290,7 @@ pprComp quals -- Prints: body | qual1, ..., qualn | otherwise = pprPanic "pprComp" (pprQuals quals) -pprQuals :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p), - Outputable body) +pprQuals :: (OutputableBndrId (GhcPass p), Outputable body) => [LStmt (GhcPass p) body] -> SDoc -- Show list comprehension qualifiers separated by commas pprQuals quals = interpp'SP quals @@ -2509,33 +2473,32 @@ splices. In contrast, when pretty printing the output of the type checker, we sense, although I hate to add another constructor to HsExpr. -} -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsSplicedThing (GhcPass p)) where ppr (HsSplicedExpr e) = ppr_expr e ppr (HsSplicedTy t) = ppr t ppr (HsSplicedPat p) = ppr p -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsSplice (GhcPass p)) where ppr s = pprSplice s -pprPendingSplice :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprPendingSplice :: (OutputableBndrId (GhcPass p)) => SplicePointName -> LHsExpr (GhcPass p) -> SDoc pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e) -pprSpliceDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprSpliceDecl :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e pprSpliceDecl e ExplicitSplice = text "$(" <> ppr_splice_decl e <> text ")" pprSpliceDecl e ImplicitSplice = ppr_splice_decl e -ppr_splice_decl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +ppr_splice_decl :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty ppr_splice_decl e = pprSplice e -pprSplice :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsSplice (GhcPass p) -> SDoc +pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc pprSplice (HsTypedSplice _ HasParens n e) = ppr_splice (text "$$(") n e (text ")") pprSplice (HsTypedSplice _ HasDollar n e) @@ -2557,7 +2520,7 @@ ppr_quasi n quoter quote = whenPprDebug (brackets (ppr n)) <> char '[' <> ppr quoter <> vbar <> ppr quote <> text "|]" -ppr_splice :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +ppr_splice :: (OutputableBndrId (GhcPass p)) => SDoc -> (IdP (GhcPass p)) -> LHsExpr (GhcPass p) -> SDoc -> SDoc ppr_splice herald n e trail = herald <> whenPprDebug (brackets (ppr n)) <> ppr e <> trail @@ -2588,13 +2551,12 @@ isTypedBracket :: HsBracket id -> Bool isTypedBracket (TExpBr {}) = True isTypedBracket _ = False -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsBracket (GhcPass p)) where ppr = pprHsBracket -pprHsBracket :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsBracket (GhcPass p) -> SDoc +pprHsBracket :: (OutputableBndrId (GhcPass p)) => HsBracket (GhcPass p) -> SDoc pprHsBracket (ExpBr _ e) = thBrackets empty (ppr e) pprHsBracket (PatBr _ p) = thBrackets (char 'p') (ppr p) pprHsBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp) @@ -2641,7 +2603,7 @@ data ArithSeqInfo id deriving instance (DataIdLR id id) => Data (ArithSeqInfo id) -- AZ: Sould ArithSeqInfo have a TTG extension? -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (ArithSeqInfo (GhcPass p)) where ppr (From e1) = hcat [ppr e1, pp_dotdot] ppr (FromThen e1 e2) = hcat [ppr e1, comma, space, ppr e2, pp_dotdot] @@ -2858,7 +2820,7 @@ matchContextErrString (StmtCtxt ListComp) = text "list comprehension" matchContextErrString (StmtCtxt MonadComp) = text "monad comprehension" matchContextErrString (StmtCtxt PArrComp) = text "array comprehension" -pprMatchInCtxt :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR), +pprMatchInCtxt :: (OutputableBndrId (GhcPass idR), -- TODO:AZ these constraints do not make sense Outputable (NameOrRdrName (NameOrRdrName (IdP (GhcPass idR)))), Outputable body) @@ -2867,8 +2829,7 @@ pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match) <> colon) 4 (pprMatch match) -pprStmtInCtxt :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR), - OutputableBndrId (GhcPass idL), +pprStmtInCtxt :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR), Outputable body) => HsStmtContext (IdP (GhcPass idL)) diff --git a/compiler/hsSyn/HsExpr.hs-boot b/compiler/hsSyn/HsExpr.hs-boot index 500d601477..3b24ea8ba8 100644 --- a/compiler/hsSyn/HsExpr.hs-boot +++ b/compiler/hsSyn/HsExpr.hs-boot @@ -13,7 +13,7 @@ import SrcLoc ( Located ) import Outputable ( SDoc, Outputable ) import {-# SOURCE #-} HsPat ( LPat ) import BasicTypes ( SpliceExplicitFlag(..)) -import HsExtension ( OutputableBndrId, DataIdLR, SourceTextX, GhcPass ) +import HsExtension ( OutputableBndrId, DataIdLR, GhcPass ) import Data.Data hiding ( Fixity ) type role HsExpr nominal @@ -36,32 +36,24 @@ instance (Data body,DataIdLR p p) => Data (MatchGroup p body) instance (Data body,DataIdLR p p) => Data (GRHSs p body) instance (DataIdLR p p) => Data (SyntaxExpr p) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsExpr (GhcPass p)) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsCmd (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsExpr (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsCmd (GhcPass p)) type LHsExpr a = Located (HsExpr a) -pprLExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LHsExpr (GhcPass p) -> SDoc +pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc -pprExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsExpr (GhcPass p) -> SDoc +pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc -pprSplice :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsSplice (GhcPass p) -> SDoc +pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc -pprSpliceDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprSpliceDecl :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc -pprPatBind :: forall bndr p body. (SourceTextX (GhcPass p), - SourceTextX (GhcPass bndr), - OutputableBndrId (GhcPass bndr), +pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr), OutputableBndrId (GhcPass p), Outputable body) => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc -pprFunBind :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR), - Outputable body) +pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body) => MatchGroup (GhcPass idR) body -> SDoc diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs index 86a0bd9431..4be7cc0766 100644 --- a/compiler/hsSyn/HsExtension.hs +++ b/compiler/hsSyn/HsExtension.hs @@ -21,8 +21,6 @@ import GhcPrelude import GHC.Exts (Constraint) import Data.Data hiding ( Fixity ) import PlaceHolder -import BasicTypes -import ConLike import NameSet import Name import RdrName @@ -31,7 +29,6 @@ import Type ( Type ) import Outputable import SrcLoc (Located) import Coercion -import TcEvidence {- Note [Trees that grow] @@ -506,47 +503,6 @@ type ForallXParStmtBlock (c :: * -> Constraint) (x :: *) (x' :: *) = , c (XXParStmtBlock x x') ) --- --------------------------------------------------------------------- - --- | The 'SourceText' fields have been moved into the extension fields, thus --- placing a requirement in the extension field to contain a 'SourceText' so --- that the pretty printing and round tripping of source can continue to --- operate. --- --- The 'HasSourceText' class captures this requirement for the relevant fields. -class HasSourceText a where - -- Provide setters to mimic existing constructors - noSourceText :: a - sourceText :: String -> a - - setSourceText :: SourceText -> a - getSourceText :: a -> SourceText - --- | Provide a summary constraint that lists all the extension points requiring --- the 'HasSourceText' class, so that it can be changed in one place as the --- named extensions change throughout the AST. -type SourceTextX x = - ( HasSourceText (XHsChar x) - , HasSourceText (XHsCharPrim x) - , HasSourceText (XHsString x) - , HasSourceText (XHsStringPrim x) - , HasSourceText (XHsIntPrim x) - , HasSourceText (XHsWordPrim x) - , HasSourceText (XHsInt64Prim x) - , HasSourceText (XHsWord64Prim x) - , HasSourceText (XHsInteger x) - ) - - --- | 'SourceText' trivially implements 'HasSourceText' -instance HasSourceText SourceText where - noSourceText = NoSourceText - sourceText s = SourceText s - - setSourceText s = s - getSourceText a = a - - -- ---------------------------------------------------------------------- -- | Conversion of annotations from one type index to another. This is required -- where the AST is converted from one pass to another, and the extension values @@ -640,20 +596,13 @@ type DataId p = , Data (NameOrRdrName (IdP p)) , Data (IdP p) - , Data (PostRn p (IdP p)) , Data (PostRn p (Located Name)) , Data (PostRn p Bool) - , Data (PostRn p Fixity) , Data (PostRn p NameSet) , Data (PostRn p [Name]) - , Data (PostTc p (IdP p)) , Data (PostTc p Coercion) - , Data (PostTc p ConLike) - , Data (PostTc p HsWrapper) , Data (PostTc p Type) - , Data (PostTc p [ConLike]) - , Data (PostTc p [Type]) ) type DataIdLR pL pR = diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs index a47b0ff4fe..0ca9bbbace 100644 --- a/compiler/hsSyn/HsLit.hs +++ b/compiler/hsSyn/HsLit.hs @@ -233,28 +233,20 @@ instance Ord OverLitVal where compare (HsIsString _ _) (HsFractional _) = GT -- Instance specific to GhcPs, need the SourceText -instance (SourceTextX (GhcPass x)) => Outputable (HsLit (GhcPass x)) where - ppr (HsChar st c) = pprWithSourceText (getSourceText st) (pprHsChar c) - ppr (HsCharPrim st c) - = pp_st_suffix (getSourceText st) primCharSuffix (pprPrimChar c) - ppr (HsString st s) - = pprWithSourceText (getSourceText st) (pprHsString s) - ppr (HsStringPrim st s) - = pprWithSourceText (getSourceText st) (pprHsBytes s) - ppr (HsInt _ i) - = pprWithSourceText (il_text i) (integer (il_value i)) - ppr (HsInteger st i _) = pprWithSourceText (getSourceText st) (integer i) +instance Outputable (HsLit (GhcPass x)) where + ppr (HsChar st c) = pprWithSourceText st (pprHsChar c) + ppr (HsCharPrim st c) = pp_st_suffix st primCharSuffix (pprPrimChar c) + ppr (HsString st s) = pprWithSourceText st (pprHsString s) + ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s) + ppr (HsInt _ i) = pprWithSourceText (il_text i) (integer (il_value i)) + ppr (HsInteger st i _) = pprWithSourceText st (integer i) ppr (HsRat _ f _) = ppr f ppr (HsFloatPrim _ f) = ppr f <> primFloatSuffix ppr (HsDoublePrim _ d) = ppr d <> primDoubleSuffix - ppr (HsIntPrim st i) - = pprWithSourceText (getSourceText st) (pprPrimInt i) - ppr (HsWordPrim st w) - = pprWithSourceText (getSourceText st) (pprPrimWord w) - ppr (HsInt64Prim st i) - = pp_st_suffix (getSourceText st) primInt64Suffix (pprPrimInt64 i) - ppr (HsWord64Prim st w) - = pp_st_suffix (getSourceText st) primWord64Suffix (pprPrimWord64 w) + ppr (HsIntPrim st i) = pprWithSourceText st (pprPrimInt i) + ppr (HsWordPrim st w) = pprWithSourceText st (pprPrimWord w) + ppr (HsInt64Prim st i) = pp_st_suffix st primInt64Suffix (pprPrimInt64 i) + ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w) ppr (XLit x) = ppr x pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc @@ -262,7 +254,7 @@ pp_st_suffix NoSourceText _ doc = doc pp_st_suffix (SourceText st) suffix _ = text st <> suffix -- in debug mode, print the expression that it's resolved to, too -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsOverLit (GhcPass p)) where ppr (OverLit {ol_val=val, ol_witness=witness}) = ppr val <+> (whenPprDebug (parens (pprExpr witness))) @@ -279,11 +271,10 @@ instance Outputable OverLitVal where -- mainly for too reasons: -- * We do not want to expose their internal representation -- * The warnings become too messy -pmPprHsLit :: (SourceTextX (GhcPass x)) => HsLit (GhcPass x) -> SDoc +pmPprHsLit :: HsLit (GhcPass x) -> SDoc pmPprHsLit (HsChar _ c) = pprHsChar c pmPprHsLit (HsCharPrim _ c) = pprHsChar c -pmPprHsLit (HsString st s) = pprWithSourceText (getSourceText st) - (pprHsString s) +pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s) pmPprHsLit (HsStringPrim _ s) = pprHsBytes s pmPprHsLit (HsInt _ i) = integer (il_value i) pmPprHsLit (HsIntPrim _ i) = integer i diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 863f00c99b..4cc357cba5 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -482,8 +482,7 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl ************************************************************************ -} -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (Pat (GhcPass p)) where +instance (OutputableBndrId (GhcPass p)) => Outputable (Pat (GhcPass p)) where ppr = pprPat pprPatBndr :: OutputableBndr name => name -> SDoc @@ -495,12 +494,10 @@ pprPatBndr var -- Print with type info if -dppr-debug is on else pprPrefixOcc var -pprParendLPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LPat (GhcPass p) -> SDoc +pprParendLPat :: (OutputableBndrId (GhcPass p)) => LPat (GhcPass p) -> SDoc pprParendLPat (L _ p) = pprParendPat p -pprParendPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Pat (GhcPass p) -> SDoc +pprParendPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc pprParendPat p = sdocWithDynFlags $ \ dflags -> if need_parens dflags p then parens (pprPat p) @@ -514,8 +511,7 @@ pprParendPat p = sdocWithDynFlags $ \ dflags -> -- But otherwise the CoPat is discarded, so it -- is the pattern inside that matters. Sigh. -pprPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Pat (GhcPass p) -> SDoc +pprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc pprPat (VarPat _ (L _ var)) = pprPatBndr var pprPat (WildPat _) = char '_' pprPat (LazyPat _ pat) = char '~' <> pprParendLPat pat @@ -553,13 +549,12 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts, else pprUserCon (unLoc con) details pprPat (XPat x) = ppr x -pprUserCon :: (SourceTextX (GhcPass p), OutputableBndr con, - OutputableBndrId (GhcPass p)) +pprUserCon :: (OutputableBndr con, OutputableBndrId (GhcPass p)) => con -> HsConPatDetails (GhcPass p) -> SDoc pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2 pprUserCon c details = pprPrefixOcc c <+> pprConArgs details -pprConArgs :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprConArgs :: (OutputableBndrId (GhcPass p)) => HsConPatDetails (GhcPass p) -> SDoc pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats) pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2] @@ -599,11 +594,9 @@ mkPrefixConPat dc pats tys mkNilPat :: Type -> OutPat p mkNilPat ty = mkPrefixConPat nilDataCon [] [ty] -mkCharLitPat :: (SourceTextX (GhcPass p)) - => SourceText -> Char -> OutPat (GhcPass p) +mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p) mkCharLitPat src c = mkPrefixConPat charDataCon - [noLoc $ LitPat noExt - (HsCharPrim (setSourceText src) c)] + [noLoc $ LitPat noExt (HsCharPrim src c)] [] {- @@ -664,7 +657,7 @@ looksLazyLPat (L _ (VarPat {})) = False looksLazyLPat (L _ (WildPat {})) = False looksLazyLPat _ = True -isIrrefutableHsPat :: (SourceTextX p, OutputableBndrId p) => LPat p -> Bool +isIrrefutableHsPat :: (OutputableBndrId p) => LPat p -> Bool -- (isIrrefutableHsPat p) is true if matching against p cannot fail, -- in the sense of falling through to the next pattern. -- (NB: this is not quite the same as the (silly) defn diff --git a/compiler/hsSyn/HsPat.hs-boot b/compiler/hsSyn/HsPat.hs-boot index eb090bdd8f..5f1b101436 100644 --- a/compiler/hsSyn/HsPat.hs-boot +++ b/compiler/hsSyn/HsPat.hs-boot @@ -11,12 +11,11 @@ import SrcLoc( Located ) import Data.Data hiding (Fixity) import Outputable -import HsExtension ( SourceTextX, DataIdLR, OutputableBndrId, GhcPass ) +import HsExtension ( DataIdLR, OutputableBndrId, GhcPass ) type role Pat nominal data Pat (i :: *) type LPat i = Located (Pat i) instance (DataIdLR p p) => Data (Pat p) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (Pat (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (Pat (GhcPass p)) diff --git a/compiler/hsSyn/HsSyn.hs b/compiler/hsSyn/HsSyn.hs index 4a3eca31c6..3ab80f4c2f 100644 --- a/compiler/hsSyn/HsSyn.hs +++ b/compiler/hsSyn/HsSyn.hs @@ -113,7 +113,7 @@ data HsModule name -- For details on above see note [Api annotations] in ApiAnnotation deriving instance (DataIdLR name name) => Data (HsModule name) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsModule (GhcPass p)) where ppr (HsModule Nothing _ imports decls _ mbDoc) diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index be70fe8ec8..4a01bbe0aa 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -715,7 +715,7 @@ type instance XAppInfix (GhcPass _) = PlaceHolder type instance XAppPrefix (GhcPass _) = PlaceHolder type instance XXAppType (GhcPass _) = PlaceHolder -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsAppType (GhcPass p)) where ppr = ppr_app_ty @@ -860,7 +860,7 @@ data ConDeclField pass -- Record fields have Haddoc docs on them -- For details on above see note [Api annotations] in ApiAnnotation deriving instance (DataIdLR pass pass) => Data (ConDeclField pass) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (ConDeclField (GhcPass p)) where ppr (ConDeclField fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty @@ -1293,18 +1293,17 @@ ambiguousFieldOcc (XFieldOcc _) = panic "ambiguousFieldOcc" ************************************************************************ -} -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsType (GhcPass p)) where +instance (OutputableBndrId (GhcPass p)) => Outputable (HsType (GhcPass p)) where ppr ty = pprHsType ty instance Outputable HsTyLit where ppr = ppr_tylit -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (LHsQTyVars (GhcPass p)) where ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +instance (OutputableBndrId (GhcPass p)) => Outputable (HsTyVarBndr (GhcPass p)) where ppr (UserTyVar _ n) = ppr n ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k] @@ -1322,7 +1321,7 @@ instance Outputable (HsWildCardInfo pass) where pprAnonWildCard :: SDoc pprAnonWildCard = char '_' -pprHsForAll :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprHsForAll :: (OutputableBndrId (GhcPass p)) => [LHsTyVarBndr (GhcPass p)] -> LHsContext (GhcPass p) -> SDoc pprHsForAll = pprHsForAllExtra Nothing @@ -1333,7 +1332,7 @@ pprHsForAll = pprHsForAllExtra Nothing -- function for this is needed, as the extra-constraints wildcard is removed -- from the actual context and type, and stored in a separate field, thus just -- printing the type will not print the extra-constraints wildcard. -pprHsForAllExtra :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprHsForAllExtra :: (OutputableBndrId (GhcPass p)) => Maybe SrcSpan -> [LHsTyVarBndr (GhcPass p)] -> LHsContext (GhcPass p) -> SDoc pprHsForAllExtra extra qtvs cxt @@ -1341,35 +1340,34 @@ pprHsForAllExtra extra qtvs cxt where show_extra = isJust extra -pprHsForAllTvs :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprHsForAllTvs :: (OutputableBndrId (GhcPass p)) => [LHsTyVarBndr (GhcPass p)] -> SDoc pprHsForAllTvs qtvs | null qtvs = whenPprDebug (forAllLit <+> dot) | otherwise = forAllLit <+> interppSP qtvs <> dot -pprHsContext :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsContext (GhcPass p) -> SDoc +pprHsContext :: (OutputableBndrId (GhcPass p)) => HsContext (GhcPass p) -> SDoc pprHsContext = maybe empty (<+> darrow) . pprHsContextMaybe -pprHsContextNoArrow :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprHsContextNoArrow :: (OutputableBndrId (GhcPass p)) => HsContext (GhcPass p) -> SDoc pprHsContextNoArrow = fromMaybe empty . pprHsContextMaybe -pprHsContextMaybe :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprHsContextMaybe :: (OutputableBndrId (GhcPass p)) => HsContext (GhcPass p) -> Maybe SDoc pprHsContextMaybe [] = Nothing pprHsContextMaybe [L _ pred] = Just $ ppr_mono_ty pred pprHsContextMaybe cxt = Just $ parens (interpp'SP cxt) -- For use in a HsQualTy, which always gets printed if it exists. -pprHsContextAlways :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprHsContextAlways :: (OutputableBndrId (GhcPass p)) => HsContext (GhcPass p) -> SDoc pprHsContextAlways [] = parens empty <+> darrow pprHsContextAlways [L _ ty] = ppr_mono_ty ty <+> darrow pprHsContextAlways cxt = parens (interpp'SP cxt) <+> darrow -- True <=> print an extra-constraints wildcard, e.g. @(Show a, _) =>@ -pprHsContextExtra :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprHsContextExtra :: (OutputableBndrId (GhcPass p)) => Bool -> HsContext (GhcPass p) -> SDoc pprHsContextExtra show_extra ctxt | not show_extra @@ -1381,7 +1379,7 @@ pprHsContextExtra show_extra ctxt where ctxt' = map ppr ctxt ++ [char '_'] -pprConDeclFields :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +pprConDeclFields :: (OutputableBndrId (GhcPass p)) => [LConDeclField (GhcPass p)] -> SDoc pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields))) where @@ -1406,16 +1404,13 @@ seems like the Right Thing anyway.) -- Printing works more-or-less as for Types -pprHsType :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsType (GhcPass p) -> SDoc +pprHsType :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc pprHsType ty = ppr_mono_ty ty -ppr_mono_lty :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LHsType (GhcPass p) -> SDoc +ppr_mono_lty :: (OutputableBndrId (GhcPass p)) => LHsType (GhcPass p) -> SDoc ppr_mono_lty ty = ppr_mono_ty (unLoc ty) -ppr_mono_ty :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsType (GhcPass p) -> SDoc +ppr_mono_ty :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc ppr_mono_ty (HsForAllTy { hst_bndrs = tvs, hst_body = ty }) = sep [pprHsForAllTvs tvs, ppr_mono_lty ty] @@ -1477,7 +1472,7 @@ ppr_mono_ty (HsDocTy _ ty doc) -- postfix operators -------------------------- -ppr_fun_ty :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +ppr_fun_ty :: (OutputableBndrId (GhcPass p)) => LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc ppr_fun_ty ty1 ty2 = let p1 = ppr_mono_lty ty1 @@ -1486,8 +1481,7 @@ ppr_fun_ty ty1 ty2 sep [p1, text "->" <+> p2] -------------------------- -ppr_app_ty :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsAppType (GhcPass p) -> SDoc +ppr_app_ty :: (OutputableBndrId (GhcPass p)) => HsAppType (GhcPass p) -> SDoc ppr_app_ty (HsAppInfix _ (L _ n)) = pprInfixOcc n ppr_app_ty (HsAppPrefix _ (L _ (HsTyVar _ NotPromoted (L _ n)))) = pprPrefixOcc n diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index e5f0fb6187..76090f5685 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -240,13 +240,11 @@ mkNPat :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> Pat GhcPs mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs -mkLastStmt :: SourceTextX (GhcPass idR) - => Located (bodyR (GhcPass idR)) +mkLastStmt :: Located (bodyR (GhcPass idR)) -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) mkBodyStmt :: Located (bodyR GhcPs) -> StmtLR idL GhcPs (Located (bodyR GhcPs)) -mkBindStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) +mkBindStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder) => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR)) -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc) @@ -270,8 +268,7 @@ mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt]) where last_stmt = L (getLoc expr) $ mkLastStmt expr -mkHsIf :: SourceTextX (GhcPass p) - => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) +mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p) mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b @@ -279,27 +276,22 @@ mkNPat lit neg = NPat noExt lit neg noSyntaxExpr mkNPlusKPat id lit = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr -mkTransformStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) +mkTransformStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder) => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR) -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL)) -mkTransformByStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) +mkTransformByStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder) => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR) -> LHsExpr (GhcPass idR) -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL)) -mkGroupUsingStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) +mkGroupUsingStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder) => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR) -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL)) -mkGroupByUsingStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) +mkGroupByUsingStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder) => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR) -> LHsExpr (GhcPass idR) -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL)) -emptyTransStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) +emptyTransStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder) => StmtLR idL (GhcPass idR) (LHsExpr (GhcPass idR)) emptyTransStmt = TransStmt { trS_form = panic "emptyTransStmt: form" , trS_stmts = [], trS_bndrs = [] @@ -318,7 +310,7 @@ mkBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr placeHolder mkTcBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr unitTy -- don't use placeHolderTypeTc above, because that panics during zonking -emptyRecStmt' :: forall idL idR body. SourceTextX (GhcPass idR) => +emptyRecStmt' :: forall idL idR body. PostTc (GhcPass idR) Type -> StmtLR (GhcPass idL) (GhcPass idR) body emptyRecStmt' tyVal = RecStmt @@ -367,12 +359,12 @@ unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote")) -- A name (uniquified later) to -- identify the quasi-quote -mkHsString :: SourceTextX p => String -> HsLit p -mkHsString s = HsString noSourceText (mkFastString s) +mkHsString :: String -> HsLit (GhcPass p) +mkHsString s = HsString NoSourceText (mkFastString s) -mkHsStringPrimLit :: SourceTextX p => FastString -> HsLit p +mkHsStringPrimLit :: FastString -> HsLit (GhcPass p) mkHsStringPrimLit fs - = HsStringPrim noSourceText (fastStringToByteString fs) + = HsStringPrim NoSourceText (fastStringToByteString fs) ------------- userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))] @@ -660,8 +652,8 @@ typeToLHsType ty , hst_body = go tau }) go (TyVarTy tv) = nlHsTyVar (getRdrName tv) go (AppTy t1 t2) = nlHsAppTy (go t1) (go t2) - go (LitTy (NumTyLit n)) = noLoc $ HsTyLit noExt (HsNumTy noSourceText n) - go (LitTy (StrTyLit s)) = noLoc $ HsTyLit noExt (HsStrTy noSourceText s) + go (LitTy (NumTyLit n)) = noLoc $ HsTyLit noExt (HsNumTy NoSourceText n) + go (LitTy (StrTyLit s)) = noLoc $ HsTyLit noExt (HsStrTy NoSourceText s) go (TyConApp tc args) = nlHsTyConApp (getRdrName tc) (map go args') where args' = filterOutInvisibleTypes tc args diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 51ce8637a4..b1e596e4f3 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -3323,17 +3323,17 @@ consym :: { Located RdrName } -- Literals literal :: { Located (HsLit GhcPs) } - : CHAR { sL1 $1 $ HsChar (sst $ getCHARs $1) $ getCHAR $1 } - | STRING { sL1 $1 $ HsString (sst $ getSTRINGs $1) - $ getSTRING $1 } - | PRIMINTEGER { sL1 $1 $ HsIntPrim (sst $ getPRIMINTEGERs $1) - $ getPRIMINTEGER $1 } - | PRIMWORD { sL1 $1 $ HsWordPrim (sst $ getPRIMWORDs $1) - $ getPRIMWORD $1 } - | PRIMCHAR { sL1 $1 $ HsCharPrim (sst $ getPRIMCHARs $1) - $ getPRIMCHAR $1 } - | PRIMSTRING { sL1 $1 $ HsStringPrim (sst $ getPRIMSTRINGs $1) - $ getPRIMSTRING $1 } + : CHAR { sL1 $1 $ HsChar (getCHARs $1) $ getCHAR $1 } + | STRING { sL1 $1 $ HsString (getSTRINGs $1) + $ getSTRING $1 } + | PRIMINTEGER { sL1 $1 $ HsIntPrim (getPRIMINTEGERs $1) + $ getPRIMINTEGER $1 } + | PRIMWORD { sL1 $1 $ HsWordPrim (getPRIMWORDs $1) + $ getPRIMWORD $1 } + | PRIMCHAR { sL1 $1 $ HsCharPrim (getPRIMCHARs $1) + $ getPRIMCHAR $1 } + | PRIMSTRING { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1) + $ getPRIMSTRING $1 } | PRIMFLOAT { sL1 $1 $ HsFloatPrim noExt $ getPRIMFLOAT $1 } | PRIMDOUBLE { sL1 $1 $ HsDoublePrim noExt $ getPRIMDOUBLE $1 } @@ -3732,7 +3732,4 @@ oll l = asl :: [Located a] -> Located b -> Located a -> P() asl [] (L ls _) (L l _) = addAnnotation l AnnSemi ls asl (x:_xs) (L ls _) _x = addAnnotation (getLoc x) AnnSemi ls - -sst ::HasSourceText a => SourceText -> a -sst = setSourceText } diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 9675fdda22..4dc22efabe 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -577,14 +577,13 @@ newNonTrivialOverloadedLit _ lit _ mkOverLit ::OverLitVal -> TcM (HsLit GhcTc) mkOverLit (HsIntegral i) = do { integer_ty <- tcMetaTy integerTyConName - ; return (HsInteger (setSourceText $ il_text i) - (il_value i) integer_ty) } + ; return (HsInteger (il_text i) (il_value i) integer_ty) } mkOverLit (HsFractional r) = do { rat_ty <- tcMetaTy rationalTyConName ; return (HsRat noExt r rat_ty) } -mkOverLit (HsIsString src s) = return (HsString (setSourceText src) s) +mkOverLit (HsIsString src s) = return (HsString src s) {- ************************************************************************ diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs index 3463750d7e..07d72a105a 100644 --- a/compiler/typecheck/TcAnnotations.hs +++ b/compiler/typecheck/TcAnnotations.hs @@ -72,7 +72,6 @@ annProvenanceToTarget _ (ValueAnnProvenance (L _ name)) = NamedTarget name annProvenanceToTarget _ (TypeAnnProvenance (L _ name)) = NamedTarget name annProvenanceToTarget mod ModuleAnnProvenance = ModuleTarget mod -annCtxt :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => AnnDecl (GhcPass p) -> SDoc +annCtxt :: (OutputableBndrId (GhcPass p)) => AnnDecl (GhcPass p) -> SDoc annCtxt ann = hang (text "In the annotation:") 2 (ppr ann) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 515eb4df35..363e5635a1 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -1742,8 +1742,7 @@ isClosedBndrGroup type_env binds -- This one is called on LHS, when pat and grhss are both Name -- and on RHS, when pat is TcId and grhss is still Name -patMonoBindsCtxt :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p), - Outputable body) +patMonoBindsCtxt :: (OutputableBndrId (GhcPass p), Outputable body) => LPat (GhcPass p) -> GRHSs GhcRn body -> SDoc patMonoBindsCtxt pat grhss = hang (text "In a pattern binding:") 2 (pprPatBind pat grhss) diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 8d11fed65c..c65daf7f10 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -884,11 +884,11 @@ data InstBindings a -- Used only to improve error messages } -instance (SourceTextX (GhcPass a), OutputableBndrId (GhcPass a)) +instance (OutputableBndrId (GhcPass a)) => Outputable (InstInfo (GhcPass a)) where ppr = pprInstInfoDetails -pprInstInfoDetails :: (SourceTextX (GhcPass a), OutputableBndrId (GhcPass a)) +pprInstInfoDetails :: (OutputableBndrId (GhcPass a)) => InstInfo (GhcPass a) -> SDoc pprInstInfoDetails info = hang (pprInstanceHdr (iSpec info) <+> text "where") diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index f88a11619a..1f9e6c8ac6 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -1340,7 +1340,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys wrapId (mkWpTyApps [ getRuntimeRep meth_tau, meth_tau]) nO_METHOD_BINDING_ERROR_ID - error_msg dflags = L inst_loc (HsLit noExt (HsStringPrim noSourceText + error_msg dflags = L inst_loc (HsLit noExt (HsStringPrim NoSourceText (unsafeMkByteString (error_string dflags)))) meth_tau = funResultTy (piResultTys (idType sel_id) inst_tys) error_string dflags = showSDoc dflags diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 2035abc1ba..c5d38d28b7 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -871,14 +871,13 @@ tcCheckPatSynPat = go go1 CoPat{} = panic "CoPat in output of renamer" go1 XPat{} = panic "XPat in output of renamer" -asPatInPatSynErr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Pat (GhcPass p) -> TcM a +asPatInPatSynErr :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> TcM a asPatInPatSynErr pat = failWithTc $ hang (text "Pattern synonym definition cannot contain as-patterns (@):") 2 (ppr pat) -nPlusKPatInPatSynErr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) +nPlusKPatInPatSynErr :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> TcM a nPlusKPatInPatSynErr pat = failWithTc $ diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index ed4b5483ef..2defdc3066 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -12,7 +12,7 @@ module TcTypeable(mkTypeableBinds) where import GhcPrelude -import BasicTypes ( Boxity(..), neverInlinePragma ) +import BasicTypes ( Boxity(..), neverInlinePragma, SourceText(..) ) import TcBinds( addTypecheckedBinds ) import IfaceEnv( newGlobalBinder ) import TyCoRep( Type(..), TyLit(..) ) @@ -632,12 +632,12 @@ mkTyConRepTyConRHS (Stuff {..}) todo tycon kind_rep ] int :: Int -> HsLit GhcTc - int n = HsIntPrim (sourceText $ show n) (toInteger n) + int n = HsIntPrim (SourceText $ show n) (toInteger n) word64 :: DynFlags -> Word64 -> HsLit GhcTc word64 dflags n - | wORD_SIZE dflags == 4 = HsWord64Prim noSourceText (toInteger n) - | otherwise = HsWordPrim noSourceText (toInteger n) + | wORD_SIZE dflags == 4 = HsWord64Prim NoSourceText (toInteger n) + | otherwise = HsWordPrim NoSourceText (toInteger n) {- Note [Representing TyCon kinds: KindRep] diff --git a/utils/haddock b/utils/haddock -Subproject e31b568bbdef28838cbaedf22143b45221303d6 +Subproject 23b459d564044b9c8db76ac74bbe1580cb45c63 |