X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FVar.lhs;h=df030e220d696890864131585fbe5daf9c18fab9;hb=f714e6b642fd614a9971717045ae47c3d871275e;hp=fb760e6fcaa0db31ab044a0151f24ae81a637bd5;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
index fb760e6..df030e2 100644
--- a/ghc/compiler/basicTypes/Var.lhs
+++ b/ghc/compiler/basicTypes/Var.lhs
@@ -1,47 +1,54 @@
-
+%
 % (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,
-
+	Var, 
+	varName, varUnique, 
+	setVarName, setVarUnique, setVarOcc,
 
 	-- TyVars
-	TyVar, GenTyVar,
+	TyVar, mkTyVar, mkTcTyVar,
 	tyVarName, tyVarKind,
-	tyVarFlexi, setTyVarFlexi, removeTyVarFlexi, setTyVarName, setTyVarUnique,
-	mkFlexiTyVar, mkTyVar, mkSysTyVar, isTyVar, isFlexiTyVar,
+	setTyVarName, setTyVarUnique,
+	tcTyVarRef, tcTyVarDetails,
 
 	-- Ids
-	Id, DictId, GenId,
-	idName, idType, idUnique, idInfo, modifyIdInfo,
-	setIdName, setIdUnique, setIdInfo,
-	mkId, isId, externallyVisibleId
+	Id, DictId,
+	idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
+	setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, 
+	setIdLocalExported, zapSpecPragmaId,
+
+	globalIdDetails, setGlobalIdDetails, 
+
+	mkLocalId, mkExportedLocalId, mkSpecPragmaId,
+	mkGlobalId, 
+
+	isTyVar, isTcTyVar, isId, isLocalVar, isLocalId,
+	isGlobalId, isExportedId, isSpecPragmaId,
+	mustHaveLocalBinding
     ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}	Type( GenType, Kind )
-import {-# SOURCE #-}	IdInfo( IdInfo )
-import {-# SOURCE #-}	Const( Con )
+import {-# SOURCE #-}	TypeRep( Type )
+import {-# SOURCE #-}	TcType( TyVarDetails )
+import {-# SOURCE #-}	IdInfo( GlobalIdDetails, notGlobalId,
+				IdInfo, seqIdInfo )
 
-import FieldLabel	( FieldLabel )
-import Unique		( Unique, Uniquable(..), mkUniqueGrimily, getKey )
-import Name		( Name, NamedThing(..),
-			  changeUnique, nameUnique, 
-			  mkSysLocalName, isExternallyVisibleName
+import Name		( Name, OccName, NamedThing(..),
+			  setNameUnique, setNameOcc, nameUnique
 			)
-import BasicTypes	( Unused )
+import Kind		( Kind )
+import Unique		( Unique, Uniquable(..), mkUniqueGrimily, getKey# )
+import FastTypes
 import Outputable
+import DATA_IOREF
 \end{code}
 
 
-
 %************************************************************************
 %*									*
 \subsection{The main data type declarations}
@@ -55,46 +62,74 @@ strictness).  The essential info about different kinds of @Vars@ is
 in its @VarDetails@.
 
 \begin{code}
-type IdOrTyVar = Var Unused Unused 
-
-data Var flex_self flex_ty 
-  = Var {
-	varName    :: Name,
-	realUnique :: Int#,		-- Key for fast comparison
+data Var
+  = TyVar {
+	varName    :: !Name,
+	realUnique :: FastInt,		-- Key for fast comparison
 					-- Identical to the Unique in the name,
 					-- cached here for speed
-	varType    :: GenType flex_ty,
-	varDetails :: VarDetails flex_self,
-	varInfo    :: IdInfo		-- Only used for Ids at the moment
-    }
-
-varUnique Var{realUnique = uniq} = mkUniqueGrimily uniq
-
-data VarDetails flex_self
-  = TyVar
-  | FlexiTyVar flex_self	-- Used during unification
-  | 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
+	tyVarKind :: Kind }
+
+  | TcTyVar { 			-- Used only during type inference
+	varName        :: !Name,	-- Could we get away without a Name?
+	realUnique     :: FastInt,
+	tyVarKind      :: Kind,
+	tcTyVarRef     :: IORef (Maybe Type),
+	tcTyVarDetails :: TyVarDetails }
+
+  | 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
 \end{code}
 
+LocalId and GlobalId
+~~~~~~~~~~~~~~~~~~~~
+A GlobalId is
+  * always a constant (top-level)
+  * imported, or data constructor, or primop, or record selector
+  * has a Unique that is globally unique across the whole
+    GHC invocation (a single invocation may compile multiple modules)
+
+A LocalId is 
+  * bound within an expression (lambda, case, local let(rec))
+  * or defined at top level in the module being compiled
+
+After CoreTidy, top-level LocalIds are turned into GlobalIds
+ 
+
 \begin{code}
-instance Outputable (Var fs ft) where
+instance Outputable Var where
   ppr var = ppr (varName var)
 
-instance Show (Var fs ft) where
+instance Show Var where
   showsPrec p var = showsPrecSDoc p (ppr var)
 
-instance NamedThing (Var fs ft) where
+instance NamedThing Var where
   getName = varName
 
-instance Uniquable (Var fs ft) where
+instance Uniquable Var where
   getUnique = varUnique
 
-instance Eq (Var fs ft) where
+instance Eq Var where
     a == b = realUnique a ==# realUnique b
 
-instance Ord (Var fs ft) where
+instance Ord Var where
     a <= b = realUnique a <=# realUnique b
     a <	 b = realUnique a <#  realUnique b
     a >= b = realUnique a >=# realUnique b
@@ -104,16 +139,22 @@ instance Ord (Var fs ft) where
 
 
 \begin{code}
-setVarUnique :: Var fs ft -> Unique -> Var fs ft
-setVarUnique var uniq = var {realUnique = getKey uniq, 
-			     varName = changeUnique (varName var) uniq}
+varUnique :: Var -> Unique
+varUnique var = mkUniqueGrimily (iBox (realUnique var))
+
+setVarUnique :: Var -> Unique -> Var
+setVarUnique var uniq 
+  = var { realUnique = getKey# uniq, 
+	  varName = setNameUnique (varName var) uniq }
 
-setVarName :: Var fs ft -> Name -> Var fs ft
+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 }
 
-setVarType :: Var flex_self flex_ty1 -> GenType flex_ty2 -> Var flex_self flex_ty2
-setVarType var ty = var {varType = ty}
+setVarOcc :: Var -> OccName -> Var
+setVarOcc var new_occ
+  = var { varName = setNameOcc (varName var) new_occ }
 \end{code}
 
 
@@ -124,58 +165,29 @@ setVarType var ty = var {varType = ty}
 %************************************************************************
 
 \begin{code}
-type GenTyVar flex_self = Var flex_self Unused		-- Perhaps a mutable tyvar, but 
-							-- with a fixed Kind
+type TyVar = Var
 
-type TyVar		= GenTyVar Unused		-- NOt even mutable
-\end{code}
-
-\begin{code}
 tyVarName = varName
-tyVarKind = varType
 
 setTyVarUnique = setVarUnique
 setTyVarName   = setVarName
-
-tyVarFlexi :: GenTyVar flexi -> flexi
-tyVarFlexi (Var {varDetails = FlexiTyVar flex}) = flex
-tyVarFlexi other_var        = pprPanic "tyVarFlexi" (ppr other_var)
-
-setTyVarFlexi :: GenTyVar flexi1 -> flexi2 -> GenTyVar flexi2
-setTyVarFlexi var flex = var {varDetails = FlexiTyVar flex}
-
-removeTyVarFlexi :: GenTyVar flexi1 -> GenTyVar flexi2
-removeTyVarFlexi var = var {varDetails = TyVar}
-\end{code}
-
-\begin{code}
-mkTyVar :: Name -> Kind -> GenTyVar flexi
-mkTyVar name kind = Var { varName = name, realUnique = getKey (nameUnique name),
-			  varType = kind, varDetails = TyVar }
-
-mkSysTyVar :: Unique -> Kind -> GenTyVar flexi
-mkSysTyVar uniq kind = Var { varName = name, realUnique = getKey uniq,
-			     varType = kind, varDetails = TyVar }
-		     where
-		       name = mkSysLocalName uniq
-
-mkFlexiTyVar :: Name -> Kind -> flexi -> GenTyVar flexi
-mkFlexiTyVar name kind flex = Var { varName = name, 
-				    realUnique = getKey (nameUnique name),
-			            varType = kind, 
-				    varDetails = FlexiTyVar flex }
 \end{code}
 
 \begin{code}
-isTyVar :: Var fs ft -> Bool
-isTyVar (Var {varDetails = details}) = case details of
-					TyVar        -> True
-					FlexiTyVar _ -> True
-					other	     -> False
-
-isFlexiTyVar :: Var fs ft -> Bool
-isFlexiTyVar (Var {varDetails = FlexiTyVar _}) = True
-isFlexiTyVar other			       = False
+mkTyVar :: Name -> Kind -> TyVar
+mkTyVar name kind = TyVar { varName    = name
+			  , realUnique = getKey# (nameUnique name)
+			  , tyVarKind  = kind
+			}
+
+mkTcTyVar :: Name -> Kind -> TyVarDetails -> IORef (Maybe Type) -> TyVar
+mkTcTyVar name kind details ref
+  = TcTyVar {	varName    = name,
+		realUnique = getKey# (nameUnique name),
+		tyVarKind  = kind,
+		tcTyVarRef = ref,
+		tcTyVarDetails = details
+	}
 \end{code}
 
 
@@ -185,20 +197,16 @@ isFlexiTyVar 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 GenId flex_ty = Var Unused flex_ty
-type Id 	   = GenId Unused
-type DictId	   = Id
+type Id     = Var
+type DictId = Id
 \end{code}
 
 \begin{code}
 idName    = varName
-idType    = varType
 idUnique  = varUnique
-idInfo	  = varInfo
-idDetails = varDetails
 
 setIdUnique :: Id -> Unique -> Id
 setIdUnique = setVarUnique
@@ -206,41 +214,129 @@ setIdUnique = setVarUnique
 setIdName :: Id -> Name -> Id
 setIdName = setVarName
 
-setIdInfo :: GenId flexi -> IdInfo -> GenId flexi
-setIdInfo var info = var {varInfo = info}
-
-modifyIdInfo :: GenId flexi -> (IdInfo -> IdInfo) -> GenId flexi
-modifyIdInfo var@(Var {varInfo = info}) fn = var {varInfo = fn info}
+setIdType :: Id -> Type -> Id
+setIdType id ty = id {idType = ty}
+
+setIdLocalExported :: Id -> Id
+-- It had better be a LocalId already
+setIdLocalExported id = id { lclDetails = Exported }
+
+setGlobalIdDetails :: Id -> GlobalIdDetails -> Id
+-- It had better be a GlobalId already
+setGlobalIdDetails id details = id { gblDetails = details }
+
+zapSpecPragmaId :: Id -> Id
+zapSpecPragmaId id
+  | isSpecPragmaId id = id {lclDetails = NotExported}
+  | otherwise         = id
+
+lazySetIdInfo :: Id -> IdInfo -> Id
+lazySetIdInfo id info = id {idInfo = info}
+
+setIdInfo :: Id -> IdInfo -> Id
+setIdInfo id info = seqIdInfo info `seq` id {idInfo = info}
+	-- Try to avoid spack leaks by seq'ing
+
+modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
+modifyIdInfo fn id
+  = seqIdInfo new_info `seq` id {idInfo = new_info}
+  where
+    new_info = fn (idInfo id)
+
+-- maybeModifyIdInfo tries to avoid unnecesary thrashing
+maybeModifyIdInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
+maybeModifyIdInfo fn id
+  = case fn (idInfo id) of
+	Nothing       -> id
+	Just new_info -> id {idInfo = new_info}
 \end{code}
 
+%************************************************************************
+%*									*
+\subsection{Predicates over variables
+%*									*
+%************************************************************************
+
 \begin{code}
-mkId :: Name -> GenType flex_ty  -> VarDetails Unused -> IdInfo -> GenId flex_ty
-mkId name ty details info
-  = Var {varName = name, realUnique = getKey (nameUnique name), 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 = mk_local_id name ty NotExported info
+
+mkExportedLocalId :: Name -> Type -> IdInfo -> Id
+mkExportedLocalId name ty info = mk_local_id name ty Exported info
+
+mkSpecPragmaId :: Name -> Type -> IdInfo -> Id
+mkSpecPragmaId name ty info = mk_local_id name ty SpecPragma info
 \end{code}
 
 \begin{code}
-isId :: Var fs ft -> Bool
-isId (Var {varDetails = details}) = case details of
-					VanillaId     -> True
-					ConstantId _  -> True
-					RecordSelId _ -> True
-					other	      -> False
+isTyVar, isTcTyVar			 :: Var -> Bool
+isId, isLocalVar, isLocalId    		 :: Var -> Bool
+isGlobalId, isExportedId, isSpecPragmaId :: Var -> Bool
+mustHaveLocalBinding			 :: Var -> Bool
+
+isTyVar (TyVar {})   = True
+isTyVar (TcTyVar {}) = True
+isTyVar other	     = False
+
+isTcTyVar (TcTyVar {}) = True
+isTcTyVar other	       = False
+
+isId (LocalId {})  = True
+isId (GlobalId {}) = True
+isId 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 (GlobalId {}) = False 
+isLocalVar other	 = True
+
+-- mustHaveLocalBinding returns True of Ids and TyVars
+-- that must have a binding in this module.  The converse
+-- is not quite right: there are some GlobalIds that must have
+-- bindings, such as record selectors.  But that doesn't matter,
+-- because it's only used for assertions
+mustHaveLocalBinding var = isLocalVar var
+
+isGlobalId (GlobalId {}) = True
+isGlobalId other	 = False
+
+-- isExportedId means "don't throw this away"
+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}
 
-@externallyVisibleId@: is it true that another module might be
-able to ``see'' this Id in a code generation sense. That
-is, another .o file might refer to this Id.
-
-In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
-local-ness precisely so that the test here would be easy
-
-This defn appears here (rather than, say, in Id.lhs) because
-CostCentre.lhs uses it (CostCentre feeds PprType feeds Id.lhs)
-
-\end{code}
 \begin{code}
-externallyVisibleId :: Id -> Bool
-externallyVisibleId var = isExternallyVisibleName (varName var)
+globalIdDetails :: Var -> GlobalIdDetails
+-- Works OK on local Ids too, returning notGlobalId
+globalIdDetails (GlobalId {gblDetails = details}) = details
+globalIdDetails other				  = notGlobalId
 \end{code}
+