[project @ 1997-11-05 16:09:11 by simonm]

[ghc-hetmet.git] / ghc / compiler / coreSyn / PprCore.lhs

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index e0dcb03..3c4a7ba 100644 (file)
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -12,7 +12,7 @@
 
 module PprCore (
        pprCoreExpr, pprIfaceUnfolding, 
-       pprCoreBinding,
+       pprCoreBinding, pprCoreBindings,
        pprBigCoreBinder,
        pprTypedCoreBinder
        
@@ -31,13 +31,12 @@ import Id           ( idType, getIdInfo, getIdStrictness, isTupleCon,
                          nullIdEnv, SYN_IE(DataCon), GenId{-instances-},
                          SYN_IE(Id)
                        ) 
-import IdInfo          ( ppIdInfo, StrictnessInfo(..) )
+import IdInfo          ( ppIdInfo, ppStrictnessInfo )
 import Literal         ( Literal{-instances-} )
-import Name            ( OccName, parenInCode )
+import Name            ( OccName )
 import Outputable      -- quite a few things
 import PprEnv
 import PprType         ( pprParendGenType, pprTyVarBndr, GenType{-instances-}, GenTyVar{-instance-} )
-import PprStyle                ( PprStyle(..), ifaceStyle )
 import Pretty
 import PrimOp          ( PrimOp{-instances-} )
 import TyVar           ( GenTyVar{-instances-} )
@@ -66,7 +65,8 @@ print something.
 @pprParendCoreExpr@ puts parens around non-atomic Core expressions.
 
 \begin{code}
-pprCoreBinding :: PprStyle -> CoreBinding -> Doc
+pprCoreBinding  :: PprStyle -> CoreBinding   -> Doc
+pprCoreBindings :: PprStyle -> [CoreBinding] -> Doc
 
 pprGenCoreBinding
        :: (Eq tyvar,  Outputable tyvar,
@@ -118,6 +118,8 @@ init_ppr_env sty tvbndr pbdr1 pbdr2 pocc
                  | otherwise      = ppr sty prim <> char '!'
 
 --------------
+pprCoreBindings sty binds = vcat (map (pprCoreBinding sty) binds)
+
 pprCoreBinding sty (NonRec binder expr)
   = hang (hsep [pprBigCoreBinder sty binder, equals])
         4 (pprCoreExpr sty (pprBigCoreBinder sty) (pprBabyCoreBinder sty) (ppr sty) expr)
@@ -281,8 +283,8 @@ ppr_expr pe expr@(Lam _ _)
        (uvars, tyvars, vars, body) = collectBinders expr
     in
     hang (hsep [pp_vars SLIT("/u\\") (pUVar    pe) uvars,
-                  pp_vars SLIT("_/\\_")  (pTyVarB  pe) tyvars,
-                  pp_vars SLIT("\\")   (pMajBndr pe) vars])
+               pp_vars SLIT("_/\\_")  (pTyVarB  pe) tyvars,
+               pp_vars SLIT("\\")   (pMajndr pe) vars])
         4 (ppr_expr pe body)
   where
     pp_vars lam pp [] = empty
@@ -421,31 +423,15 @@ Other printing bits-and-bobs used with the general @pprCoreBinding@
 and @pprCoreExpr@ functions.
 
 \begin{code}
-pprBigCoreBinder sty binder
-  = vcat [sig, pragmas, ppr sty binder]
-  where
-    sig = ifnotPprShowAll sty (
-           hang (hsep [ppr sty binder, ppDcolon])
-                4 (ppr sty (idType binder)))
-    pragmas =
-       ifnotPprForUser sty
-        (ppIdInfo sty False{-no specs, thanks-} (getIdInfo binder))
+pprBigCoreBinder sty binder = pprTypedCoreBinder sty binder
 
 pprBabyCoreBinder sty binder
   = hsep [ppr sty binder, pp_strictness]
   where
-    pp_strictness
-      = case (getIdStrictness binder) of
-         NoStrictnessInfo    -> empty
-         BottomGuaranteed    -> ptext SLIT("{- _!_ -}")
-         StrictnessInfo xx _ ->
-               panic "PprCore:pp_strictness:StrictnessInfo:ToDo"
-               -- text ("{- " ++ (showList xx "") ++ " -}")
+    pp_strictness = ppStrictnessInfo sty (getIdStrictness binder)
 
 pprTypedCoreBinder sty binder
-  = hcat [ppr sty binder, ppDcolon, pprParendGenType sty (idType binder)]
-
-ppDcolon = ptext SLIT(" :: ")
+  = hsep [ppr sty binder, ptext SLIT("::"), pprParendGenType sty (idType binder)]
                -- The space before the :: is important; it helps the lexer
                -- when reading inferfaces.  Otherwise it would lex "a::b" as one thing.
 \end{code}