[project @ 2000-01-13 17:01:16 by sewardj]

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

diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
index 81e137d..6b5661b 100644 (file)
--- a/ghc/compiler/basicTypes/Unique.lhs
+++ b/ghc/compiler/basicTypes/Unique.lhs
@@ -26,6 +26,7 @@ module Unique (
        getKey,                         -- Used in Var only!
 
        incrUnique,                     -- Used for renumbering
+       deriveUnique,                   -- Ditto
        initTyVarUnique,
        initTidyUniques,
 
@@ -152,6 +153,7 @@ module Unique (
        recSelErrIdKey,
        recUpdErrorIdKey,
        returnMClassOpKey,
+       runSTRepIdKey,
        showClassKey,
        ioTyConKey,
        ioDataConKey,
@@ -232,6 +234,7 @@ mkUniqueGrimily :: Int# -> Unique           -- A trap-door for UniqSupply
 getKey         :: Unique -> Int#               -- for Var
 
 incrUnique     :: Unique -> Unique
+deriveUnique   :: Unique -> Int -> Unique
 \end{code}
 
 
@@ -243,6 +246,10 @@ getKey (MkUnique x) = x
 
 incrUnique (MkUnique i) = MkUnique (i +# 1#)
 
+-- deriveUnique uses an 'X' tag so that it won't clash with
+-- any of the uniques produced any other way
+deriveUnique (MkUnique i) delta = mkUnique 'X' (I# i + delta)
+
 -- pop the Char in the top 8 bits of the Unique(Supply)
 
 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
@@ -252,12 +259,15 @@ i2w x = int2Word# x
 i2w_s x = (x::Int#)
 
 mkUnique (C# c) (I# i)
-  = MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
+  = MkUnique (w2i (tag `or#` bits))
+  where
+    tag  = i2w (ord# c) `shiftL#` i2w_s 24#
+    bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-}
 
 unpkUnique (MkUnique u)
   = let
        tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
-       i   = I#  (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
+       i   = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
     in
     (tag, i)
   where
@@ -364,7 +374,11 @@ iToBase62 :: Int -> SDoc
 iToBase62 n@(I# n#)
   = ASSERT(n >= 0)
     let
+#if __GLASGOW_HASKELL__ < 405
        bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
+#else
+       bytes = case chars62 of { BYTE_ARRAY _ _ bytes -> bytes }
+#endif
     in
     if n# <# 62# then
        case (indexCharArray# bytes n#) of { c ->
@@ -403,6 +417,7 @@ Allocation of unique supply characters:
        other a-z: lower case chars for unique supplies (see Main.lhs)
        B:   builtin
        C-E: pseudo uniques     (used in native-code generator)
+       X:   uniques derived by deriveUnique
        _:   unifiable tyvars   (above)
        0-9: prelude things below
 
@@ -640,4 +655,5 @@ mapIdKey                  = mkPreludeMiscIdUnique 120
 
 \begin{code}
 assertIdKey                  = mkPreludeMiscIdUnique 121
+runSTRepIdKey                = mkPreludeMiscIdUnique 122
 \end{code}