[project @ 2001-08-09 11:32:15 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Literal.lhs

diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index fb93ef4..f9de3e3 100644 (file)
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ b/ghc/compiler/basicTypes/Literal.lhs
@@ -12,9 +12,12 @@ module Literal
        , literalType, literalPrimRep
        , hashLiteral
 
-       , inIntRange, inWordRange, tARGET_MAX_INT
+       , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
 
-       , word2IntLit, int2WordLit, char2IntLit, int2CharLit
+       , word2IntLit, int2WordLit
+       , intToInt8Lit, intToInt16Lit, intToInt32Lit
+       , wordToWord8Lit, wordToWord16Lit, wordToWord32Lit
+       , char2IntLit, int2CharLit
        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
        , addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
        ) where
@@ -25,7 +28,8 @@ import TysPrim                ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
                          intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
                        )
 import PrimRep         ( PrimRep(..) )
-import Type            ( Type, typePrimRep )
+import TcType          ( Type, tcCmpType )
+import Type            ( typePrimRep )
 import PprType         ( pprParendType )
 import CStrings                ( pprFSInCStyle )
 
@@ -35,6 +39,8 @@ import Util           ( thenCmp )
 
 import Ratio           ( numerator )
 import FastString      ( uniqueOfFS, lengthFS )
+import Int             ( Int8,  Int16,  Int32 )
+import Word            ( Word8, Word16, Word32 )
 import Char            ( ord, chr )
 \end{code}
 
@@ -61,6 +67,9 @@ tARGET_MIN_INT = -2147483648
 tARGET_MAX_INT =  2147483647
 #endif
 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
+
+tARGET_MAX_CHAR :: Int
+tARGET_MAX_CHAR = 0x10ffff
 \end{code}
  
 
@@ -145,14 +154,21 @@ mkMachWord64 x = MachWord64 x     -- Ditto?
 inIntRange, inWordRange :: Integer -> Bool
 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 inWordRange x = x >= 0             && x <= tARGET_MAX_WORD
+
+inCharRange :: Int -> Bool
+inCharRange c =  c >= 0 && c <= tARGET_MAX_CHAR
 \end{code}
 
        Coercions
        ~~~~~~~~~
 \begin{code}
-word2IntLit, int2WordLit, char2IntLit, int2CharLit,
- float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
- addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit :: Literal -> Literal
+word2IntLit, int2WordLit,
+  intToInt8Lit, intToInt16Lit, intToInt32Lit,
+  wordToWord8Lit, wordToWord16Lit, wordToWord32Lit,
+  char2IntLit, int2CharLit,
+  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
+  addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
+  :: Literal -> Literal
 
 word2IntLit (MachWord w) 
   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
@@ -162,13 +178,20 @@ int2WordLit (MachInt i)
   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)     -- (-1)  --->  tARGET_MAX_WORD
   | otherwise = MachWord i
 
+intToInt8Lit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
+intToInt16Lit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
+intToInt32Lit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
+wordToWord8Lit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
+wordToWord16Lit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
+wordToWord32Lit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
+
 char2IntLit (MachChar c) = MachInt  (toInteger c)
 int2CharLit (MachInt  i) = MachChar (fromInteger i)
 
 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 
-double2IntLit (MachFloat f) = MachInt    (truncate    f)
+double2IntLit (MachDouble f) = MachInt    (truncate    f)
 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 
 addr2IntLit (MachAddr a) = MachInt  a
@@ -246,7 +269,7 @@ cmpLit (MachWord64    a)   (MachWord64         b)   = a `compare` b
 cmpLit (MachFloat     a)   (MachFloat     b)   = a `compare` b
 cmpLit (MachDouble    a)   (MachDouble    b)   = a `compare` b
 cmpLit (MachLabel     a)   (MachLabel      b)   = a `compare` b
-cmpLit (MachLitLit    a b) (MachLitLit    c d)  = (a `compare` c) `thenCmp` (b `compare` d)
+cmpLit (MachLitLit    a b) (MachLitLit    c d)  = (a `compare` c) `thenCmp` (b `tcCmpType` d)
 cmpLit lit1               lit2                 | litTag lit1 <# litTag lit2 = LT
                                                | otherwise                    = GT