X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprCore.lhs;h=9d6f0bdfa454f0a29cb134ffa8aee9f7f0b160fa;hb=9cb332c05f2f85432d2d235907af2c4e83fdff27;hp=ab3257e80a9f0eb09f183cce2eaa2560447d320b;hpb=5d53543308da8a9b2c81c1dacf41a76f31a55dcd;p=ghc-hetmet.git diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index ab3257e..9d6f0bd 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -6,6 +6,13 @@ Printing of Core syntax \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module PprCore ( pprCoreExpr, pprParendExpr, pprCoreBinding, pprCoreBindings, pprCoreAlt, @@ -33,7 +40,6 @@ import BasicTypes import Util import Outputable import FastString -import Module \end{code} %************************************************************************ @@ -187,7 +193,6 @@ ppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body) nest 2 (pprCoreExpr rhs), ptext SLIT("} in"), pprCoreExpr body ] --} ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _)) = add_par @@ -196,15 +201,16 @@ ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _)) ptext SLIT("} in")]) $$ pprCoreExpr expr) +-} --- general case (recursive case, too) +-- General case (recursive case, too) ppr_expr add_par (Let bind expr) = add_par $ - sep [hang (ptext keyword) 2 (ppr_bind bind), - hang (ptext SLIT("} in ")) 2 (pprCoreExpr expr)] + sep [hang (ptext keyword) 2 (ppr_bind bind <+> ptext SLIT("} in")), + pprCoreExpr expr] where keyword = case bind of - Rec _ -> SLIT("__letrec {") + Rec _ -> SLIT("letrec {") NonRec _ _ -> SLIT("let {") ppr_expr add_par (Note (SCC cc) expr) @@ -213,21 +219,6 @@ ppr_expr add_par (Note (SCC cc) expr) ppr_expr add_par (Note InlineMe expr) = add_par $ ptext SLIT("__inline_me") <+> pprParendExpr expr -ppr_expr add_par (Note (TickBox mod n) expr) - = add_par $ - sep [sep [ptext SLIT("__tick_box"), - pprModule mod, - text (show n)], - pprParendExpr expr] - -ppr_expr add_par (Note (BinaryTickBox mod t e) expr) - = add_par $ - sep [sep [ptext SLIT("__binary_tick_box"), - pprModule mod, - text (show t), - text (show e)], - pprParendExpr expr] - ppr_expr add_par (Note (CoreNote s) expr) = add_par $ sep [sep [ptext SLIT("__core_note"), pprHsString (mkFastString s)], @@ -301,7 +292,7 @@ pprTyVarBndr tyvar pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id) pprIdBndrInfo info - = megaSeqIdInfo `seq` doc -- The seq is useful for poking on black holes + = megaSeqIdInfo info `seq` doc -- The seq is useful for poking on black holes where prag_info = inlinePragInfo info occ_info = occInfo info @@ -371,7 +362,7 @@ pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn, ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs }) = hang (doubleQuotes (ftext name) <+> ppr act) - 4 (sep [ptext SLIT("__forall") <+> braces (sep (map pprTypedBinder tpl_vars)), + 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) ])