X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FVar.lhs;h=89bef36a2445aef5d00bb323f77f8f982ddef297;hb=9adbdb312507dcc7d5777e36376535918549103b;hp=cacde2b61e1cc4ef804f8f4252ed567b191af470;hpb=d133b73a4d4717892ced072d05e039a54ede0ceb;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
index cacde2b..89bef36 100644
--- a/ghc/compiler/basicTypes/Var.lhs
+++ b/ghc/compiler/basicTypes/Var.lhs
@@ -5,11 +5,9 @@
 
 \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,
@@ -22,35 +20,32 @@ module Var (
         -- UVars
         UVar,
         isUVar,
-        mkUVar,
+        mkUVar, mkNamedUVar,
 
 	-- 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}
@@ -64,12 +59,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,
@@ -78,9 +71,7 @@ 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;
 	     Bool			-- True <=> this is a type signature variable, which
@@ -123,8 +114,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
@@ -163,9 +155,7 @@ mkTyVar name kind = Var { varName    = name
 			, realUnique = getKey (nameUnique name)
 			, varType    = kind
 			, varDetails = TyVar
-#ifdef DEBUG
-			, varInfo = pprPanic "mkTyVar" (ppr name)
-#endif
+			, varInfo    = pprPanic "mkTyVar" (ppr name)
 			}
 
 mkSysTyVar :: Unique -> Kind -> TyVar
@@ -173,28 +163,29 @@ mkSysTyVar uniq kind = Var { varName    = name
 			   , realUnique = getKey uniq
 			   , varType    = kind
 			   , varDetails = TyVar
-#ifdef DEBUG
-			   , varInfo = pprPanic "mkSysTyVar" (ppr name)
-#endif
+			   , 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 False})
+newMutTyVar name kind = newTyVar name kind False
 
 newSigTyVar :: Name -> Kind -> IO TyVar
-newSigTyVar name kind = 
-  do loc <- newIORef Nothing
-     return (Var { varName = name, 
-		   realUnique = getKey (nameUnique name),
-		   varType = kind, 
-		   varDetails = MutTyVar loc True})
+-- 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
@@ -233,9 +224,21 @@ type UVar = Var
 
 \begin{code}
 mkUVar :: Unique -> UVar
-mkUVar unique = Var { varName    = mkSysLocalName unique SLIT("u"),
-		      realUnique = getKey unique,
-		      varDetails = UVar }
+mkUVar unique = Var { varName    = name
+		    , realUnique = getKey unique
+		    , varDetails = UVar
+		    , varType    = pprPanic "mkUVar (varType)" (ppr name)
+		    , varInfo    = pprPanic "mkUVar (varInfo)" (ppr name)
+		    }
+	      where name = mkSysLocalName unique SLIT("u")
+
+mkNamedUVar :: Name -> UVar
+mkNamedUVar name = Var { varName    = name
+		       , realUnique = getKey (nameUnique name)
+		       , varDetails = UVar
+		       , varType    = pprPanic "mkNamedUVar (varType)" (ppr name)
+		       , varInfo    = pprPanic "mkNamedUVar (varInfo)" (ppr name)
+		       }
 \end{code}
 
 \begin{code}
@@ -264,7 +267,6 @@ idName    = varName
 idType    = varType
 idUnique  = varUnique
 idInfo	  = varInfo
-idDetails = varDetails
 
 setIdUnique :: Id -> Unique -> Id
 setIdUnique = setVarUnique
@@ -272,27 +274,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