[project @ 1997-07-05 03:02:04 by sof]

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

diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
index 2f2b1c8..9aa57b9 100644 (file)
--- a/ghc/compiler/basicTypes/Unique.lhs
+++ b/ghc/compiler/basicTypes/Unique.lhs
@@ -21,7 +21,7 @@ Haskell).
 --<mkdependHS:friends> UniqSupply
 
 module Unique (
-       Unique,
+       Unique, Uniquable(..),
        u2i,                            -- hack: used in UniqFM
 
        pprUnique, pprUnique10, showUnique,
@@ -30,7 +30,8 @@ module Unique (
        mkUniqueGrimily,                -- Used in UniqSupply only!
 
        incrUnique,                     -- Used for renumbering
-       initRenumberingUniques,
+       initTyVarUnique, mkTyVarUnique,
+       initTidyUniques,
 
        -- now all the built-in Uniques (and functions to make them)
        -- [the Oh-So-Wonderful Haskell module system wins again...]
@@ -87,6 +88,7 @@ module Unique (
        foreignObjTyConKey,
        forkIdKey,
        fractionalClassKey,
+       fromEnumClassOpKey,
        fromIntClassOpKey,
        fromIntegerClassOpKey,
        fromRationalClassOpKey,
@@ -112,8 +114,8 @@ module Unique (
        liftTyConKey,
        listTyConKey,
        ltDataConKey,
-       mainIdKey,
-       mainPrimIOIdKey,
+       mainKey, mainPrimIoKey,
+       minusClassOpKey,
        monadClassKey,
        monadPlusClassKey,
        monadZeroClassKey,
@@ -127,12 +129,12 @@ module Unique (
        numClassKey,
        ordClassKey,
        orderingTyConKey,
+       otherwiseIdKey,
        packCStringIdKey,
        parErrorIdKey,
        parIdKey,
        patErrorIdKey,
        primIoTyConKey,
-       primIoDataConKey,
        ratioDataConKey,
        ratioTyConKey,
        rationalTyConKey,
@@ -149,6 +151,7 @@ module Unique (
        return2GMPsTyConKey,
        returnIntAndGMPDataConKey,
        returnIntAndGMPTyConKey,
+       returnMClassOpKey,
        runSTIdKey,
        seqIdKey,
        showClassKey,
@@ -193,6 +196,7 @@ module Unique (
        stateTyConKey,
        synchVarPrimTyConKey,
        thenMClassOpKey,
+       toEnumClassOpKey,
        traceIdKey,
        trueDataConKey,
        unpackCString2IdKey,
@@ -215,12 +219,23 @@ module Unique (
        , parAtRelIdKey
        , parGlobalIdKey
        , parLocalIdKey
+       , unboundKey
+       , byteArrayTyConKey
+       , mutableByteArrayTyConKey
+       , allClassKey
     ) where
 
+#if __GLASGOW_HASKELL__ <= 201
 import PreludeGlaST
+#else
+import GlaExts
+import ST
+import PrelBase ( Char(..), chr, ord )
+#endif
 
 IMP_Ubiq(){-uitous-}
 
+import Outputable
 import Pretty
 import Util
 \end{code}
@@ -235,9 +250,14 @@ The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
 Fast comparison is everything on @Uniques@:
 
 \begin{code}
-u2i :: Unique -> FAST_INT
-
 data Unique = MkUnique Int#
+
+class Uniquable a where
+    uniqueOf :: a -> Unique
+\end{code}
+
+\begin{code}
+u2i :: Unique -> FAST_INT
 u2i (MkUnique i) = i
 \end{code}
 
@@ -319,7 +339,7 @@ instance Uniquable Unique where
 
 We do sometimes make strings with @Uniques@ in them:
 \begin{code}
-pprUnique, pprUnique10 :: Unique -> Pretty
+pprUnique, pprUnique10 :: Unique -> Doc
 
 pprUnique uniq
   = case unpkUnique uniq of
@@ -327,30 +347,22 @@ pprUnique uniq
 
 pprUnique10 uniq       -- in base-10, dudes
   = case unpkUnique uniq of
-      (tag, u) -> finish_ppr tag u (ppInt u)
-
-finish_ppr tag u pp_u
-  = if tag /= 't' -- this is just to make v common tyvars, t1, t2, ...
-                 -- come out as a, b, ... (shorter, easier to read)
-    then pp_all
-    else case u of
-          1 -> ppChar 'a'
-          2 -> ppChar 'b'
-          3 -> ppChar 'c'
-          4 -> ppChar 'd'
-          5 -> ppChar 'e'
-          _ -> pp_all
-  where
-    pp_all = ppBeside (ppChar tag) pp_u
+      (tag, u) -> finish_ppr tag u (int u)
+
+finish_ppr 't' u pp_u | u < 26
+  =    -- Special case to make v common tyvars, t1, t2, ...
+       -- come out as a, b, ... (shorter, easier to read)
+    char (chr (ord 'a' + u))
+finish_ppr tag u pp_u = char tag <> pp_u
 
-showUnique :: Unique -> FAST_STRING
-showUnique uniq = _PK_ (ppShow 80 (pprUnique uniq))
+showUnique :: Unique -> String
+showUnique uniq = show (pprUnique uniq)
 
 instance Outputable Unique where
     ppr sty u = pprUnique u
 
 instance Text Unique where
-    showsPrec p uniq rest = _UNPK_ (showUnique uniq)
+    showsPrec p uniq rest = showUnique uniq
 \end{code}
 
 %************************************************************************
@@ -363,12 +375,18 @@ A character-stingy way to read/write numbers (notably Uniques).
 The ``62-its'' are \tr{[0-9a-zA-Z]}.  We don't handle negative Ints.
 Code stolen from Lennart.
 \begin{code}
-#if __GLASGOW_HASKELL__ >= 200
+#if __GLASGOW_HASKELL__ == 201
 # define BYTE_ARRAY GHCbase.ByteArray
 # define RUN_ST            GHCbase.runST
 # define AND_THEN   >>=
 # define AND_THEN_  >>
 # define RETURN            return
+#elif __GLASGOW_HASKELL__ >= 202
+# define BYTE_ARRAY GlaExts.ByteArray
+# define RUN_ST            ST.runST
+# define AND_THEN   >>=
+# define AND_THEN_  >>
+# define RETURN            return
 #else
 # define BYTE_ARRAY _ByteArray
 # define RUN_ST            _runST
@@ -377,7 +395,7 @@ Code stolen from Lennart.
 # define RETURN            returnStrictlyST
 #endif
 
-iToBase62 :: Int -> Pretty
+iToBase62 :: Int -> Doc
 
 iToBase62 n@(I# n#)
   = ASSERT(n >= 0)
@@ -386,11 +404,11 @@ iToBase62 n@(I# n#)
     in
     if n# <# 62# then
        case (indexCharArray# bytes n#) of { c ->
-       ppChar (C# c) }
+       char (C# c) }
     else
        case (quotRem n 62)             of { (q, I# r#) ->
        case (indexCharArray# bytes r#) of { c  ->
-       ppBeside (iToBase62 q) (ppChar (C# c)) }}
+       (<>) (iToBase62 q) (char (C# c)) }}
 
 -- keep this at top level! (bug on 94/10/24 WDP)
 chars62 :: BYTE_ARRAY Int
@@ -437,7 +455,17 @@ mkTupleDataConUnique a             = mkUnique '6' a        -- ditto (*may* be used in C labels)
 mkPrimOpIdUnique op            = mkUnique '7' op
 mkPreludeMiscIdUnique i                = mkUnique '8' i
 
-initRenumberingUniques = (mkUnique 'v' 1, mkUnique 't' 1, mkUnique 'u' 1)
+-- The "tyvar uniques" print specially nicely: a, b, c, etc.
+-- See pprUnique for details
+
+initTyVarUnique :: Unique
+initTyVarUnique = mkUnique 't' 0
+
+mkTyVarUnique :: Int -> Unique
+mkTyVarUnique n = mkUnique 't' n
+
+initTidyUniques :: (Unique, Unique)    -- Global and local
+initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
 
 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
  mkBuiltinUnique :: Int -> Unique
@@ -481,6 +509,7 @@ cCallableClassKey   = mkPreludeClassUnique 19
 cReturnableClassKey    = mkPreludeClassUnique 20
 
 ixClassKey             = mkPreludeClassUnique 21
+allClassKey            = mkPreludeClassUnique 22       -- Pseudo class used for universal quantification
 \end{code}
 
 %************************************************************************
@@ -537,10 +566,10 @@ stateAndStablePtrPrimTyConKey             = mkPreludeTyConUnique 45
 stateAndWordPrimTyConKey               = mkPreludeTyConUnique 46
 statePrimTyConKey                      = mkPreludeTyConUnique 47
 stateTyConKey                          = mkPreludeTyConUnique 48
-                                                               -- 49 is spare
+mutableByteArrayTyConKey               = mkPreludeTyConUnique 49
 stTyConKey                             = mkPreludeTyConUnique 50
 primIoTyConKey                         = mkPreludeTyConUnique 51
-                                                               -- 52 is spare
+byteArrayTyConKey                      = mkPreludeTyConUnique 52
 wordPrimTyConKey                       = mkPreludeTyConUnique 53
 wordTyConKey                           = mkPreludeTyConUnique 54
 voidTyConKey                           = mkPreludeTyConUnique 55
@@ -590,7 +619,6 @@ stateDataConKey                             = mkPreludeDataConUnique 39
 trueDataConKey                         = mkPreludeDataConUnique 40
 wordDataConKey                         = mkPreludeDataConUnique 41
 stDataConKey                           = mkPreludeDataConUnique 42
-primIoDataConKey                       = mkPreludeDataConUnique 43
 \end{code}
 
 %************************************************************************
@@ -617,8 +645,6 @@ integerPlusTwoIdKey       = mkPreludeMiscIdUnique 14
 integerZeroIdKey             = mkPreludeMiscIdUnique 15
 irrefutPatErrorIdKey         = mkPreludeMiscIdUnique 16
 lexIdKey                     = mkPreludeMiscIdUnique 17
-mainIdKey                    = mkPreludeMiscIdUnique 18
-mainPrimIOIdKey                      = mkPreludeMiscIdUnique 19
 noDefaultMethodErrorIdKey     = mkPreludeMiscIdUnique 20
 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21
 nonExplicitMethodErrorIdKey   = mkPreludeMiscIdUnique 22
@@ -661,6 +687,7 @@ to conjure them up during type checking.
 \begin{code}                                     
 fromIntClassOpKey      = mkPreludeMiscIdUnique 53
 fromIntegerClassOpKey  = mkPreludeMiscIdUnique 54
+minusClassOpKey                = mkPreludeMiscIdUnique 69
 fromRationalClassOpKey = mkPreludeMiscIdUnique 55
 enumFromClassOpKey     = mkPreludeMiscIdUnique 56
 enumFromThenClassOpKey = mkPreludeMiscIdUnique 57
@@ -670,4 +697,14 @@ eqClassOpKey               = mkPreludeMiscIdUnique 60
 geClassOpKey           = mkPreludeMiscIdUnique 61
 zeroClassOpKey         = mkPreludeMiscIdUnique 62
 thenMClassOpKey                = mkPreludeMiscIdUnique 63 -- (>>=)
+unboundKey             = mkPreludeMiscIdUnique 64      -- Just a place holder for unbound
+                                                       -- variables produced by the renamer
+fromEnumClassOpKey     = mkPreludeMiscIdUnique 65
+
+mainKey                        = mkPreludeMiscIdUnique 66
+mainPrimIoKey          = mkPreludeMiscIdUnique 67
+returnMClassOpKey      = mkPreludeMiscIdUnique 68
+-- Used for minusClassOp                       69
+otherwiseIdKey         = mkPreludeMiscIdUnique 70
+toEnumClassOpKey       = mkPreludeMiscIdUnique 71
 \end{code}