[project @ 1998-08-14 13:05:45 by sof]

[ghc-hetmet.git] / ghc / compiler / absCSyn / HeapOffs.lhs

diff --git a/ghc/compiler/absCSyn/HeapOffs.lhs b/ghc/compiler/absCSyn/HeapOffs.lhs
index 0ce2a41..cc96031 100644 (file)
--- a/ghc/compiler/absCSyn/HeapOffs.lhs
+++ b/ghc/compiler/absCSyn/HeapOffs.lhs
@@ -9,8 +9,6 @@ symbolic}---are sufficiently turgid that they get their own module.
 INTERNAL MODULE: should be accessed via @AbsCSyn.hi@.
 
 \begin{code}
-#include "HsVersions.h"
-
 module HeapOffs (
        HeapOffset,
 
@@ -26,20 +24,22 @@ module HeapOffs (
        hpRelToInt,
 #endif
 
-       VirtualHeapOffset(..), HpRelOffset(..),
-       VirtualSpAOffset(..), VirtualSpBOffset(..),
-       SpARelOffset(..), SpBRelOffset(..)
+       VirtualHeapOffset, HpRelOffset,
+       VirtualSpAOffset, VirtualSpBOffset,
+       SpARelOffset, SpBRelOffset
     ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
+
 #if ! OMIT_NATIVE_CODEGEN
-IMPORT_DELOOPER(AbsCLoop)              ( fixedHdrSizeInWords, varHdrSizeInWords )
+import {-# SOURCE #-} MachMisc
 #endif
 
 import Maybes          ( catMaybes )
 import SMRep
-import Unpretty                -- ********** NOTE **********
 import Util            ( panic )
+import Outputable
+import GlaExts         ( Int(..), Int#, (+#), negateInt#, (<=#), (>=#), (==#) )
 \end{code}
 
 %************************************************************************
@@ -264,69 +264,68 @@ print either a single value, or a parenthesised value.  No need for
 the caller to parenthesise.
 
 \begin{code}
-pprHeapOffset :: PprStyle -> HeapOffset -> Unpretty
+pprHeapOffset :: HeapOffset -> SDoc
 
-pprHeapOffset sty ZeroHeapOffset = uppChar '0'
+pprHeapOffset ZeroHeapOffset = char '0'
 
-pprHeapOffset sty (MaxHeapOffset off1 off2)
-  = uppBeside (uppPStr SLIT("STG_MAX"))
-      (uppParens (uppBesides [pprHeapOffset sty off1, uppComma, pprHeapOffset sty off2]))
+pprHeapOffset (MaxHeapOffset off1 off2)
+  = (<>) (ptext SLIT("STG_MAX"))
+      (parens (hcat [pprHeapOffset off1, comma, pprHeapOffset off2]))
 
-pprHeapOffset sty (AddHeapOffset off1 off2)
-  = uppParens (uppBesides [pprHeapOffset sty off1, uppChar '+',
-                       pprHeapOffset sty off2])
-pprHeapOffset sty (SubHeapOffset off1 off2)
-  = uppParens (uppBesides [pprHeapOffset sty off1, uppChar '-',
-                       pprHeapOffset sty off2])
+pprHeapOffset (AddHeapOffset off1 off2)
+  = parens (hcat [pprHeapOffset off1, char '+',
+                       pprHeapOffset off2])
+pprHeapOffset (SubHeapOffset off1 off2)
+  = parens (hcat [pprHeapOffset off1, char '-',
+                       pprHeapOffset off2])
 
-pprHeapOffset sty (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
-  = pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
+pprHeapOffset (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
+  = pprHeapOffsetPieces int_offs fxdhdr_offs varhdr_offs tothdr_offs
 \end{code}
 
 \begin{code}
-pprHeapOffsetPieces :: PprStyle
-                   -> FAST_INT         -- Words
+pprHeapOffsetPieces :: FAST_INT                -- Words
                    -> FAST_INT         -- Fixed hdrs
                    -> [SMRep__Int]     -- Var hdrs
                    -> [SMRep__Int]     -- Tot hdrs
-                   -> Unpretty
+                   -> SDoc
 
-pprHeapOffsetPieces sty n ILIT(0) [] [] = uppInt IBOX(n) -- Deals with zero case too
+pprHeapOffsetPieces n ILIT(0) [] [] = int IBOX(n) -- Deals with zero case too
 
-pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
+pprHeapOffsetPieces int_offs fxdhdr_offs varhdr_offs tothdr_offs
   = let pp_int_offs =
            if int_offs _EQ_ ILIT(0)
            then Nothing
-           else Just (uppInt IBOX(int_offs))
+           else Just (int IBOX(int_offs))
 
        pp_fxdhdr_offs =
            if fxdhdr_offs _EQ_ ILIT(0) then
                Nothing
            else if fxdhdr_offs _EQ_ ILIT(1) then
-               Just (uppPStr SLIT("_FHS"))
+               Just (ptext SLIT("_FHS"))
            else
-               Just (uppBesides [uppStr "(_FHS*", uppInt IBOX(fxdhdr_offs), uppChar ')'])
+               Just (hcat [text "(", ptext SLIT("_FHS*"), int IBOX(fxdhdr_offs), text ")"])
 
-       pp_varhdr_offs = pp_hdrs (uppPStr SLIT("_VHS")) varhdr_offs
+       pp_varhdr_offs = pp_hdrs (ptext SLIT("_VHS")) varhdr_offs
 
-       pp_tothdr_offs = pp_hdrs (uppPStr SLIT("_HS")) tothdr_offs
+       pp_tothdr_offs = pp_hdrs (ptext SLIT("_HS")) tothdr_offs
     in
     case (catMaybes [pp_tothdr_offs, pp_varhdr_offs, pp_fxdhdr_offs, pp_int_offs]) of
-       []   -> uppChar '0'
+       []   -> char '0'
        [pp] -> pp      -- Each blob is parenthesised if necessary
-       pps  -> uppParens (uppIntersperse (uppChar '+') pps)
+       pps  -> text "(" <> (hcat (punctuate (char '+') pps)) <> text ")"
   where
     pp_hdrs hdr_pp [] = Nothing
-    pp_hdrs hdr_pp [SMRI(rep, n)] | n _EQ_ ILIT(1) = Just (uppBeside (uppStr (show rep)) hdr_pp)
-    pp_hdrs hdr_pp hdrs = Just (uppParens (uppInterleave (uppChar '+')
-                                               (map (pp_hdr hdr_pp) hdrs)))
+    pp_hdrs hdr_pp [SMRI(rep, n)] | n _EQ_ ILIT(1) = Just ((<>) (text (show rep)) hdr_pp)
+    pp_hdrs hdr_pp hdrs = Just (parens (hsep (punctuate (char '+')
+                                               (map (pp_hdr hdr_pp) hdrs))))
 
-    pp_hdr :: Unpretty -> SMRep__Int -> Unpretty
+    pp_hdr :: SDoc -> SMRep__Int -> SDoc
     pp_hdr pp_str (SMRI(rep, n))
       = if n _EQ_ ILIT(1) then
-         uppBeside (uppStr (show rep)) pp_str
+         (<>) (text (show rep)) pp_str
        else
-         uppBesides [uppInt IBOX(n), uppChar '*', uppStr (show rep), pp_str]
+         hcat [int IBOX(n), char '*', text (show rep), pp_str]
 \end{code}
 
 %************************************************************************