X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsExpr.lhs;h=40866f44d701e3da2aba2038ebcd8f78d801609e;hp=f7d7bda8137f3aa59bb885a673de0d4822f02971;hb=e6d057711f4d6d6ff6342c39fa2b9e44d25447f1;hpb=edbfd324eec5773496119e12ef25e1ce3da1796d diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index f7d7bda..40866f4 100644 --- a/compiler/hsSyn/HsExpr.lhs +++ b/compiler/hsSyn/HsExpr.lhs @@ -14,7 +14,8 @@ import HsPat ( LPat ) import HsLit ( HsLit(..), HsOverLit ) import HsTypes ( LHsType, PostTcType ) import HsImpExp ( isOperator, pprHsVar ) -import HsBinds ( HsLocalBinds, DictBinds, ExprCoFn, isEmptyLocalBinds ) +import HsBinds ( HsLocalBinds, DictBinds, isEmptyLocalBinds, + HsWrapper, pprHsWrapper ) -- others: import Type ( Type, pprParendType ) @@ -239,22 +240,7 @@ The renamer translates them into the Right Thing. Everything from here on appears only in typechecker output. \begin{code} - | TyLam -- TRANSLATION - [TyVar] - (LHsExpr id) - | TyApp -- TRANSLATION - (LHsExpr id) -- generated by Spec - [Type] - - -- DictLam and DictApp are "inverses" - | DictLam - [id] - (LHsExpr id) - | DictApp - (LHsExpr id) - [id] - - | HsCoerce ExprCoFn -- TRANSLATION + | HsWrap HsWrapper -- TRANSLATION (HsExpr id) type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be @@ -394,35 +380,8 @@ ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e ppr_expr (HsSCC lbl expr) = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ] -ppr_expr (TyLam tyvars expr) - = hang (hsep [ptext SLIT("/\\"), - hsep (map (pprBndr LambdaBind) tyvars), - ptext SLIT("->")]) - 4 (ppr_lexpr expr) - -ppr_expr (TyApp expr [ty]) - = hang (ppr_lexpr expr) 4 (pprParendType ty) - -ppr_expr (TyApp expr tys) - = hang (ppr_lexpr expr) - 4 (brackets (interpp'SP tys)) - -ppr_expr (DictLam dictvars expr) - = hang (hsep [ptext SLIT("\\{-dict-}"), - hsep (map (pprBndr LambdaBind) dictvars), - ptext SLIT("->")]) - 4 (ppr_lexpr expr) - -ppr_expr (DictApp expr [dname]) - = hang (ppr_lexpr expr) 4 (ppr dname) - -ppr_expr (DictApp expr dnames) - = hang (ppr_lexpr expr) - 4 (brackets (interpp'SP dnames)) - -ppr_expr (HsCoerce co_fn e) = ppr_expr e - -ppr_expr (HsType id) = ppr id +ppr_expr (HsWrap co_fn e) = pprHsWrapper (ppr_expr e) co_fn +ppr_expr (HsType id) = ppr id ppr_expr (HsSpliceE s) = pprSplice s ppr_expr (HsBracket b) = pprHsBracket b @@ -648,7 +607,9 @@ We know the list must have at least one @Match@ in it. \begin{code} pprMatches :: (OutputableBndr id) => HsMatchContext id -> MatchGroup id -> SDoc -pprMatches ctxt (MatchGroup matches _) = vcat (map (pprMatch ctxt) (map unLoc matches)) +pprMatches ctxt (MatchGroup matches ty) = vcat (map (pprMatch ctxt) (map 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 :: (OutputableBndr id) => id -> MatchGroup id -> SDoc