X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprCore.lhs;h=a3c1f6f4235e67ccd9d475cf05356abdd34758be;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hp=8713e74411363f7942c45e1ec5cce568c4afd657;hpb=f80b81f8b56ebd0fa0f7f82494a5090e9ab64256;p=ghc-hetmet.git diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index 8713e74..a3c1f6f 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -1,11 +1,9 @@ % +% (c) The University of Glasgow 2006 % (c) The AQUA Project, Glasgow University, 1996-1998 % -%************************************************************************ -%* * -\section[PprCore]{Printing of Core syntax, including for interfaces} -%* * -%************************************************************************ + +Printing of Core syntax \begin{code} module PprCore ( @@ -17,34 +15,24 @@ module PprCore ( #include "HsVersions.h" import CoreSyn -import CostCentre ( pprCostCentreCore ) -import Var ( Var ) -import Id ( Id, idType, isDataConWorkId_maybe, idArity, - idInfo, globalIdDetails, isGlobalId, isExportedId - ) -import Var ( TyVar, isTyVar, tyVarKind ) -import IdInfo ( IdInfo, megaSeqIdInfo, - inlinePragInfo, occInfo, newDemandInfo, - lbvarInfo, hasNoLBVarInfo, - arityInfo, ppArityInfo, - specInfo, pprNewStrictness, - workerInfo, ppWorkerInfo, - newStrictnessInfo, cafInfo, ppCafInfo, specInfoRules - ) -import NewDemand ( isTop ) +import CostCentre +import Var +import Id +import IdInfo +import NewDemand #ifdef OLD_STRICTNESS -import Id ( idDemandInfo ) -import IdInfo ( cprInfo, ppCprInfo, strictnessInfo, ppStrictnessInfo ) +import Id +import IdInfo #endif -import DataCon ( dataConTyCon ) -import TyCon ( tupleTyConBoxity, isTupleTyCon ) -import Type ( pprParendType, pprType, pprParendKind ) -import Coercion ( coercionKindPredTy ) -import BasicTypes ( tupleParens, isNoOcc, isAlwaysActive ) -import Util ( lengthIs ) +import DataCon +import TyCon +import Type +import Coercion +import BasicTypes +import Util import Outputable -import FastString ( mkFastString ) +import FastString \end{code} %************************************************************************ @@ -144,7 +132,7 @@ ppr_expr add_par expr@(App fun arg) let pp_args = sep (map pprArg args) val_args = dropWhile isTypeArg args -- Drop the type arguments for tuples - pp_tup_args = sep (punctuate comma (map pprArg val_args)) + pp_tup_args = sep (punctuate comma (map pprCoreExpr val_args)) in case fun of Var f -> case isDataConWorkId_maybe f of @@ -366,10 +354,9 @@ pprRule (BuiltinRule { ru_fn = fn, ru_name = name}) pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn, ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs }) - = doubleQuotes (ftext name) <+> ppr act <+> - sep [ - ptext SLIT("__forall") <+> braces (sep (map pprTypedBinder tpl_vars)), - nest 2 (ppr fn <+> sep (map pprArg tpl_args)), - nest 2 (ptext SLIT("=") <+> pprCoreExpr rhs) - ] <+> semi + = hang (doubleQuotes (ftext name) <+> ppr act) + 4 (sep [ptext SLIT("forall") <+> braces (sep (map pprTypedBinder tpl_vars)), + nest 2 (ppr fn <+> sep (map pprArg tpl_args)), + nest 2 (ptext SLIT("=") <+> pprCoreExpr rhs) + ]) \end{code}