[project @ 2000-06-12 11:04:50 by panne]

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

diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
index 604a980..8850936 100644 (file)
--- a/ghc/compiler/basicTypes/Unique.lhs
+++ b/ghc/compiler/basicTypes/Unique.lhs
@@ -16,7 +16,7 @@ Haskell).
 
 \begin{code}
 module Unique (
-       Unique, Uniquable(..),
+       Unique, Uniquable(..), hasKey,
        u2i,                            -- hack: used in UniqFM
 
        pprUnique, pprUnique10,
@@ -30,14 +30,14 @@ module Unique (
        initTyVarUnique,
        initTidyUniques,
 
+       isTupleKey, 
+
        -- now all the built-in Uniques (and functions to make them)
        -- [the Oh-So-Wonderful Haskell module system wins again...]
        mkAlphaTyVarUnique,
        mkPrimOpIdUnique,
        mkTupleDataConUnique,
-       mkUbxTupleDataConUnique,
        mkTupleTyConUnique,
-       mkUbxTupleTyConUnique,
 
        getBuiltinUniques, mkBuiltinUnique,
        mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
@@ -136,7 +136,6 @@ module Unique (
        ordClassKey,
        orderingTyConKey,
        otherwiseIdKey,
-       packCStringIdKey,
        parErrorIdKey,
        parIdKey,
        patErrorIdKey,
@@ -152,6 +151,7 @@ module Unique (
        recConErrorIdKey,
        recSelErrIdKey,
        recUpdErrorIdKey,
+       returnIOIdKey,
        returnMClassOpKey,
        runSTRepIdKey,
        showClassKey,
@@ -196,6 +196,7 @@ module Unique (
 
 #include "HsVersions.h"
 
+import BasicTypes      ( Boxity(..) )
 import FastString      ( FastString, uniqueOfFS )
 import GlaExts
 import ST
@@ -235,6 +236,8 @@ getKey              :: Unique -> Int#               -- for Var
 
 incrUnique     :: Unique -> Unique
 deriveUnique   :: Unique -> Int -> Unique
+
+isTupleKey     :: Unique -> Bool
 \end{code}
 
 
@@ -286,6 +289,9 @@ unpkUnique (MkUnique u)
 class Uniquable a where
     getUnique :: a -> Unique
 
+hasKey         :: Uniquable a => a -> Unique -> Bool
+x `hasKey` k   = getUnique x == k
+
 instance Uniquable FastString where
  getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
 
@@ -374,7 +380,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 ->
@@ -422,12 +432,23 @@ mkAlphaTyVarUnique i            = mkUnique '1' i
 
 mkPreludeClassUnique i         = mkUnique '2' i
 mkPreludeTyConUnique i         = mkUnique '3' i
-mkTupleTyConUnique a           = mkUnique '4' a
-mkUbxTupleTyConUnique a                = mkUnique '5' a
+mkTupleTyConUnique Boxed   a   = mkUnique '4' a
+mkTupleTyConUnique Unboxed a   = mkUnique '5' a
+
+-- Data constructor keys occupy *two* slots.  The first is used for the
+-- data constructor itself and its wrapper function (the function that
+-- evaluates arguments as necessary and calls the worker). The second is
+-- used for the worker function (the function that builds the constructor
+-- representation).
+
+mkPreludeDataConUnique i       = mkUnique '6' (2*i)    -- Must be alphabetic
+mkTupleDataConUnique Boxed a   = mkUnique '7' (2*a)    -- ditto (*may* be used in C labels)
+mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a)
 
-mkPreludeDataConUnique i       = mkUnique '6' i -- must be alphabetic
-mkTupleDataConUnique a         = mkUnique '7' a -- ditto (*may* be used in C labels)
-mkUbxTupleDataConUnique a      = mkUnique '8' a
+-- This one is used for a tiresome reason
+-- to improve a consistency-checking error check in the renamer
+isTupleKey u = case unpkUnique u of
+               (tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
 
 mkPrimOpIdUnique op            = mkUnique '9' op
 mkPreludeMiscIdUnique i                = mkUnique '0' i
@@ -553,24 +574,24 @@ threadIdPrimTyConKey                      = mkPreludeTyConUnique 70
 %************************************************************************
 
 \begin{code}
-addrDataConKey                         = mkPreludeDataConUnique  1
-charDataConKey                         = mkPreludeDataConUnique  2
-consDataConKey                         = mkPreludeDataConUnique  3
-doubleDataConKey                       = mkPreludeDataConUnique  4
-falseDataConKey                                = mkPreludeDataConUnique  5
-floatDataConKey                                = mkPreludeDataConUnique  6
-intDataConKey                          = mkPreludeDataConUnique  7
-smallIntegerDataConKey                 = mkPreludeDataConUnique 12
-largeIntegerDataConKey                 = mkPreludeDataConUnique 13
-foreignObjDataConKey                   = mkPreludeDataConUnique 14
-nilDataConKey                          = mkPreludeDataConUnique 15
-ratioDataConKey                                = mkPreludeDataConUnique 16
-stablePtrDataConKey                    = mkPreludeDataConUnique 17
-stableNameDataConKey                   = mkPreludeDataConUnique 18
-trueDataConKey                         = mkPreludeDataConUnique 34
-wordDataConKey                         = mkPreludeDataConUnique 35
-stDataConKey                           = mkPreludeDataConUnique 40
-ioDataConKey                           = mkPreludeDataConUnique 42
+addrDataConKey                         = mkPreludeDataConUnique  0
+charDataConKey                         = mkPreludeDataConUnique  1
+consDataConKey                         = mkPreludeDataConUnique  2
+doubleDataConKey                       = mkPreludeDataConUnique  3
+falseDataConKey                                = mkPreludeDataConUnique  4
+floatDataConKey                                = mkPreludeDataConUnique  5
+intDataConKey                          = mkPreludeDataConUnique  6
+smallIntegerDataConKey                 = mkPreludeDataConUnique  7
+largeIntegerDataConKey                 = mkPreludeDataConUnique  8
+foreignObjDataConKey                   = mkPreludeDataConUnique  9
+nilDataConKey                          = mkPreludeDataConUnique 10
+ratioDataConKey                                = mkPreludeDataConUnique 11
+stablePtrDataConKey                    = mkPreludeDataConUnique 12
+stableNameDataConKey                   = mkPreludeDataConUnique 13
+trueDataConKey                         = mkPreludeDataConUnique 14
+wordDataConKey                         = mkPreludeDataConUnique 15
+stDataConKey                           = mkPreludeDataConUnique 16
+ioDataConKey                           = mkPreludeDataConUnique 17
 \end{code}
 
 %************************************************************************
@@ -598,7 +619,6 @@ irrefutPatErrorIdKey              = mkPreludeMiscIdUnique 15
 lexIdKey                     = mkPreludeMiscIdUnique 16
 noMethodBindingErrorIdKey     = mkPreludeMiscIdUnique 17
 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18
-packCStringIdKey             = mkPreludeMiscIdUnique 19
 parErrorIdKey                = mkPreludeMiscIdUnique 20
 parIdKey                     = mkPreludeMiscIdUnique 21
 patErrorIdKey                = mkPreludeMiscIdUnique 22
@@ -616,9 +636,10 @@ concatIdKey                      = mkPreludeMiscIdUnique 33
 filterIdKey                  = mkPreludeMiscIdUnique 34
 zipIdKey                     = mkPreludeMiscIdUnique 35
 bindIOIdKey                  = mkPreludeMiscIdUnique 36
-deRefStablePtrIdKey          = mkPreludeMiscIdUnique 37
-makeStablePtrIdKey           = mkPreludeMiscIdUnique 38
-getTagIdKey                  = mkPreludeMiscIdUnique 39
+returnIOIdKey                = mkPreludeMiscIdUnique 37
+deRefStablePtrIdKey          = mkPreludeMiscIdUnique 38
+makeStablePtrIdKey           = mkPreludeMiscIdUnique 39
+getTagIdKey                  = mkPreludeMiscIdUnique 40
 \end{code}
 
 Certain class operations from Prelude classes.  They get their own