[project @ 2001-02-28 00:01:01 by qrczak]

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

diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index d98048c..e022656 100644 (file)
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -38,16 +38,16 @@ import CmdLineOpts  ( opt_SccProfilingOn, opt_GranMacros )
 import CostCentre      ( pprCostCentreDecl, pprCostCentreStackDecl )
 
 import Costs           ( costs, addrModeCosts, CostRes(..), Side(..) )
-import CStrings                ( stringToC, pprCLabelString )
+import CStrings                ( pprStringInCStyle, pprCLabelString )
 import FiniteMap       ( addToFM, emptyFM, lookupFM, FiniteMap )
 import Literal         ( Literal(..) )
 import TyCon           ( tyConDataCons )
 import Name            ( NamedThing(..) )
-import DataCon         ( DataCon{-instance NamedThing-}, dataConWrapId )
+import DataCon         ( dataConWrapId )
 import Maybes          ( maybeToBool, catMaybes )
-import PrimOp          ( primOpNeedsWrapper, pprPrimOp, pprCCallOp, 
+import PrimOp          ( primOpNeedsWrapper, pprCCallOp, 
                          PrimOp(..), CCall(..), CCallTarget(..), isDynamicTarget )
-import PrimRep         ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep )
+import PrimRep         ( isFloatingRep, PrimRep(..), getPrimRepSize )
 import SMRep           ( pprSMRep )
 import Unique          ( pprUnique, Unique{-instance NamedThing-} )
 import UniqSet         ( emptyUniqSet, elementOfUniqSet,
@@ -56,10 +56,10 @@ import UniqSet              ( emptyUniqSet, elementOfUniqSet,
 import StgSyn          ( SRT(..) )
 import BitSet          ( intBS )
 import Outputable
+import GlaExts
 import Util            ( nOfThem )
 
 import ST
-import MutableArray
 
 infixr 9 `thenTE`
 \end{code}
@@ -239,7 +239,7 @@ pprAbsC stmt@(COpStmt results op args vol_regs) _
        the_op
   where
     ppr_op_call results args
-      = hcat [ pprPrimOp op, lparen,
+      = hcat [ ppr op, lparen,
        hcat (punctuate comma (map ppr_op_result results)),
        if null results || null args then empty else comma,
        hcat (punctuate comma (map pprAmode args)),
@@ -333,14 +333,14 @@ pprAbsC stmt@(CCallTypedef is_tdef (CCall op_str is_asm may_gc cconv) results ar
      ccall_res_ty = 
        case non_void_results of
           []       -> ptext SLIT("void")
-         [amode]  -> text (showPrimRep (getAmodeRep amode))
+         [amode]  -> ppr (getAmodeRep amode)
          _        -> panic "pprAbsC{CCallTypedef}: ccall_res_ty"
 
      ccall_decl_ty_args 
        | is_tdef   = tail ccall_arg_tys
        | otherwise = ccall_arg_tys
 
-     ccall_arg_tys      = map (text.showPrimRep.getAmodeRep) non_void_args
+     ccall_arg_tys      = map (ppr . getAmodeRep) non_void_args
 
       -- the first argument will be the "I/O world" token (a VoidRep)
       -- all others should be non-void
@@ -418,16 +418,18 @@ pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
       where 
        rep = getAmodeRep item
 
-    padding_wds =
-       if not (closureUpdReqd cl_info) then
-           []
-       else
-           case max 0 (mIN_UPD_SIZE - length amodes) of { still_needed ->
-           nOfThem still_needed (mkIntCLit 0) } -- a bunch of 0s
+    upd_reqd = closureUpdReqd cl_info
 
+    padding_wds
+       | not upd_reqd = []
+       | otherwise    = case max 0 (mIN_UPD_SIZE - length amodes) of { still_needed ->
+                        nOfThem still_needed (mkIntCLit 0) } -- a bunch of 0s
+
+       -- always have a static link field, it's used to save the closure's
+       -- info pointer when we're reverting CAFs (see comment in Storage.c)
     static_link_field
-       | staticClosureNeedsLink cl_info = [mkIntCLit 0]
-       | otherwise                      = []
+       | upd_reqd || staticClosureNeedsLink cl_info = [mkIntCLit 0]
+       | otherwise                                  = []
 
 pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _
   = vcat [
@@ -498,8 +500,8 @@ pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _
 
     type_str = pprSMRep (closureSMRep cl_info)
 
-    pp_descr = hcat [char '"', text (stringToC cl_descr), char '"']
-    pp_type  = hcat [char '"', text (stringToC (closureTypeDescr cl_info)), char '"']
+    pp_descr = pprStringInCStyle cl_descr
+    pp_type  = pprStringInCStyle (closureTypeDescr cl_info)
 
 pprAbsC stmt@(CClosureTbl tycon) _
   = vcat (
@@ -647,9 +649,6 @@ pp_basic_restores = ptext SLIT("CALLER_RESTORE_SYSTEM")
 \end{code}
 
 \begin{code}
-has_srt (_, NoSRT) = False
-has_srt _ = True
-
 pp_srt_info srt = 
     case srt of
        (lbl, NoSRT) -> 
@@ -1266,9 +1265,9 @@ pprMagicId BaseReg                    = ptext SLIT("BaseReg")
 pprMagicId (VanillaReg pk n)
                                    = hcat [ pprVanillaReg n, char '.',
                                                  pprUnionTag pk ]
-pprMagicId (FloatReg  n)            = (<>) (ptext SLIT("F")) (int IBOX(n))
-pprMagicId (DoubleReg n)           = (<>) (ptext SLIT("D")) (int IBOX(n))
-pprMagicId (LongReg _ n)           = (<>) (ptext SLIT("L")) (int IBOX(n))
+pprMagicId (FloatReg  n)            = ptext SLIT("F") <> int (I# n)
+pprMagicId (DoubleReg n)           = ptext SLIT("D") <> int (I# n)
+pprMagicId (LongReg _ n)           = ptext SLIT("L") <> int (I# n)
 pprMagicId Sp                      = ptext SLIT("Sp")
 pprMagicId Su                      = ptext SLIT("Su")
 pprMagicId SpLim                   = ptext SLIT("SpLim")
@@ -1277,8 +1276,8 @@ pprMagicId HpLim              = ptext SLIT("HpLim")
 pprMagicId CurCostCentre           = ptext SLIT("CCCS")
 pprMagicId VoidReg                 = panic "pprMagicId:VoidReg!"
 
-pprVanillaReg :: FAST_INT -> SDoc
-pprVanillaReg n = (<>) (char 'R') (int IBOX(n))
+pprVanillaReg :: Int# -> SDoc
+pprVanillaReg n = char 'R' <> int (I# n)
 
 pprUnionTag :: PrimRep -> SDoc
 
@@ -1289,6 +1288,7 @@ pprUnionTag RetRep                = char 'p'
 pprUnionTag CostCentreRep      = panic "pprUnionTag:CostCentre?"
 
 pprUnionTag CharRep            = char 'c'
+pprUnionTag Int8Rep            = ptext SLIT("i8")
 pprUnionTag IntRep             = char 'i'
 pprUnionTag WordRep            = char 'w'
 pprUnionTag AddrRep            = char 'a'
@@ -1299,11 +1299,13 @@ pprUnionTag StablePtrRep        = char 'p'
 pprUnionTag StableNameRep      = char 'p'
 pprUnionTag WeakPtrRep         = char 'p'
 pprUnionTag ForeignObjRep      = char 'p'
+pprUnionTag PrimPtrRep         = char 'p'
 
 pprUnionTag ThreadIdRep                = char 't'
 
 pprUnionTag ArrayRep           = char 'p'
 pprUnionTag ByteArrayRep       = char 'b'
+pprUnionTag BCORep             = char 'p'
 
 pprUnionTag _                   = panic "pprUnionTag:Odd kind"
 \end{code}
@@ -1534,9 +1536,8 @@ ppr_decls_Amode (CLit _)  = returnTE (Nothing, Nothing)
 -- CIntLike must be a literal -- no decls
 ppr_decls_Amode (CIntLike int) = returnTE (Nothing, Nothing)
 
--- CCharLike may have be arbitrary value -- may have decls
-ppr_decls_Amode (CCharLike char)
-  = ppr_decls_Amode char
+-- CCharLike too
+ppr_decls_Amode (CCharLike char) = returnTE (Nothing, Nothing)
 
 -- now, the only place where we actually print temps/externs...
 ppr_decls_Amode (CTemp uniq kind)