X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FUnique.lhs;h=a25498b84eac6ebdd4ed54158e208c8a2859a070;hb=9c26739695219d8343505a88457cb55c76b65449;hp=a482b689d747fe15de5fdb1107aa1410017eb69e;hpb=8de16184643ea3c2f9f30b5eaed18db6ef247760;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
index a482b68..a25498b 100644
--- a/ghc/compiler/basicTypes/Unique.lhs
+++ b/ghc/compiler/basicTypes/Unique.lhs
@@ -114,6 +114,7 @@ module Unique (
 	listTyConKey,
 	ltDataConKey,
 	mainKey, mainPrimIoKey,
+	minusClassOpKey,
 	monadClassKey,
 	monadPlusClassKey,
 	monadZeroClassKey,
@@ -127,6 +128,7 @@ module Unique (
 	numClassKey,
 	ordClassKey,
 	orderingTyConKey,
+	otherwiseIdKey,
 	packCStringIdKey,
 	parErrorIdKey,
 	parIdKey,
@@ -148,6 +150,7 @@ module Unique (
 	return2GMPsTyConKey,
 	returnIntAndGMPDataConKey,
 	returnIntAndGMPTyConKey,
+	returnMClassOpKey,
 	runSTIdKey,
 	seqIdKey,
 	showClassKey,
@@ -192,6 +195,7 @@ module Unique (
 	stateTyConKey,
 	synchVarPrimTyConKey,
 	thenMClassOpKey,
+	toEnumClassOpKey,
 	traceIdKey,
 	trueDataConKey,
 	unpackCString2IdKey,
@@ -215,12 +219,28 @@ module Unique (
 	, parGlobalIdKey
 	, parLocalIdKey
 	, unboundKey
+	, byteArrayTyConKey
+	, mutableByteArrayTyConKey
+	, allClassKey
     ) where
 
+#if __GLASGOW_HASKELL__ <= 201
 import PreludeGlaST
+#else
+import GlaExts
+import ST
+#if __GLASGOW_HASKELL__ == 202
+import PrelBase ( Char(..) )
+#endif
+#endif
 
 IMP_Ubiq(){-uitous-}
 
+#if __GLASGOW_HASKELL__ >= 202
+import {-# SOURCE #-} UniqFM ( Uniquable(..) )
+#endif
+
+import Outputable
 import Pretty
 import Util
 \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,24 +347,24 @@ pprUnique uniq
 
 pprUnique10 uniq	-- in base-10, dudes
   = case unpkUnique uniq of
-      (tag, u) -> finish_ppr tag u (ppInt u)
+      (tag, u) -> finish_ppr tag u (int 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'
+	   1 -> char 'a'
+	   2 -> char 'b'
+	   3 -> char 'c'
+	   4 -> char 'd'
+	   5 -> char 'e'
 	   _ -> pp_all
   where
-    pp_all = ppBeside (ppChar tag) pp_u
+    pp_all = (<>) (char tag) pp_u
 
 showUnique :: Unique -> FAST_STRING
-showUnique uniq = _PK_ (ppShow 80 (pprUnique uniq))
+showUnique uniq = _PK_ (show (pprUnique uniq))
 
 instance Outputable Unique where
     ppr sty u = pprUnique u
@@ -363,12 +383,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 +403,7 @@ Code stolen from Lennart.
 # define RETURN	    returnStrictlyST
 #endif
 
-iToBase62 :: Int -> Pretty
+iToBase62 :: Int -> Doc
 
 iToBase62 n@(I# n#)
   = ASSERT(n >= 0)
@@ -386,11 +412,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
@@ -481,6 +507,7 @@ cCallableClassKey	= mkPreludeClassUnique 19
 cReturnableClassKey	= mkPreludeClassUnique 20
 
 ixClassKey		= mkPreludeClassUnique 21
+allClassKey		= mkPreludeClassUnique 22	-- Pseudo class used for universal quantification
 \end{code}
 
 %************************************************************************
@@ -537,10 +564,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
@@ -658,6 +685,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
@@ -673,4 +701,8 @@ fromEnumClassOpKey	= mkPreludeMiscIdUnique 65
 
 mainKey			= mkPreludeMiscIdUnique 66
 mainPrimIoKey		= mkPreludeMiscIdUnique 67
+returnMClassOpKey	= mkPreludeMiscIdUnique 68
+-- Used for minusClassOp			69
+otherwiseIdKey		= mkPreludeMiscIdUnique 70
+toEnumClassOpKey	= mkPreludeMiscIdUnique 71
 \end{code}