[project @ 1999-02-05 16:37:13 by sof]

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

diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index f5456b8..4901261 100644 (file)
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -43,7 +43,7 @@ import Const          ( Literal(..) )
 import Maybes          ( maybeToBool, catMaybes )
 import PrimOp          ( primOpNeedsWrapper, pprPrimOp, PrimOp(..) )
 import PrimRep         ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep )
-import SMRep           ( getSMRepStr )
+import SMRep           ( pprSMRep )
 import Unique          ( pprUnique, Unique{-instance NamedThing-} )
 import UniqSet         ( emptyUniqSet, elementOfUniqSet,
                          addOneToUniqSet, UniqSet
@@ -170,6 +170,7 @@ pprAbsC (CSwitch discrim [(tag,alt_code)] deflt) c -- only one alt
       Just dc ->               -- make it an "if"
                 do_if_stmt discrim tag alt_code dc c
 
+-- What problem is the re-ordering trying to solve ?
 pprAbsC (CSwitch discrim [(tag1@(MachInt i1 _), alt_code1),
                              (tag2@(MachInt i2 _), alt_code2)] deflt) c
   | empty_deflt && ((i1 == 0 && i2 == 1) || (i1 == 1 && i2 == 0))
@@ -449,7 +450,7 @@ pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast srt cl_descr) _
                  else empty,
                  type_str ]
 
-    type_str = text (getSMRepStr (closureSMRep cl_info))
+    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 '"']
@@ -625,9 +626,23 @@ do_if_stmt discrim tag alt_code deflt c
                                      deflt alt_code
                                      (addrModeCosts discrim Rhs) c
       other              -> let
-                              cond = hcat [ pprAmode discrim,
-                                         ptext SLIT(" == "),
-                                         pprAmode (CLit tag) ]
+                              cond = hcat [ pprAmode discrim
+                                          , ptext SLIT(" == ")
+                                          , tcast
+                                          , pprAmode (CLit tag)
+                                          ]
+                               -- to be absolutely sure that none of the 
+                               -- conversion rules hit, e.g.,
+                               --
+                               --     minInt is different to (int)minInt
+                               --
+                               -- in C (when minInt is a number not a constant
+                               --  expression which evaluates to it.)
+                               -- 
+                              tcast =
+                                case other of
+                                  MachInt _ signed | signed    -> ptext SLIT("(I_)")
+                                  _ -> empty
                            in
                            ppr_if_stmt cond
                                         alt_code deflt
@@ -1229,6 +1244,7 @@ pprUnionTag FloatRep              = char 'f'
 pprUnionTag DoubleRep          = panic "pprUnionTag:Double?"
 
 pprUnionTag StablePtrRep       = char 'i'
+pprUnionTag StableNameRep      = char 'p'
 pprUnionTag WeakPtrRep         = char 'p'
 pprUnionTag ForeignObjRep      = char 'p'
 
@@ -1543,7 +1559,7 @@ big_doubles = (getPrimRepSize DoubleRep) /= 1
 floatToWord :: CAddrMode -> CAddrMode
 floatToWord (CLit (MachFloat r))
   = runST (do
-       arr <- newFloatArray (0,0)
+       arr <- newFloatArray ((0::Int),0)
        writeFloatArray arr 0 (fromRational r)
        i <- readIntArray arr 0
        return (CLit (MachInt (toInteger i) True))
@@ -1553,7 +1569,7 @@ doubleToWords :: CAddrMode -> [CAddrMode]
 doubleToWords (CLit (MachDouble r))
   | big_doubles                                -- doubles are 2 words
   = runST (do
-       arr <- newDoubleArray (0,1)
+       arr <- newDoubleArray ((0::Int),1)
        writeDoubleArray arr 0 (fromRational r)
        i1 <- readIntArray arr 0
        i2 <- readIntArray arr 1
@@ -1563,7 +1579,7 @@ doubleToWords (CLit (MachDouble r))
     )
   | otherwise                          -- doubles are 1 word
   = runST (do
-       arr <- newDoubleArray (0,0)
+       arr <- newDoubleArray ((0::Int),0)
        writeDoubleArray arr 0 (fromRational r)
        i <- readIntArray arr 0
        return [ CLit (MachInt (toInteger i) True) ]