[project @ 2000-05-15 14:49:47 by simonmar]
[ghc-hetmet.git] / ghc / compiler / nativeGen / AbsCStixGen.lhs
index e5aa5f6..36cb457 100644 (file)
@@ -29,14 +29,14 @@ import ClosureInfo  ( infoTableLabelFromCI, entryLabelFromCI,
                          fastLabelFromCI, closureUpdReqd,
                          staticClosureNeedsLink
                        )
-import Literal         ( Literal(..) )
+import Literal         ( Literal(..), word2IntLit )
 import Maybes          ( maybeToBool )
 import PrimOp          ( primOpNeedsWrapper, PrimOp(..) )
 import PrimRep         ( isFloatingRep, PrimRep(..) )
 import StixInfo                ( genCodeInfoTable, genBitmapInfoTable )
 import StixMacro       ( macroCode, checkCode )
 import StixPrim                ( primCode, amodeToStix, amodeToStix' )
-import Outputable       ( pprPanic )
+import Outputable       ( pprPanic, ppr )
 import UniqSupply      ( returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
 import Util            ( naturalMergeSortLe )
 import Panic           ( panic )
@@ -44,10 +44,7 @@ import TyCon         ( tyConDataCons )
 import DataCon         ( dataConWrapId )
 import BitSet          ( intBS )
 import Name             ( NamedThing(..) )
-
-#ifdef REALLY_HASKELL_1_3
-ord = fromEnum :: Char -> Int
-#endif
+import Char            ( ord )
 \end{code}
 
 For each independent chunk of AbstractC code, we generate a list of
@@ -160,8 +157,9 @@ Here we handle top-level things, like @CCodeBlock@s and
             : StData IntRep [StInt 0]
             : StSegment TextSegment
             : StLabel lbl
-            : StCondJump tmp_lbl (StPrim IntNeOp [StCLbl moduleRegdLabel, 
-                                                  StInt 0])
+            : StCondJump tmp_lbl (StPrim IntNeOp       
+                                    [StInd IntRep (StCLbl moduleRegdLabel),
+                                     StInt 0])
             : StAssign IntRep (StInd IntRep (StCLbl moduleRegdLabel)) (StInt 1)
             : code 
             [ StLabel tmp_lbl
@@ -449,14 +447,15 @@ be tuned.)
 
  intTag :: Literal -> Integer
  intTag (MachChar c)  = toInteger (ord c)
- intTag (MachInt i) = i
- intTag _ = panic "intTag"
+ intTag (MachInt i)   = i
+ intTag (MachWord w)  = intTag (word2IntLit (MachWord w))
+ intTag _             = panic "intTag"
 
  fltTag :: Literal -> Rational
 
- fltTag (MachFloat f) = f
+ fltTag (MachFloat f)  = f
  fltTag (MachDouble d) = d
- fltTag _ = panic "fltTag"
+ fltTag x              = pprPanic "fltTag" (ppr x)
 
  {-
  mkSimpleSwitches
@@ -493,9 +492,10 @@ be tuned.)
        floating = isFloatingRep (getAmodeRep am)
        choices = length alts
 
-       (x@(MachChar _),_) `leAlt` (y,_) = intTag x <= intTag y
-       (x@(MachInt _), _) `leAlt` (y,_) = intTag x <= intTag y
-       (x,_)              `leAlt` (y,_) = fltTag x <= fltTag y
+       (x@(MachChar _),_)  `leAlt` (y,_) = intTag x <= intTag y
+       (x@(MachInt _), _)  `leAlt` (y,_) = intTag x <= intTag y
+       (x@(MachWord _), _) `leAlt` (y,_) = intTag x <= intTag y
+       (x,_)               `leAlt` (y,_) = fltTag x <= fltTag y
 
 \end{code}