X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprCore.lhs;h=c78516a1f7c7910245ec13ffa56fafca2f55c40e;hb=1e4f900ade324e2db2f886a11d7cb571ad5f180c;hp=cc3883767f686ec031f410dd8222c471dc81a6f4;hpb=69a804e3ff13197cd2962bea96a69bb81eb6bcf0;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index cc38837..c78516a 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -152,11 +152,27 @@ ppr_expr add_par expr@(App {})
     }
 
 ppr_expr add_par (Case expr var ty [(con,args,rhs)])
+  | opt_PprCaseAsLet
+  = add_par $
+    sep [sep 	[ ptext (sLit "let")
+			<+> char '{'
+			<+> ppr_case_pat con args 
+			<+> ptext (sLit "~")
+			<+> ppr_bndr var
+		, ptext (sLit "<-") 
+		  	<+> ppr_expr id expr
+		, char '}' 
+			<+> ptext (sLit "in")
+	  	]
+	, pprCoreExpr rhs
+    	]
+
+  | otherwise
   = add_par $
     sep [sep [ptext (sLit "case") <+> pprCoreExpr expr,
 	      ifPprDebug (braces (ppr ty)),
 	      sep [ptext (sLit "of") <+> ppr_bndr var, 
-		   char '{' <+> ppr_case_pat con args]
+		   char '{' <+> ppr_case_pat con args <+> arrow]
 	  ],
 	 pprCoreExpr rhs,
 	 char '}'
@@ -218,18 +234,18 @@ ppr_expr add_par (Note (CoreNote s) expr)
 
 pprCoreAlt :: OutputableBndr a => (AltCon, [a] , Expr a) -> SDoc
 pprCoreAlt (con, args, rhs) 
-  = hang (ppr_case_pat con args) 2 (pprCoreExpr rhs)
+  = hang (ppr_case_pat con args <+> arrow) 2 (pprCoreExpr rhs)
 
 ppr_case_pat :: OutputableBndr a => AltCon -> [a] -> SDoc
 ppr_case_pat (DataAlt dc) args
   | isTupleTyCon tc
-  = tupleParens (tupleTyConBoxity tc) (hsep (punctuate comma (map ppr_bndr args))) <+> arrow
+  = tupleParens (tupleTyConBoxity tc) (hsep (punctuate comma (map ppr_bndr args)))
   where
     ppr_bndr = pprBndr CaseBind
     tc = dataConTyCon dc
 
 ppr_case_pat con args
-  = ppr con <+> sep (map ppr_bndr args) <+> arrow
+  = ppr con <+> sep (map ppr_bndr args)
   where
     ppr_bndr = pprBndr CaseBind
 
@@ -282,8 +298,9 @@ pprTypedLCBinder bind_site debug_on var
 pprTypedBinder :: Var -> SDoc
 -- Print binder with a type or kind signature (not paren'd)
 pprTypedBinder binder
-  | isTyCoVar binder  = pprKindedTyVarBndr binder
-  | otherwise	    = hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder))
+  | isTyCoVar binder		= pprKindedTyVarBndr binder
+  | opt_SuppressTypeSignatures	= empty
+  | otherwise			= hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder))
 
 pprKindedTyVarBndr :: TyVar -> SDoc
 -- Print a type variable binder with its kind (but not if *)
@@ -302,6 +319,8 @@ pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)
 
 pprIdBndrInfo :: IdInfo -> SDoc
 pprIdBndrInfo info 
+  | opt_SuppressIdInfo = empty
+  | otherwise
   = megaSeqIdInfo info `seq` doc -- The seq is useful for poking on black holes
   where
     prag_info = inlinePragInfo info