X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FVar.lhs;h=c3f626e54f33375866a53a98545520692e1b7d6e;hb=233b831bd7e89950f5c75aaa71b859c87a33d11a;hp=23622292abe1c6c64dd18d7f23ad08cbafb29ce2;hpb=16d5d1c75c999677783c9c1bda519540fa9a6e58;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
index 2362229..c3f626e 100644
--- a/ghc/compiler/basicTypes/Var.lhs
+++ b/ghc/compiler/basicTypes/Var.lhs
@@ -5,49 +5,45 @@
 
 \begin{code}
 module Var (
-	Var, VarDetails,		-- Abstract
-	varName, varUnique, varInfo, varType,
-	setVarName, setVarUnique, setVarType, setVarOcc,
+	Var, 
+	varName, varUnique, 
+	setVarName, setVarUnique, setVarOcc,
 
 	-- TyVars
-	TyVar,
+	TyVar, mkTyVar, mkTcTyVar,
 	tyVarName, tyVarKind,
 	setTyVarName, setTyVarUnique,
-	mkTyVar, mkSysTyVar, 
-	newMutTyVar, newSigTyVar,
-	readMutTyVar, writeMutTyVar, makeTyVarImmutable,
+	tcTyVarDetails,
 
 	-- Ids
 	Id, DictId,
 	idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
-	setIdName, setIdUnique, setIdInfo, lazySetIdInfo, 
-	setIdNoDiscard, zapSpecPragmaId,
+	setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, 
+	setIdExported, setIdNotExported, zapSpecPragmaId,
 
-	globalIdDetails, setGlobalIdDetails, 
+	globalIdDetails, globaliseId, 
 
-	mkLocalId, mkGlobalId, mkSpecPragmaId,
+	mkLocalId, mkExportedLocalId, mkSpecPragmaId,
+	mkGlobalId, 
 
-	isTyVar, isMutTyVar, isSigTyVar,
-	isId, isLocalVar, isLocalId,
+	isTyVar, isTcTyVar, isId, isLocalVar, isLocalId,
 	isGlobalId, isExportedId, isSpecPragmaId,
 	mustHaveLocalBinding
     ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}	TypeRep( Type, Kind )
-import {-# SOURCE #-}	IdInfo( GlobalIdDetails, notGlobalId,
-				IdInfo, seqIdInfo )
+import {-# SOURCE #-}	TypeRep( Type )
+import {-# SOURCE #-}	TcType( TcTyVarDetails )
+import {-# SOURCE #-}	IdInfo( GlobalIdDetails, notGlobalId, IdInfo, seqIdInfo )
 
 import Name		( Name, OccName, NamedThing(..),
-			  setNameUnique, setNameOcc, nameUnique, 
-			  mkSysLocalName, isExternallyVisibleName
+			  setNameUnique, setNameOcc, nameUnique
 			)
-import Unique		( Unique, Uniquable(..), mkUniqueGrimily, getKey )
+import Kind		( Kind )
+import Unique		( Unique, Uniquable(..), mkUniqueGrimily, getKey# )
 import FastTypes
 import Outputable
-
-import IOExts		( IORef, newIORef, readIORef, writeIORef )
 \end{code}
 
 
@@ -65,38 +61,40 @@ in its @VarDetails@.
 
 \begin{code}
 data Var
-  = Var {
-	varName    :: Name,
+  = TyVar {
+	varName    :: !Name,
 	realUnique :: FastInt,		-- Key for fast comparison
 					-- Identical to the Unique in the name,
 					-- cached here for speed
-	varType    :: Type,
-	varDetails :: VarDetails,
-	varInfo    :: IdInfo		-- Only used for Ids at the moment
-    }
-
-data VarDetails
-  = LocalId 		-- Used for locally-defined Ids (see NOTE below)
-	LocalIdDetails
-
-  | GlobalId 		-- Used for imported Ids, dict selectors etc
-	GlobalIdDetails
-
-  | TyVar
-  | MutTyVar (IORef (Maybe Type)) 	-- Used during unification;
-	     Bool			-- True <=> this is a type signature variable, which
-					--	    should not be unified with a non-tyvar type
-
-	-- For a long time I tried to keep mutable Vars statically type-distinct
-	-- from immutable Vars, but I've finally given up.   It's just too painful.
-	-- After type checking there are no MutTyVars left, but there's no static check
-	-- of that fact.
+	tyVarKind :: Kind }
+
+  | TcTyVar { 				-- Used only during type inference
+	varName        :: !Name,
+	realUnique     :: FastInt,
+	tyVarKind      :: Kind,
+	tcTyVarDetails :: TcTyVarDetails }
+
+  | GlobalId { 			-- Used for imported Ids, dict selectors etc
+	varName    :: !Name,
+	realUnique :: FastInt,
+   	idType     :: Type,
+	idInfo     :: IdInfo,
+	gblDetails :: GlobalIdDetails }
+
+  | LocalId { 			-- Used for locally-defined Ids (see NOTE below)
+	varName    :: !Name,
+	realUnique :: FastInt,
+   	idType     :: Type,
+	idInfo     :: IdInfo,
+	lclDetails :: LocalIdDetails }
 
 data LocalIdDetails 
   = NotExported	-- Not exported
   | Exported	-- Exported
   | SpecPragma	-- Not exported, but not to be discarded either
 		-- It's unclean that this is so deeply built in
+  -- Exported and SpecPragma Ids are kept alive; 
+  -- NotExported things may be discarded as dead code.
 \end{code}
 
 LocalId and GlobalId
@@ -141,23 +139,21 @@ instance Ord Var where
 
 \begin{code}
 varUnique :: Var -> Unique
-varUnique (Var {realUnique = uniq}) = mkUniqueGrimily uniq
+varUnique var = mkUniqueGrimily (iBox (realUnique var))
 
 setVarUnique :: Var -> Unique -> Var
-setVarUnique var@(Var {varName = name}) uniq 
-  = var {realUnique = getKey uniq, 
-	 varName = setNameUnique name uniq}
+setVarUnique var uniq 
+  = var { realUnique = getKey# uniq, 
+	  varName = setNameUnique (varName var) uniq }
 
 setVarName :: Var -> Name -> Var
 setVarName var new_name
-  = var { realUnique = getKey (getUnique new_name), varName = new_name }
+  = var { realUnique = getKey# (getUnique new_name), 
+   	  varName = new_name }
 
 setVarOcc :: Var -> OccName -> Var
 setVarOcc var new_occ
   = var { varName = setNameOcc (varName var) new_occ }
-
-setVarType :: Var -> Type -> Var
-setVarType var ty = var {varType = ty}
 \end{code}
 
 
@@ -169,11 +165,8 @@ setVarType var ty = var {varType = ty}
 
 \begin{code}
 type TyVar = Var
-\end{code}
 
-\begin{code}
 tyVarName = varName
-tyVarKind = varType
 
 setTyVarUnique = setVarUnique
 setTyVarName   = setVarName
@@ -181,50 +174,18 @@ setTyVarName   = setVarName
 
 \begin{code}
 mkTyVar :: Name -> Kind -> TyVar
-mkTyVar name kind = Var { varName    = name
-			, realUnique = getKey (nameUnique name)
-			, varType    = kind
-			, varDetails = TyVar
-			, varInfo    = pprPanic "mkTyVar" (ppr name)
+mkTyVar name kind = TyVar { varName    = name
+			  , realUnique = getKey# (nameUnique name)
+			  , tyVarKind  = kind
 			}
 
-mkSysTyVar :: Unique -> Kind -> TyVar
-mkSysTyVar uniq kind = Var { varName    = name
-			   , realUnique = getKey uniq
-			   , varType    = kind
-			   , varDetails = TyVar
-			   , varInfo    = pprPanic "mkSysTyVar" (ppr name)
-			   }
-		     where
-		       name = mkSysLocalName uniq SLIT("t")
-
-newMutTyVar :: Name -> Kind -> IO TyVar
-newMutTyVar name kind = newTyVar name kind False
-
-newSigTyVar :: Name -> Kind -> IO TyVar
--- Type variables from type signatures are still mutable, because
--- they may get unified with type variables from other signatures
--- But they do contain a flag to distinguish them, so we can tell if
--- we unify them with a non-type-variable.
-newSigTyVar name kind = newTyVar name kind True
-
-newTyVar name kind is_sig
- = do loc <- newIORef Nothing
-      return (Var { varName    = name
-		  , realUnique = getKey (nameUnique name)
-		  , varType    = kind
-		  , varDetails = MutTyVar loc is_sig
-		  , varInfo    = pprPanic "newMutTyVar" (ppr name)
-		  })
-
-readMutTyVar :: TyVar -> IO (Maybe Type)
-readMutTyVar (Var {varDetails = MutTyVar loc _}) = readIORef loc
-
-writeMutTyVar :: TyVar -> Maybe Type -> IO ()
-writeMutTyVar (Var {varDetails = MutTyVar loc _}) val = writeIORef loc val
-
-makeTyVarImmutable :: TyVar -> TyVar
-makeTyVarImmutable tyvar = tyvar { varDetails = TyVar}
+mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
+mkTcTyVar name kind details
+  = TcTyVar {	varName    = name,
+		realUnique = getKey# (nameUnique name),
+		tyVarKind  = kind,
+		tcTyVarDetails = details
+	}
 \end{code}
 
 
@@ -243,9 +204,7 @@ type DictId = Id
 
 \begin{code}
 idName    = varName
-idType    = varType
 idUnique  = varUnique
-idInfo	  = varInfo
 
 setIdUnique :: Id -> Unique -> Id
 setIdUnique = setVarUnique
@@ -253,35 +212,51 @@ setIdUnique = setVarUnique
 setIdName :: Id -> Name -> Id
 setIdName = setVarName
 
-setIdNoDiscard :: Id -> Id
-setIdNoDiscard id 
-  = WARN( not (isLocalId id), ppr id )
-    id { varDetails = LocalId Exported }
+setIdType :: Id -> Type -> Id
+setIdType id ty = id {idType = ty}
+
+setIdExported :: Id -> Id
+-- Can be called on GlobalIds, such as data cons and class ops,
+-- which are "born" as GlobalIds and automatically exported
+setIdExported id@(LocalId {}) = id { lclDetails = Exported }
+setIdExported other_id	      = ASSERT( isId other_id ) other_id
+
+setIdNotExported :: Id -> Id
+-- We can only do this to LocalIds
+setIdNotExported id = ASSERT( isLocalId id ) id { lclDetails = NotExported }
 
 zapSpecPragmaId :: Id -> Id
-zapSpecPragmaId id 
-  = case varDetails id of
-	LocalId SpecPragma -> id { varDetails = LocalId NotExported }
-	other		   -> id
+zapSpecPragmaId id
+  | isSpecPragmaId id = id {lclDetails = NotExported}
+  | otherwise         = id
+
+globaliseId :: GlobalIdDetails -> Id -> Id
+-- If it's a local, make it global
+globaliseId details id = GlobalId { varName    = varName id,
+				    realUnique = realUnique id,
+			   	    idType     = idType id,
+				    idInfo     = idInfo id,
+				    gblDetails = details }
 
 lazySetIdInfo :: Id -> IdInfo -> Id
-lazySetIdInfo var info = var {varInfo = info}
+lazySetIdInfo id info = id {idInfo = info}
 
 setIdInfo :: Id -> IdInfo -> Id
-setIdInfo var info = seqIdInfo info `seq` var {varInfo = info}
+setIdInfo id info = seqIdInfo info `seq` id {idInfo = info}
 	-- Try to avoid spack leaks by seq'ing
 
 modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
-modifyIdInfo fn var@(Var {varInfo = info})
-  = seqIdInfo new_info `seq` var {varInfo = new_info}
+modifyIdInfo fn id
+  = seqIdInfo new_info `seq` id {idInfo = new_info}
   where
-    new_info = fn info
+    new_info = fn (idInfo id)
 
 -- maybeModifyIdInfo tries to avoid unnecesary thrashing
 maybeModifyIdInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
-maybeModifyIdInfo fn var@(Var {varInfo = info}) = case fn info of
-							Nothing       -> var
-							Just new_info -> var {varInfo = new_info}
+maybeModifyIdInfo fn id
+  = case fn (idInfo id) of
+	Nothing       -> id
+	Just new_info -> id {idInfo = new_info}
 \end{code}
 
 %************************************************************************
@@ -291,58 +266,57 @@ maybeModifyIdInfo fn var@(Var {varInfo = info}) = case fn info of
 %************************************************************************
 
 \begin{code}
-mkId :: Name -> Type -> VarDetails -> IdInfo -> Id
-mkId name ty details info
-  = Var { varName    = name, 
-	  realUnique = getKey (nameUnique name), 	-- Cache the unique
-	  varType    = ty,	
-	  varDetails = details,
-	  varInfo    = info }
+mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
+mkGlobalId details name ty info 
+  = GlobalId {	varName    = name, 
+		realUnique = getKey# (nameUnique name), 	-- Cache the unique
+		idType     = ty,	
+		gblDetails = details,
+		idInfo     = info }
+
+mk_local_id :: Name -> Type -> LocalIdDetails -> IdInfo -> Id
+mk_local_id name ty details info
+  = LocalId {	varName    = name, 
+		realUnique = getKey# (nameUnique name), 	-- Cache the unique
+		idType     = ty,	
+		lclDetails = details,
+		idInfo     = info }
 
 mkLocalId :: Name -> Type -> IdInfo -> Id
-mkLocalId name ty info = mkId name ty (LocalId NotExported) info
+mkLocalId name ty info = mk_local_id name ty NotExported info
 
-mkSpecPragmaId :: Name -> Type -> IdInfo -> Id
-mkSpecPragmaId name ty info = mkId name ty (LocalId SpecPragma) info
+mkExportedLocalId :: Name -> Type -> IdInfo -> Id
+mkExportedLocalId name ty info = mk_local_id name ty Exported info
 
-mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
-mkGlobalId details name ty info = mkId name ty (GlobalId details) info
+mkSpecPragmaId :: Name -> Type -> IdInfo -> Id
+mkSpecPragmaId name ty info = mk_local_id name ty SpecPragma info
 \end{code}
 
 \begin{code}
-isTyVar, isMutTyVar, isSigTyVar		 :: Var -> Bool
+isTyVar, isTcTyVar			 :: Var -> Bool
 isId, isLocalVar, isLocalId    		 :: Var -> Bool
 isGlobalId, isExportedId, isSpecPragmaId :: Var -> Bool
 mustHaveLocalBinding			 :: Var -> Bool
 
-isTyVar var = case varDetails var of
-		TyVar        -> True
-		MutTyVar _ _ -> True
-		other	     -> False
-
-isMutTyVar (Var {varDetails = MutTyVar _ _}) = True
-isMutTyVar other			     = False
+isTyVar (TyVar {})   = True
+isTyVar (TcTyVar {}) = True
+isTyVar other	     = False
 
-isSigTyVar (Var {varDetails = MutTyVar _ is_sig}) = is_sig
-isSigTyVar other			          = False
+isTcTyVar (TcTyVar {}) = True
+isTcTyVar other	       = False
 
-isId var = case varDetails var of
-		LocalId _  -> True
-		GlobalId _ -> True
-		other	   -> False
+isId (LocalId {})  = True
+isId (GlobalId {}) = True
+isId other	   = False
 
-isLocalId var = case varDetails var of
-		  LocalId _  -> True
-		  other	     -> False
+isLocalId (LocalId {}) = True
+isLocalId other	       = False
 
 -- isLocalVar returns True for type variables as well as local Ids
 -- These are the variables that we need to pay attention to when finding free
 -- variables, or doing dependency analysis.
-isLocalVar var = case varDetails var of
-		    LocalId _  	 -> True
-		    TyVar      	 -> True
-		    MutTyVar _ _ -> True
-		    other	 -> False
+isLocalVar (GlobalId {}) = False 
+isLocalVar other	 = True
 
 -- mustHaveLocalBinding returns True of Ids and TyVars
 -- that must have a binding in this module.  The converse
@@ -351,29 +325,26 @@ isLocalVar var = case varDetails var of
 -- because it's only used for assertions
 mustHaveLocalBinding var = isLocalVar var
 
-isGlobalId var = case varDetails var of
-		   GlobalId _ -> True
-		   other      -> False
+isGlobalId (GlobalId {}) = True
+isGlobalId other	 = False
 
 -- isExportedId means "don't throw this away"
-isExportedId var = case varDetails var of
-			LocalId Exported   -> True
-			LocalId SpecPragma -> True
-			GlobalId _	   -> True
-			other		   -> False
-
-isSpecPragmaId var = case varDetails var of
-			LocalId SpecPragma -> True
-			other		   -> False
+isExportedId (GlobalId {}) = True
+isExportedId (LocalId {lclDetails = details}) 
+  = case details of
+	Exported   -> True
+	SpecPragma -> True
+	other	   -> False
+isExportedId other = False
+
+isSpecPragmaId (LocalId {lclDetails = SpecPragma}) = True
+isSpecPragmaId other = False
 \end{code}
 
 \begin{code}
 globalIdDetails :: Var -> GlobalIdDetails
 -- Works OK on local Ids too, returning notGlobalId
-globalIdDetails var = case varDetails var of
-			  GlobalId details -> details
-			  other		   -> notGlobalId
-setGlobalIdDetails :: Id -> GlobalIdDetails -> Id
-setGlobalIdDetails id details = id { varDetails = GlobalId details }
+globalIdDetails (GlobalId {gblDetails = details}) = details
+globalIdDetails other				  = notGlobalId
 \end{code}