[project @ 2001-04-27 19:35:50 by qrczak]

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

diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index d2f6509..206df95 100644 (file)
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ b/ghc/compiler/basicTypes/Literal.lhs
@@ -8,13 +8,16 @@ module Literal
        ( Literal(..)           -- Exported to ParseIface
        , mkMachInt, mkMachWord
        , mkMachInt64, mkMachWord64
-       , isLitLitLit, maybeLitLit, litIsDupable,
+       , isLitLitLit, maybeLitLit, litSize, litIsDupable,
        , 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
@@ -30,10 +33,13 @@ import PprType              ( pprParendType )
 import CStrings                ( pprFSInCStyle )
 
 import Outputable
+import FastTypes
 import Util            ( thenCmp )
 
-import Ratio           ( numerator, denominator )
-import FastString      ( uniqueOfFS )
+import Ratio           ( numerator )
+import FastString      ( uniqueOfFS, lengthFS )
+import Int             ( Int8,  Int16,  Int32 )
+import Word            ( Word8, Word16, Word32 )
 import Char            ( ord, chr )
 \end{code}
 
@@ -60,6 +66,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}
  
 
@@ -98,6 +107,8 @@ data Literal
   | MachFloat  Rational
   | MachDouble Rational
 
+        -- MachLabel is used (only) for the literal derived from a 
+       -- "foreign label" declaration.
        -- string argument is the name of a symbol.  This literal
        -- refers to the *address* of the label.
   | MachLabel   FAST_STRING            -- always an Addr#
@@ -142,14 +153,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)
@@ -159,6 +177,13 @@ 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)
 
@@ -189,6 +214,11 @@ litIsDupable :: Literal -> Bool
        -- False principally of strings
 litIsDupable (MachStr _) = False
 litIsDupable other      = True
+
+litSize :: Literal -> Int
+       -- used by CoreUnfold.sizeExpr
+litSize (MachStr str) = lengthFS str `div` 4
+litSize _other       = 1
 \end{code}
 
        Types
@@ -239,20 +269,20 @@ 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 lit1               lit2                 | litTag lit1 _LT_ litTag lit2 = LT
+cmpLit lit1               lit2                 | litTag lit1 <# litTag lit2 = LT
                                                | otherwise                    = GT
 
-litTag (MachChar      _)   = ILIT(1)
-litTag (MachStr       _)   = ILIT(2)
-litTag (MachAddr      _)   = ILIT(3)
-litTag (MachInt       _)   = ILIT(4)
-litTag (MachWord      _)   = ILIT(5)
-litTag (MachInt64     _)   = ILIT(6)
-litTag (MachWord64    _)   = ILIT(7)
-litTag (MachFloat     _)   = ILIT(8)
-litTag (MachDouble    _)   = ILIT(9)
-litTag (MachLabel     _)   = ILIT(10)
-litTag (MachLitLit    _ _) = ILIT(11)
+litTag (MachChar      _)   = _ILIT(1)
+litTag (MachStr       _)   = _ILIT(2)
+litTag (MachAddr      _)   = _ILIT(3)
+litTag (MachInt       _)   = _ILIT(4)
+litTag (MachWord      _)   = _ILIT(5)
+litTag (MachInt64     _)   = _ILIT(6)
+litTag (MachWord64    _)   = _ILIT(7)
+litTag (MachFloat     _)   = _ILIT(8)
+litTag (MachDouble    _)   = _ILIT(9)
+litTag (MachLabel     _)   = _ILIT(10)
+litTag (MachLitLit    _ _) = _ILIT(11)
 \end{code}
 
        Printing
@@ -358,5 +388,5 @@ hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
                -- since we use * to combine hash values
 
 hashFS :: FAST_STRING -> Int
-hashFS s = IBOX( uniqueOfFS s )
+hashFS s = iBox (uniqueOfFS s)
 \end{code}