X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FVar.lhs;h=a7c4e3cf88a176ac443304667e8f10b5142af2ab;hb=76258fba6c276213d210cfa14632d8f6a9ff5062;hp=6bf3a88b0046dddcd98e2cef357dbbee07b12c23;hpb=7e602b0a11e567fcb035d1afd34015aebcf9a577;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
index 6bf3a88..a7c4e3c 100644
--- a/ghc/compiler/basicTypes/Var.lhs
+++ b/ghc/compiler/basicTypes/Var.lhs
@@ -1,50 +1,46 @@
-
+%
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section{@Vars@: Variables}
 
 \begin{code}
 module Var (
-	Var, IdOrTyVar,		-- Abstract
-	VarDetails(..), 	-- Concrete
-	varName, varUnique, varDetails, varInfo, varType,
-	setVarName, setVarUnique, setVarType,  setVarOcc,
-
+	Var, VarDetails,		-- Abstract
+	varName, varUnique, varInfo, varType,
+	setVarName, setVarUnique, setVarType, setVarOcc,
 
 	-- TyVars
 	TyVar,
 	tyVarName, tyVarKind,
 	setTyVarName, setTyVarUnique,
-	mkTyVar, mkSysTyVar, isTyVar,
-	newMutTyVar, readMutTyVar, writeMutTyVar, isMutTyVar, makeTyVarImmutable,
+	mkTyVar, mkSysTyVar, isTyVar, isSigTyVar,
+	newMutTyVar, newSigTyVar,
+	readMutTyVar, writeMutTyVar, isMutTyVar, makeTyVarImmutable,
 
 	-- Ids
 	Id, DictId,
-	idDetails, idName, idType, idUnique, idInfo, modifyIdInfo,
-	setIdName, setIdUnique, setIdInfo,
-	mkId, isId, externallyVisibleId
+	idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
+	setIdName, setIdUnique, setIdInfo, lazySetIdInfo, zapIdInfo,
+	mkIdVar, isId, externallyVisibleId
     ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}	Type( Type, Kind )
-import {-# SOURCE #-}	IdInfo( IdInfo )
-import {-# SOURCE #-}	Const( Con )
+import {-# SOURCE #-}	TypeRep( Type, Kind )
+import {-# SOURCE #-}	IdInfo( IdInfo, seqIdInfo, vanillaIdInfo )
 
-import FieldLabel	( FieldLabel )
 import Unique		( Unique, Uniquable(..), mkUniqueGrimily, getKey )
 import Name		( Name, OccName, NamedThing(..),
 			  setNameUnique, setNameOcc, nameUnique, 
 			  mkSysLocalName, isExternallyVisibleName
 			)
-import BasicTypes	( Unused )
+import FastTypes
 import Outputable
 
 import IOExts		( IORef, newIORef, readIORef, writeIORef )
 \end{code}
 
 
-
 %************************************************************************
 %*									*
 \subsection{The main data type declarations}
@@ -58,12 +54,10 @@ strictness).  The essential info about different kinds of @Vars@ is
 in its @VarDetails@.
 
 \begin{code}
-type IdOrTyVar = Var
-
 data Var
   = Var {
 	varName    :: Name,
-	realUnique :: Int#,		-- Key for fast comparison
+	realUnique :: FastInt,		-- Key for fast comparison
 					-- Identical to the Unique in the name,
 					-- cached here for speed
 	varType    :: Type,
@@ -72,11 +66,11 @@ data Var
     }
 
 data VarDetails
-  = VanillaId 				-- Most Ids are like this
-  | ConstantId Con			-- The Id for a constant (data constructor or primop)
-  | RecordSelId FieldLabel		-- The Id for a record selector
+  = AnId
   | TyVar
-  | MutTyVar (IORef (Maybe Type))	-- Used during unification
+  | 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.
@@ -114,8 +108,9 @@ varUnique :: Var -> Unique
 varUnique (Var {realUnique = uniq}) = mkUniqueGrimily uniq
 
 setVarUnique :: Var -> Unique -> Var
-setVarUnique var uniq = var {realUnique = getKey uniq, 
-			     varName = setNameUnique (varName var) uniq}
+setVarUnique var@(Var {varName = name}) uniq 
+  = var {realUnique = getKey uniq, 
+	 varName = setNameUnique name uniq}
 
 setVarName :: Var -> Name -> Var
 setVarName var new_name
@@ -150,43 +145,64 @@ setTyVarName   = setVarName
 
 \begin{code}
 mkTyVar :: Name -> Kind -> TyVar
-mkTyVar name kind = Var { varName = name, realUnique = getKey (nameUnique name),
-			  varType = kind, varDetails = TyVar }
+mkTyVar name kind = Var { varName    = name
+			, realUnique = getKey (nameUnique name)
+			, varType    = kind
+			, varDetails = TyVar
+			, varInfo    = pprPanic "mkTyVar" (ppr name)
+			}
 
 mkSysTyVar :: Unique -> Kind -> TyVar
-mkSysTyVar uniq kind = Var { varName = name, realUnique = getKey uniq,
-			     varType = kind, varDetails = 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 = 
-  do loc <- newIORef Nothing
-     return (Var { varName = name, 
-		   realUnique = getKey (nameUnique name),
-		   varType = kind, 
-		   varDetails = MutTyVar loc })
+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
+readMutTyVar (Var {varDetails = MutTyVar loc _}) = readIORef loc
 
 writeMutTyVar :: TyVar -> Maybe Type -> IO ()
-writeMutTyVar (Var {varDetails = MutTyVar loc}) val = writeIORef loc val
+writeMutTyVar (Var {varDetails = MutTyVar loc _}) val = writeIORef loc val
 
 makeTyVarImmutable :: TyVar -> TyVar
 makeTyVarImmutable tyvar = tyvar { varDetails = TyVar}
-\end{code}
 
-\begin{code}
 isTyVar :: Var -> Bool
 isTyVar (Var {varDetails = details}) = case details of
-					TyVar      -> True
-					MutTyVar _ -> True
-					other	   -> False
+					TyVar        -> True
+					MutTyVar _ _ -> True
+					other	     -> False
 
 isMutTyVar :: Var -> Bool
-isMutTyVar (Var {varDetails = MutTyVar _}) = True
-isMutTyVar other			       = False
+isMutTyVar (Var {varDetails = MutTyVar _ _}) = True
+isMutTyVar other			     = False
+
+isSigTyVar :: Var -> Bool
+isSigTyVar (Var {varDetails = MutTyVar _ is_sig}) = is_sig
+isSigTyVar other			          = False
 \end{code}
 
 
@@ -196,7 +212,7 @@ isMutTyVar other			       = False
 %*									*
 %************************************************************************
 
-	Most Id-related functions are in Id.lhs and MkId.lhs
+Most Id-related functions are in Id.lhs and MkId.lhs
 
 \begin{code}
 type Id     = Var
@@ -208,7 +224,6 @@ idName    = varName
 idType    = varType
 idUnique  = varUnique
 idInfo	  = varInfo
-idDetails = varDetails
 
 setIdUnique :: Id -> Unique -> Id
 setIdUnique = setVarUnique
@@ -216,27 +231,40 @@ setIdUnique = setVarUnique
 setIdName :: Id -> Name -> Id
 setIdName = setVarName
 
-setIdInfo :: Id -> IdInfo -> Id
-setIdInfo var info = var {varInfo = info}
+lazySetIdInfo :: Id -> IdInfo -> Id
+lazySetIdInfo var info = var {varInfo = info}
 
-modifyIdInfo :: Id -> (IdInfo -> IdInfo) -> Id
-modifyIdInfo var@(Var {varInfo = info}) fn = var {varInfo = fn info}
+setIdInfo :: Id -> IdInfo -> Id
+setIdInfo var info = seqIdInfo info `seq` var {varInfo = info}
+	-- Try to avoid spack leaks by seq'ing
+
+zapIdInfo :: Id -> Id
+zapIdInfo var = var {varInfo = vanillaIdInfo}
+
+modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
+modifyIdInfo fn var@(Var {varInfo = info})
+  = seqIdInfo new_info `seq` var {varInfo = new_info}
+  where
+    new_info = fn info
+
+-- 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}
 \end{code}
 
 \begin{code}
-mkId :: Name -> Type -> VarDetails -> IdInfo -> Id
-mkId name ty details info
+mkIdVar :: Name -> Type -> IdInfo -> Id
+mkIdVar name ty info
   = Var {varName = name, realUnique = getKey (nameUnique name), varType = ty, 
-	 varDetails = details, varInfo = info}
+	 varDetails = AnId, varInfo = info}
 \end{code}
 
 \begin{code}
 isId :: Var -> Bool
-isId (Var {varDetails = details}) = case details of
-					VanillaId     -> True
-					ConstantId _  -> True
-					RecordSelId _ -> True
-					other	      -> False
+isId (Var {varDetails = AnId}) = True
+isId other		       = False
 \end{code}
 
 @externallyVisibleId@: is it true that another module might be