[project @ 1997-05-19 00:12:10 by sof]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsCore.lhs

diff --git a/ghc/compiler/hsSyn/HsCore.lhs b/ghc/compiler/hsSyn/HsCore.lhs
index 8e60262..6a37f2d 100644 (file)
--- a/ghc/compiler/hsSyn/HsCore.lhs
+++ b/ghc/compiler/hsSyn/HsCore.lhs
@@ -32,6 +32,9 @@ import Literal                ( Literal )
 import Outputable      ( Outputable(..) )
 import Pretty
 import Util            ( panic )
+#if __GLASGOW_HASKELL__ >= 202
+import CostCentre
+#endif
 \end{code}
 
 %************************************************************************
@@ -104,57 +107,57 @@ instance Outputable name => Outputable (UfExpr name) where
     ppr sty (UfLit l) = ppr sty l
 
     ppr sty (UfCon c as)
-      = ppCat [ppStr "UfCon", ppr sty c, ppr sty as, ppChar ')']
+      = hsep [text "UfCon", ppr sty c, ppr sty as, char ')']
     ppr sty (UfPrim o as)
-      = ppCat [ppStr "UfPrim", ppr sty o, ppr sty as, ppChar ')']
+      = hsep [text "UfPrim", ppr sty o, ppr sty as, char ')']
 
     ppr sty (UfLam b body)
-      = ppCat [ppChar '\\', ppr sty b, ppPStr SLIT("->"), ppr sty body]
+      = hsep [char '\\', ppr sty b, ptext SLIT("->"), ppr sty body]
 
     ppr sty (UfApp fun (UfTyArg ty))
-      = ppCat [ppr sty fun, ppChar '@', pprParendHsType sty ty]
+      = hsep [ppr sty fun, char '@', pprParendHsType sty ty]
 
     ppr sty (UfApp fun (UfLitArg lit))
-      = ppCat [ppr sty fun, ppr sty lit]
+      = hsep [ppr sty fun, ppr sty lit]
 
     ppr sty (UfApp fun (UfVarArg var))
-      = ppCat [ppr sty fun, ppr sty var]
+      = hsep [ppr sty fun, ppr sty var]
 
     ppr sty (UfCase scrut alts)
-      = ppCat [ppPStr SLIT("case"), ppr sty scrut, ppPStr SLIT("of {"), pp_alts alts, ppChar '}']
+      = hsep [ptext SLIT("case"), ppr sty scrut, ptext SLIT("of {"), pp_alts alts, char '}']
       where
        pp_alts (UfAlgAlts alts deflt)
-         = ppCat [ppInterleave ppSemi (map pp_alt alts), pp_deflt deflt]
+         = hsep [hsep (punctuate semi (map pp_alt alts)), pp_deflt deflt]
          where
-          pp_alt (c,bs,rhs) = ppCat [ppr sty c, ppr sty bs, ppr_arrow, ppr sty rhs]
+          pp_alt (c,bs,rhs) = hsep [ppr sty c, ppr sty bs, ppr_arrow, ppr sty rhs]
        pp_alts (UfPrimAlts alts deflt)
-         = ppCat [ppInterleave ppSemi (map pp_alt alts), pp_deflt deflt]
+         = hsep [hsep (punctuate semi (map pp_alt alts)), pp_deflt deflt]
          where
-          pp_alt (l,rhs) = ppCat [ppr sty l, ppr_arrow, ppr sty rhs]
+          pp_alt (l,rhs) = hsep [ppr sty l, ppr_arrow, ppr sty rhs]
 
-       pp_deflt UfNoDefault = ppNil
-       pp_deflt (UfBindDefault b rhs) = ppCat [ppr sty b, ppr_arrow, ppr sty rhs]
+       pp_deflt UfNoDefault = empty
+       pp_deflt (UfBindDefault b rhs) = hsep [ppr sty b, ppr_arrow, ppr sty rhs]
 
-        ppr_arrow = ppPStr SLIT("->")
+        ppr_arrow = ptext SLIT("->")
 
     ppr sty (UfLet (UfNonRec b rhs) body)
-      = ppCat [ppPStr SLIT("let"), ppr sty b, ppEquals, ppr sty rhs, ppPStr SLIT("in"), ppr sty body]
+      = hsep [ptext SLIT("let"), ppr sty b, equals, ppr sty rhs, ptext SLIT("in"), ppr sty body]
     ppr sty (UfLet (UfRec pairs) body)
-      = ppCat [ppPStr SLIT("letrec {"), ppInterleave ppSemi (map pp_pair pairs), ppPStr SLIT("} in"), ppr sty body]
+      = hsep [ptext SLIT("letrec"), braces (hsep (punctuate semi (map pp_pair pairs))), ptext SLIT("in"), ppr sty body]
       where
-       pp_pair (b,rhs) = ppCat [ppr sty b, ppEquals, ppr sty rhs]
+       pp_pair (b,rhs) = hsep [ppr sty b, equals, ppr sty rhs]
 
     ppr sty (UfSCC uf_cc body)
-      = ppCat [ppPStr SLIT("_scc_ <cost-centre[ToDo]>"), ppr sty body]
+      = hsep [ptext SLIT("_scc_ <cost-centre[ToDo]>"), ppr sty body]
 
 instance Outputable name => Outputable (UfPrimOp name) where
     ppr sty (UfCCallOp str is_casm can_gc arg_tys result_ty)
       = let
-           before = ppPStr (if is_casm then SLIT("_casm_ ``") else SLIT("_ccall_ "))
-           after  = if is_casm then ppStr "'' " else ppSP
+           before = ptext (if is_casm then SLIT("_casm_ ``") else SLIT("_ccall_ "))
+           after  = if is_casm then text "'' " else space
        in
-       ppBesides [before, ppPStr str, after,
-                  ppLbrack, ppr sty arg_tys, ppRbrack, ppSP, ppr sty result_ty]
+       hcat [before, ptext str, after,
+                  brackets (ppr sty arg_tys), space, ppr sty result_ty]
 
     ppr sty (UfOtherOp op)
       = ppr sty op
@@ -166,8 +169,8 @@ instance Outputable name => Outputable (UfArg name) where
     ppr sty (UfUsageArg name)  = ppr sty name
 
 instance Outputable name => Outputable (UfBinder name) where
-    ppr sty (UfValBinder name ty)  = ppCat [ppr sty name, ppPStr SLIT("::"), ppr sty ty]
-    ppr sty (UfTyBinder name kind) = ppCat [ppr sty name, ppPStr SLIT("::"), ppr sty kind]
+    ppr sty (UfValBinder name ty)  = hsep [ppr sty name, ptext SLIT("::"), ppr sty ty]
+    ppr sty (UfTyBinder name kind) = hsep [ppr sty name, ptext SLIT("::"), ppr sty kind]
     ppr sty (UfUsageBinder name)   = ppr sty name
 \end{code}