X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FVar.lhs;h=a0fa92157d3d68167aae96cbc5ea838df20a284c;hp=4f1ed2e1a603f0ab73b9f710bd5103c1dc44917a;hb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;hpb=5e5310b3cb4f78e30cc7b90879eb016e97c214cb

diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs
index 4f1ed2e..a0fa921 100644
--- a/compiler/basicTypes/Var.lhs
+++ b/compiler/basicTypes/Var.lhs
@@ -25,29 +25,27 @@
 -- Global 'Id's and 'Var's are those that are imported or correspond to a data constructor, primitive operation, or record selectors.
 -- Local 'Id's and 'Var's are those bound within an expression (e.g. by a lambda) or at the top level of the module being compiled.
 module Var (
-        -- * The main data type
-	Var,
-
-	-- ** Constructing 'Var's
-	mkLocalIdVar, mkExportedLocalIdVar, mkGlobalIdVar, 
+        -- * The main data type and synonyms
+	Var, TyVar, CoVar, Id, DictId, DFunId, EvVar, EvId, IpId,
 
 	-- ** Taking 'Var's apart
-	varName, varUnique, varType, varIdInfo, globalIdVarDetails,
+	varName, varUnique, varType, 
 
 	-- ** Modifying 'Var's
 	setVarName, setVarUnique, setVarType,
-	setIdVarExported, setIdVarNotExported, 
-	globaliseIdVar, lazySetVarIdInfo,
+
+	-- ** Constructing, taking apart, modifying 'Id's
+	mkGlobalVar, mkLocalVar, mkExportedLocalVar, 
+	idInfo, idDetails,
+	lazySetIdInfo, setIdDetails, globaliseId,
+	setIdExported, setIdNotExported,
 
         -- ** Predicates
-        isCoVar, isIdVar, isTyVar, isTcTyVar,
-        isLocalVar, isLocalIdVar,
-	isGlobalIdVar, isExportedIdVar,
+        isCoVar, isId, isTyCoVar, isTyVar, isTcTyVar,
+        isLocalVar, isLocalId,
+	isGlobalId, isExportedId,
 	mustHaveLocalBinding,
 
-	-- * Type variable data type
-	TyVar,
-
 	-- ** Constructing 'TyVar's
 	mkTyVar, mkTcTyVar, mkWildCoVar,
 
@@ -57,9 +55,6 @@ module Var (
 	-- ** Modifying 'TyVar's
 	setTyVarName, setTyVarUnique, setTyVarKind,
 
-        -- * Coercion variable data type
-        CoVar,
-
         -- ** Constructing 'CoVar's
         mkCoVar,
 
@@ -67,30 +62,55 @@ module Var (
         coVarName,
 
         -- ** Modifying 'CoVar's
-        setCoVarUnique, setCoVarName,
+        setCoVarUnique, setCoVarName
 
-	-- * 'Var' type synonyms
-	Id, DictId
     ) where
 
 #include "HsVersions.h"
+#include "Typeable.h"
 
 import {-# SOURCE #-}	TypeRep( Type, Kind )
 import {-# SOURCE #-}	TcType( TcTyVarDetails, pprTcTyVarDetails )
-import {-# SOURCE #-}	IdInfo( GlobalIdDetails, notGlobalId, 
-                                IdInfo )
+import {-# SOURCE #-}	IdInfo( IdDetails, IdInfo, pprIdDetails )
 import {-# SOURCE #-}	TypeRep( isCoercionKind )
 
 import Name hiding (varName)
 import Unique
+import Util
 import FastTypes
 import FastString
 import Outputable
+
+import Data.Data
 \end{code}
 
 
 %************************************************************************
 %*									*
+                     Synonyms									
+%*									*
+%************************************************************************
+-- These synonyms are here and not in Id because otherwise we need a very
+-- large number of SOURCE imports of Id.hs :-(
+
+\begin{code}
+type EvVar = Var	-- An evidence variable: dictionary or equality constraint
+     	       		-- Could be an DictId or a CoVar
+
+type Id     = Var       -- A term-level identifier
+type DFunId = Id	-- A dictionary function
+type EvId   = Id        -- Term-level evidence: DictId or IpId
+type DictId = EvId	-- A dictionary variable
+type IpId   = EvId      -- A term-level implicit parameter
+
+type TyVar = Var
+type CoVar = TyVar	-- A coercion variable is simply a type 
+			-- variable of kind @ty1 ~ ty2@. Hence its
+			-- 'varType' is always @PredTy (EqPred t1 t2)@
+\end{code}
+
+%************************************************************************
+%*									*
 \subsection{The main data type declarations}
 %*									*
 %************************************************************************
@@ -120,25 +140,21 @@ data Var
 	varName        :: !Name,
 	realUnique     :: FastInt,
 	varType        :: Kind,
-	tcTyVarDetails :: TcTyVarDetails }
+	tc_tv_details  :: TcTyVarDetails }
 
-  | GlobalId { 			-- Used for imported Ids, dict selectors etc
- 				-- See Note [GlobalId/LocalId] below
-	varName    :: !Name,	-- Always an External or WiredIn Name
-	realUnique :: FastInt,
-   	varType    :: Type,
-	idInfo_    :: IdInfo,
-	gblDetails :: GlobalIdDetails }
-
-  | LocalId { 			-- Used for locally-defined Ids 
-				-- See Note [GlobalId/LocalId] below
+  | Id {
 	varName    :: !Name,
 	realUnique :: FastInt,
    	varType    :: Type,
-	idInfo_    :: IdInfo,
-	lclDetails :: LocalIdDetails }
+	idScope    :: IdScope,
+	id_details :: IdDetails,	-- Stable, doesn't change
+	id_info    :: IdInfo }		-- Unstable, updated by simplifier
+
+data IdScope	-- See Note [GlobalId/LocalId]
+  = GlobalId 
+  | LocalId ExportFlag
 
-data LocalIdDetails 
+data ExportFlag 
   = NotExported	-- ^ Not exported: may be discarded as dead code.
   | Exported	-- ^ Exported: kept alive
 \end{code}
@@ -162,13 +178,17 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds
 
 \begin{code}
 instance Outputable Var where
-  ppr var = ppr (varName var) <+> ifPprDebug (brackets extra)
-	where
-	  extra = case var of
-			GlobalId {} -> ptext (sLit "gid")
-			LocalId  {} -> ptext (sLit "lid")
-			TyVar    {} -> ptext (sLit "tv")
-			TcTyVar {tcTyVarDetails = details} -> pprTcTyVarDetails details
+  ppr var = ppr (varName var) <+> ifPprDebug (brackets (ppr_debug var))
+
+ppr_debug :: Var -> SDoc
+ppr_debug (TyVar {})                          = ptext (sLit "tv")
+ppr_debug (TcTyVar {tc_tv_details = d})       = pprTcTyVarDetails d
+ppr_debug (Id { idScope = s, id_details = d }) = ppr_id_scope s <> pprIdDetails d
+
+ppr_id_scope :: IdScope -> SDoc
+ppr_id_scope GlobalId              = ptext (sLit "gid")
+ppr_id_scope (LocalId Exported)    = ptext (sLit "lidx")
+ppr_id_scope (LocalId NotExported) = ptext (sLit "lid")
 
 instance Show Var where
   showsPrec p var = showsPrecSDoc p (ppr var)
@@ -188,6 +208,14 @@ instance Ord Var where
     a >= b = realUnique a >=# realUnique b
     a >	 b = realUnique a >#  realUnique b
     a `compare` b = varUnique a `compare` varUnique b
+
+INSTANCE_TYPEABLE0(Var,varTc,"Var")
+
+instance Data Var where
+  -- don't traverse?
+  toConstr _   = abstractConstr "Var"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "Var"
 \end{code}
 
 
@@ -207,33 +235,6 @@ setVarName var new_name
 
 setVarType :: Id -> Type -> Id
 setVarType id ty = id { varType = ty }
-
-setIdVarExported :: Var -> Var
--- ^ Exports the given local 'Id'. Can also be called on global 'Id's, such as data constructors
--- and class operations, which are born as global 'Id's and automatically exported
-setIdVarExported id@(LocalId {}) = id { lclDetails = Exported }
-setIdVarExported other_id	      = ASSERT( isIdVar other_id ) other_id
-
-setIdVarNotExported :: Id -> Id
--- ^ We can only do this to LocalIds
-setIdVarNotExported id = ASSERT( isLocalIdVar id ) id { lclDetails = NotExported }
-
-globaliseIdVar :: GlobalIdDetails -> Var -> Var
--- ^ If it's a local, make it global
-globaliseIdVar details id = GlobalId { varName    = varName id,
-				    realUnique = realUnique id,
-			   	    varType    = varType id,
-				    idInfo_    = varIdInfo id,
-				    gblDetails = details }
-
--- | Extract 'Id' information from the 'Var' if it represents a global or local 'Id', otherwise panic
-varIdInfo :: Var -> IdInfo
-varIdInfo (GlobalId {idInfo_ = info}) = info
-varIdInfo (LocalId  {idInfo_ = info}) = info
-varIdInfo other_var		   = pprPanic "idInfo" (ppr other_var)
-
-lazySetVarIdInfo :: Var -> IdInfo -> Var
-lazySetVarIdInfo id info = id { idInfo_ = info }
 \end{code}
 
 
@@ -244,8 +245,6 @@ lazySetVarIdInfo id info = id { idInfo_ = info }
 %************************************************************************
 
 \begin{code}
-type TyVar = Var
-
 tyVarName :: TyVar -> Name
 tyVarName = varName
 
@@ -277,8 +276,12 @@ mkTcTyVar name kind details
     TcTyVar {	varName    = name,
 		realUnique = getKeyFastInt (nameUnique name),
 		varType  = kind,
-		tcTyVarDetails = details
+		tc_tv_details = details
 	}
+
+tcTyVarDetails :: TyVar -> TcTyVarDetails
+tcTyVarDetails (TcTyVar { tc_tv_details = details }) = details
+tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var)
 \end{code}
 
 %************************************************************************
@@ -288,10 +291,6 @@ mkTcTyVar name kind details
 %************************************************************************
 
 \begin{code}
-type CoVar = TyVar -- A coercion variable is simply a type 
-			-- variable of kind @ty1 ~ ty2@. Hence its
-			-- 'varType' is always @PredTy (EqPred t1 t2)@
-
 coVarName :: CoVar -> Name
 coVarName = varName
 
@@ -322,12 +321,60 @@ mkWildCoVar = mkCoVar (mkSysTvName (mkBuiltinUnique 1) (fsLit "co_wild"))
 %************************************************************************
 
 \begin{code}
+idInfo :: Id -> IdInfo
+idInfo (Id { id_info = info }) = info
+idInfo other 	       	       = pprPanic "idInfo" (ppr other)
 
--- These synonyms are here and not in Id because otherwise we need a very
--- large number of SOURCE imports of Id.hs :-(
-type Id = Var
-type DictId = Var
+idDetails :: Id -> IdDetails
+idDetails (Id { id_details = details }) = details
+idDetails other 	       	        = pprPanic "idDetails" (ppr other)
+
+-- The next three have a 'Var' suffix even though they always build
+-- Ids, becuase Id.lhs uses 'mkGlobalId' etc with different types
+mkGlobalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
+mkGlobalVar details name ty info
+  = mk_id name ty GlobalId details info
+
+mkLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
+mkLocalVar details name ty info
+  = mk_id name ty (LocalId NotExported) details  info
+
+-- | Exported 'Var's will not be removed as dead code
+mkExportedLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
+mkExportedLocalVar details name ty info 
+  = mk_id name ty (LocalId Exported) details info
+
+mk_id :: Name -> Type -> IdScope -> IdDetails -> IdInfo -> Id
+mk_id name ty scope details info
+  = Id { varName    = name, 
+	 realUnique = getKeyFastInt (nameUnique name),
+	 varType    = ty,	
+	 idScope    = scope,
+	 id_details = details,
+	 id_info    = info }
+
+-------------------
+lazySetIdInfo :: Id -> IdInfo -> Var
+lazySetIdInfo id info = id { id_info = info }
+
+setIdDetails :: Id -> IdDetails -> Id
+setIdDetails id details = id { id_details = details }
+
+globaliseId :: Id -> Id
+-- ^ If it's a local, make it global
+globaliseId id = id { idScope = GlobalId }
 
+setIdExported :: Id -> Id
+-- ^ Exports the given local 'Id'. Can also be called on global 'Id's, such as data constructors
+-- and class operations, which are born as global 'Id's and automatically exported
+setIdExported id@(Id { idScope = LocalId {} }) = id { idScope = LocalId Exported }
+setIdExported id@(Id { idScope = GlobalId })   = id
+setIdExported tv	  	    	       = pprPanic "setIdExported" (ppr tv)
+
+setIdNotExported :: Id -> Id
+-- ^ We can only do this to LocalIds
+setIdNotExported id = ASSERT( isLocalId id ) 
+                      id { idScope = LocalId NotExported }
 \end{code}
 
 %************************************************************************
@@ -337,62 +384,41 @@ type DictId = Var
 %************************************************************************
 
 \begin{code}
--- | For an explanation of global vs. local 'Var's, see "Var#globalvslocal"
-mkGlobalIdVar :: GlobalIdDetails -> Name -> Type -> IdInfo -> Var
-mkGlobalIdVar details name ty info 
-  = GlobalId {	varName    = name, 
-		realUnique = getKeyFastInt (nameUnique name), 	-- Cache the unique
-		varType     = ty,	
-		gblDetails = details,
-		idInfo_    = info }
-
-mkLocalIdVar' :: Name -> Type -> LocalIdDetails -> IdInfo -> Var
-mkLocalIdVar' name ty details info
-  = LocalId {	varName    = name, 
-		realUnique = getKeyFastInt (nameUnique name), 	-- Cache the unique
-		varType     = ty,	
-		lclDetails = details,
-		idInfo_    = info }
-
--- | For an explanation of global vs. local 'Var's, see "Var#globalvslocal"
-mkLocalIdVar :: Name -> Type -> IdInfo -> Var
-mkLocalIdVar name ty info = mkLocalIdVar' name ty NotExported info
+isTyCoVar :: Var -> Bool	-- True of both type and coercion variables
+isTyCoVar (TyVar {})   = True
+isTyCoVar (TcTyVar {}) = True
+isTyCoVar _            = False
 
--- | Exported 'Var's will not be removed as dead code
-mkExportedLocalIdVar :: Name -> Type -> IdInfo -> Var
-mkExportedLocalIdVar name ty info = mkLocalIdVar' name ty Exported info
-\end{code}
-
-\begin{code}
-isTyVar :: Var -> Bool
-isTyVar (TyVar {})   = True
+isTyVar :: Var -> Bool		-- True of both type variables only
+isTyVar v@(TyVar {}) = not (isCoercionVar v)
 isTyVar (TcTyVar {}) = True
 isTyVar _            = False
 
+isCoVar :: Var -> Bool		-- Only works after type checking (sigh)
+isCoVar v@(TyVar {}) = isCoercionVar v
+isCoVar _            = False
+
 isTcTyVar :: Var -> Bool
 isTcTyVar (TcTyVar {}) = True
 isTcTyVar _            = False
 
-isIdVar :: Var -> Bool
-isIdVar (LocalId {})  = True
-isIdVar (GlobalId {}) = True
-isIdVar _             = False
-
-isLocalIdVar :: Var -> Bool
-isLocalIdVar (LocalId {}) = True
-isLocalIdVar _            = False
+isId :: Var -> Bool
+isId (Id {}) = True
+isId _       = False
 
-isCoVar :: Var -> Bool
-isCoVar (v@(TyVar {}))             = isCoercionVar v
-isCoVar (TcTyVar {varType = kind}) = isCoercionKind kind  -- used during solving
-isCoVar _                          = False
+isLocalId :: Var -> Bool
+isLocalId (Id { idScope = LocalId _ }) = True
+isLocalId _                            = False
 
 -- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's
 -- These are the variables that we need to pay attention to when finding free
 -- variables, or doing dependency analysis.
 isLocalVar :: Var -> Bool
-isLocalVar (GlobalId {}) = False 
-isLocalVar _             = True
+isLocalVar v = not (isGlobalId v)
+
+isGlobalId :: Var -> Bool
+isGlobalId (Id { idScope = GlobalId }) = True
+isGlobalId _                           = False
 
 -- | 'mustHaveLocalBinding' returns @True@ of 'Id's and 'TyVar's
 -- that must have a binding in this module.  The converse
@@ -402,23 +428,9 @@ isLocalVar _             = True
 mustHaveLocalBinding	    :: Var -> Bool
 mustHaveLocalBinding var = isLocalVar var
 
-isGlobalIdVar :: Var -> Bool
-isGlobalIdVar (GlobalId {}) = True
-isGlobalIdVar _             = False
-
 -- | 'isExportedIdVar' means \"don't throw this away\"
-isExportedIdVar :: Var -> Bool
-isExportedIdVar (GlobalId {}) = True
-isExportedIdVar (LocalId {lclDetails = details}) 
-  = case details of
-	Exported   -> True
-	_          -> False
-isExportedIdVar _ = False
-\end{code}
-
-\begin{code}
-globalIdVarDetails :: Var -> GlobalIdDetails
--- ^ Find the global 'Id' information if the 'Var' is a global 'Id', otherwise returns 'notGlobalId'
-globalIdVarDetails (GlobalId {gblDetails = details}) = details
-globalIdVarDetails _                                 = notGlobalId
+isExportedId :: Var -> Bool
+isExportedId (Id { idScope = GlobalId })        = True
+isExportedId (Id { idScope = LocalId Exported}) = True
+isExportedId _ = False
 \end{code}