X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FTyVar.lhs;h=b7fc8b7d581ece259e1e05683df4f0490748c179;hb=5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d;hp=a448f565b48866c7e4ddcfa8bdb96c97ea3180c6;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/TyVar.lhs b/ghc/compiler/types/TyVar.lhs
index a448f56..b7fc8b7 100644
--- a/ghc/compiler/types/TyVar.lhs
+++ b/ghc/compiler/types/TyVar.lhs
@@ -2,41 +2,43 @@
 #include "HsVersions.h"
 
 module TyVar (
-	GenTyVar(..), TyVar(..),
-	mkTyVar,
-	getTyVarKind,		-- TyVar -> Kind
+	GenTyVar(..), SYN_IE(TyVar),
+	mkTyVar, mkSysTyVar,
+	tyVarKind,		-- TyVar -> Kind
+	cloneTyVar,
 
+	openAlphaTyVar,
 	alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
 
 	-- We also export "environments" keyed off of
 	-- TyVars and "sets" containing TyVars:
-	TyVarEnv(..),
+	SYN_IE(TyVarEnv),
 	nullTyVarEnv, mkTyVarEnv, addOneToTyVarEnv,
-	growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv,
+	growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv, delFromTyVarEnv,
 
-	GenTyVarSet(..), TyVarSet(..),
-	emptyTyVarSet, singletonTyVarSet, unionTyVarSets, tyVarListToSet,
-	tyVarSetToList, elementOfTyVarSet, minusTyVarSet, isEmptyTyVarSet
+	SYN_IE(GenTyVarSet), SYN_IE(TyVarSet),
+	emptyTyVarSet, unitTyVarSet, unionTyVarSets,
+	unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
+	tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
+	isEmptyTyVarSet
   ) where
 
 CHK_Ubiq() 	-- debugging consistency check
-import IdLoop 	-- for paranoia checking
+--IMPORT_DELOOPER(IdLoop) 	-- for paranoia checking
 
 -- friends
-import Usage		( GenUsage, Usage(..), usageOmega )
-import Kind		( Kind, mkBoxedTypeKind )
+import Usage		( GenUsage, SYN_IE(Usage), usageOmega )
+import Kind		( Kind, mkBoxedTypeKind, mkTypeKind )
 
 -- others
-import UniqSet		( uniqSetToList, emptyUniqSet, singletonUniqSet, minusUniqSet,
-			  unionUniqSets, elementOfUniqSet, isEmptyUniqSet, mkUniqSet,
-			  UniqSet(..) )
+import UniqSet		-- nearly all of it
 import UniqFM		( emptyUFM, listToUFM, addToUFM, lookupUFM,
-			  plusUFM, sizeUFM, UniqFM )
-import Maybes		( Maybe(..) )
-import NameTypes	( ShortName )
-import Pretty		( Pretty(..), PrettyRep, ppBeside, ppPStr )
+			  plusUFM, sizeUFM, delFromUFM, UniqFM
+			)
+import Name		( mkLocalName, changeUnique, Name, RdrName(..) )
+import Pretty		( SYN_IE(Pretty), PrettyRep, ppBeside, ppPStr )
 import PprStyle		( PprStyle )
-import Outputable	( Outputable(..), NamedThing(..), ExportFlag(..) )
+--import Outputable	( Outputable(..), NamedThing(..), ExportFlag(..) )
 import SrcLoc		( mkUnknownSrcLoc, SrcLoc )
 import Unique		( showUnique, mkAlphaTyVarUnique, Unique )
 import Util		( panic, Ord3(..) )
@@ -47,7 +49,7 @@ data GenTyVar flexi_slot
   = TyVar
 	Unique
 	Kind
-	(Maybe ShortName)	-- User name (if any)
+	(Maybe Name)		-- User name (if any)
 	flexi_slot		-- Extra slot used during type and usage
 				-- inference, and to contain usages.
 
@@ -58,24 +60,39 @@ type TyVar = GenTyVar Usage	-- Usage slot makes sense only if Kind = Type
 Simple construction and analysis functions
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 \begin{code}
-mkTyVar :: ShortName -> Unique -> Kind -> TyVar
-mkTyVar name uniq kind = TyVar  uniq
-				kind
-				(Just name)
-				usageOmega
-
-getTyVarKind :: GenTyVar flexi -> Kind
-getTyVarKind (TyVar _ kind _ _) = kind
+mkTyVar :: Name -> Kind -> TyVar
+mkTyVar name kind = TyVar  (uniqueOf name)
+			   kind
+			   (Just name)
+			   usageOmega
+
+mkSysTyVar :: Unique -> Kind -> TyVar
+mkSysTyVar uniq kind = TyVar uniq
+			     kind
+			     Nothing
+			     usageOmega
+
+tyVarKind :: GenTyVar flexi -> Kind
+tyVarKind (TyVar _ kind _ _) = kind
+
+cloneTyVar :: GenTyVar flexi -> Unique -> GenTyVar flexi
+cloneTyVar (TyVar _ k n x) u = TyVar u k n x
 \end{code}
 
 
 Fixed collection of type variables
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 \begin{code}
+	-- openAlphaTyVar is prepared to be instantiated
+	-- to a boxed or unboxed type variable.  It's used for the 
+	-- result type for "error", so that we can have (error Int# "Help")
+openAlphaTyVar = TyVar (mkAlphaTyVarUnique 1) mkTypeKind Nothing usageOmega
+
 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
-	      | u <- map mkAlphaTyVarUnique [1..] ]
+	      | u <- map mkAlphaTyVarUnique [2..] ]
 
 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
+
 \end{code}
 
 
@@ -90,11 +107,13 @@ addOneToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
 isNullTyVarEnv	 :: TyVarEnv a -> Bool
 lookupTyVarEnv	 :: TyVarEnv a -> GenTyVar flexi -> Maybe a
+delFromTyVarEnv	 :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
 
 nullTyVarEnv	 = emptyUFM
 mkTyVarEnv	 = listToUFM
 addOneToTyVarEnv = addToUFM
 lookupTyVarEnv   = lookupUFM
+delFromTyVarEnv  = delFromUFM
 
 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
 isNullTyVarEnv   env	   = sizeUFM env == 0
@@ -107,22 +126,26 @@ type GenTyVarSet flexi	= UniqSet (GenTyVar flexi)
 type TyVarSet		= UniqSet TyVar
 
 emptyTyVarSet     :: GenTyVarSet flexi
+intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 unionTyVarSets    :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
+unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
 tyVarSetToList    :: GenTyVarSet flexi -> [GenTyVar flexi]
-singletonTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
+unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
 minusTyVarSet	  :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 isEmptyTyVarSet   :: GenTyVarSet flexi -> Bool
-tyVarListToSet	  :: [GenTyVar flexi] -> GenTyVarSet flexi
+mkTyVarSet	  :: [GenTyVar flexi] -> GenTyVarSet flexi
 
 emptyTyVarSet  	  = emptyUniqSet
-singletonTyVarSet = singletonUniqSet
+unitTyVarSet = unitUniqSet
+intersectTyVarSets= intersectUniqSets
 unionTyVarSets 	  = unionUniqSets
+unionManyTyVarSets= unionManyUniqSets
 tyVarSetToList 	  = uniqSetToList
 elementOfTyVarSet = elementOfUniqSet
 minusTyVarSet	  = minusUniqSet
 isEmptyTyVarSet   = isEmptyUniqSet
-tyVarListToSet	  = mkUniqSet
+mkTyVarSet	  = mkUniqSet
 \end{code}
 
 Instance delarations
@@ -134,20 +157,10 @@ instance Eq (GenTyVar a) where
 instance Ord3 (GenTyVar a) where
     cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
 
-instance NamedThing (GenTyVar a) where
-    getExportFlag 	(TyVar _ _ _ _) = NotExported
-    isLocallyDefined	(TyVar _ _ _ _) = True
-
-    getOrigName		(TyVar _ _ (Just n) _) = getOrigName n
-    getOrigName		(TyVar u _ _        _) = (panic "getOrigName:TyVar",
-						  showUnique u)
-    getOccurrenceName	(TyVar _ _ (Just n) _) = getOccurrenceName n
-    getOccurrenceName	(TyVar u _ _        _) = showUnique u
-
-    getSrcLoc		(TyVar _ _ (Just n) _) = getSrcLoc n
-    getSrcLoc		(TyVar _ _ _        _) = mkUnknownSrcLoc
-    fromPreludeCore	(TyVar _ _ _ _)	       = False
-
-    getItsUnique	(TyVar u _ _ _)	       = u
+instance Uniquable (GenTyVar a) where
+    uniqueOf (TyVar u _ _ _) = u
 
+instance NamedThing (GenTyVar a) where
+    getName (TyVar _ _ (Just n) _) = n
+    getName (TyVar u _ _        _) = mkLocalName u (showUnique u) True{-emph uniq-} mkUnknownSrcLoc
 \end{code}