X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcEnv.lhs;h=744fb42661ed9cb1298bc31abf8b2d21455d4825;hb=0a7b8d872ebf93a1bfc8f87a8a60cce0097ecfc2;hp=1f83155b6e5de03392d6ad993fd930b5aa435b9e;hpb=c7e7bc25c21e28651194d9d37a53a8820932fba7;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 1f83155..744fb42 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -5,7 +5,7 @@ module TcEnv(
 
 	-- Getting stuff from the environment
 	TcEnv, initTcEnv, 
-	tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars,
+	tcEnvTyCons, tcEnvClasses, tcEnvIds, tcLEnvElts,
 	getTcGEnv,
 	
 	-- Instance environment, and InstInfo type
@@ -16,7 +16,7 @@ module TcEnv(
 	-- Global environment
 	tcExtendGlobalEnv, tcExtendGlobalValEnv, tcExtendGlobalTypeEnv,
 	tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
-	tcLookupGlobal_maybe, tcLookupGlobal, tcLookupSyntaxId, tcLookupSyntaxName,
+	tcLookupGlobal_maybe, tcLookupGlobal, 
 
 	-- Local environment
 	tcExtendKindEnv,  tcLookupLocalIds, tcInLocalScope,
@@ -27,11 +27,10 @@ module TcEnv(
 	tcGetGlobalTyVars, tcExtendGlobalTyVars,
 
 	-- Random useful things
-	RecTcEnv, tcAddImportedIdInfo, tcLookupRecId, tcLookupRecId_maybe, 
+	RecTcEnv, tcLookupRecId, tcLookupRecId_maybe, 
 
 	-- New Ids
-	newLocalId, newSpecPragmaId,
-	newDFunName,
+	newLocalName, newDFunName,
 
 	-- Misc
 	isLocalThing, tcSetEnv
@@ -41,23 +40,20 @@ module TcEnv(
 
 import RnHsSyn		( RenamedMonoBinds, RenamedSig )
 import TcMonad
-import TcType		( TcKind,  TcType, TcTyVar, TcTyVarSet, 
-			  zonkTcTyVarsAndFV
+import TcMType		( zonkTcTyVarsAndFV )
+import TcType		( Type, ThetaType, TcKind, TcTyVar, TcTyVarSet, 
+			  tyVarsOfTypes, tcSplitDFunTy,
+			  getDFunTyKey, tcTyConAppTyCon
 			)
-import Id		( idName, mkSpecPragmaId, mkUserLocal, isDataConWrapId_maybe )
+import Id		( idName, isDataConWrapId_maybe )
 import IdInfo		( vanillaIdInfo )
 import Var		( TyVar, Id, idType, lazySetIdInfo, idInfo )
 import VarSet
-import Type		( Type, ThetaType, 
-			  tyVarsOfTypes, splitDFunTy,
-			  getDFunTyKey, tyConAppTyCon
-			)
 import DataCon		( DataCon )
 import TyCon		( TyCon )
 import Class		( Class, ClassOpItem )
-import Name		( Name, OccName, NamedThing(..), 
-			  nameOccName, getSrcLoc, mkLocalName, isLocalName,
-			  nameIsLocalOrFrom
+import Name		( Name, NamedThing(..), 
+			  getSrcLoc, mkLocalName, isLocalName, nameIsLocalOrFrom
 			)
 import NameEnv		( NameEnv, lookupNameEnv, nameEnvElts, elemNameEnv,
 			  extendNameEnvList, emptyNameEnv, plusNameEnv )
@@ -73,7 +69,6 @@ import InstEnv		( InstEnv, emptyInstEnv )
 import HscTypes		( lookupType, TyThing(..) )
 import Util		( zipEqual )
 import SrcLoc		( SrcLoc )
-import qualified PrelNames 
 import Outputable
 
 import IOExts		( newIORef )
@@ -91,8 +86,6 @@ type TcIdSet = IdSet
 
 data TcEnv
   = TcEnv {
-	tcSyntaxMap :: PrelNames.SyntaxMap,	-- The syntax map (usually the identity)
-
 	tcGST  	 :: Name -> Maybe TyThing,	-- The type environment at the moment we began this compilation
 
 	tcInsts	 :: InstEnv,		-- All instances (both imported and in this module)
@@ -135,23 +128,10 @@ used thus:
 
 
 \begin{code}
-data TcTyThing
-  = AGlobal TyThing	-- Used only in the return type of a lookup
-  | ATcId  TcId		-- Ids defined in this module
-  | ATyVar TyVar	-- Type variables
-  | AThing TcKind	-- Used temporarily, during kind checking
--- Here's an example of how the AThing guy is used
--- Suppose we are checking (forall a. T a Int):
---	1. We first bind (a -> AThink kv), where kv is a kind variable. 
---	2. Then we kind-check the (T a Int) part.
---	3. Then we zonk the kind variable.
---	4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
-
-initTcEnv :: PrelNames.SyntaxMap -> HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
-initTcEnv syntax_map hst pte 
+initTcEnv :: HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
+initTcEnv hst pte 
   = do { gtv_var <- newIORef emptyVarSet ;
-	 return (TcEnv { tcSyntaxMap = syntax_map,
-			 tcGST    = lookup,
+	 return (TcEnv { tcGST    = lookup,
 		      	 tcGEnv   = emptyNameEnv,
 		      	 tcInsts  = emptyInstEnv,
 		      	 tcLEnv   = emptyNameEnv,
@@ -165,22 +145,39 @@ initTcEnv syntax_map hst pte
 tcEnvClasses env = typeEnvClasses (tcGEnv env)
 tcEnvTyCons  env = typeEnvTyCons  (tcGEnv env) 
 tcEnvIds     env = typeEnvIds     (tcGEnv env) 
-tcEnvTyVars  env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
-tcEnvTcIds   env = [id | ATcId  id <- nameEnvElts (tcLEnv env)]
+tcLEnvElts   env = nameEnvElts (tcLEnv env)
 
 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
 
 tcInLocalScope :: TcEnv -> Name -> Bool
 tcInLocalScope env v = v `elemNameEnv` (tcLEnv env)
+\end{code}
+
+\begin{code}
+data TcTyThing
+  = AGlobal TyThing		-- Used only in the return type of a lookup
+  | ATcId   TcId		-- Ids defined in this module
+  | ATyVar  TyVar 		-- Type variables
+  | AThing  TcKind		-- Used temporarily, during kind checking
+-- Here's an example of how the AThing guy is used
+-- Suppose we are checking (forall a. T a Int):
+--	1. We first bind (a -> AThink kv), where kv is a kind variable. 
+--	2. Then we kind-check the (T a Int) part.
+--	3. Then we zonk the kind variable.
+--	4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
+
+\end{code}
+
+This data type is used to help tie the knot
+ when type checking type and class declarations
 
--- This data type is used to help tie the knot
--- when type checking type and class declarations
+\begin{code}
 data TyThingDetails = SynTyDetails Type
 		    | DataTyDetails ThetaType [DataCon] [Id]
 		    | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
+		    | ForeignTyDetails	-- Nothing yet
 \end{code}
 
-
 %************************************************************************
 %*									*
 \subsection{Basic lookups}
@@ -211,16 +208,6 @@ type RecTcEnv = TcEnv
 -- on imported things and for looking up Ids in unfoldings
 -- The environment doesn't have any local Ids in it
 
-tcAddImportedIdInfo :: RecTcEnv -> Id -> Id
-tcAddImportedIdInfo env id
-  = id `lazySetIdInfo` new_info
-	-- The Id must be returned without a data dependency on maybe_id
-  where
-    new_info = case tcLookupRecId_maybe env (idName id) of
-		  Nothing	   -> pprTrace "tcAddIdInfo" (ppr id) vanillaIdInfo
-		  Just imported_id -> idInfo imported_id
-		-- ToDo: could check that types are the same
-
 tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
 tcLookupRecId_maybe env name = case lookup_global env name of
 				   Just (AnId id) -> Just id
@@ -241,15 +228,10 @@ tcLookupRecId env name = case lookup_global env name of
 Constructing new Ids
 
 \begin{code}
-newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM TcId
-newLocalId name ty loc
+newLocalName :: Name -> NF_TcM Name
+newLocalName name	-- Make a clone
   = tcGetUnique		`thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkUserLocal name uniq ty loc)
-
-newSpecPragmaId :: Name -> TcType -> NF_TcM TcId
-newSpecPragmaId name ty 
-  = tcGetUnique		`thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
+    returnNF_Tc (mkLocalName uniq (getOccName name) (getSrcLoc name))
 \end{code}
 
 Make a name for the dict fun for an instance decl.
@@ -369,21 +351,6 @@ tcLookupLocalIds ns
     lookup lenv name = case lookupNameEnv lenv name of
 			Just (ATcId id) -> id
 			other		-> pprPanic "tcLookupLocalIds" (ppr name)
-
-tcLookupSyntaxId :: Name -> NF_TcM Id
--- Lookup a name like PrelNum.fromInt, and return the corresponding Id,
--- after mapping through the SyntaxMap.  This may give us the Id for
--- (say) MyPrelude.fromInteger
-tcLookupSyntaxId name
-  = tcGetEnv 		`thenNF_Tc` \ env ->
-    returnNF_Tc (case lookup_global env (tcSyntaxMap env name) of
-			Just (AnId id) -> id
-			other  	       -> pprPanic "tcLookupSyntaxId" (ppr name))
-
-tcLookupSyntaxName :: Name -> NF_TcM Name
-tcLookupSyntaxName name
-  = tcGetEnv 		`thenNF_Tc` \ env ->
-    returnNF_Tc (tcSyntaxMap env name)
 \end{code}
 
 
@@ -528,6 +495,12 @@ The InstInfo type summarises the information in an instance declaration
 
     instance c => k (t tvs) where b
 
+It is used just for *local* instance decls (not ones from interface files).
+But local instance decls includes
+	- derived ones
+	- generic ones
+as well as explicit user written ones.
+
 \begin{code}
 data InstInfo
   = InstInfo {
@@ -536,17 +509,22 @@ data InstInfo
       iPrags  :: [RenamedSig]		-- User pragmas recorded for generating specialised instances
     }
 
-pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
-			 nest 4 (ppr (iBinds info))]
+  | NewTypeDerived {		-- Used for deriving instances of newtypes, where the
+				-- witness dictionary is identical to the argument dictionary
+				-- Hence no bindings.
+      iDFunId :: DFunId			-- The dfun id
+    }
+
+pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
 
 simpleInstInfoTy :: InstInfo -> Type
-simpleInstInfoTy info = case splitDFunTy (idType (iDFunId info)) of
+simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
 			  (_, _, _, [ty]) -> ty
 
 simpleInstInfoTyCon :: InstInfo -> TyCon
   -- Gets the type constructor for a simple instance declaration,
   -- i.e. one of the form 	instance (...) => C (T a b c) where ...
-simpleInstInfoTyCon inst = tyConAppTyCon (simpleInstInfoTy inst)
+simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 \end{code}