From: sewardj <unknown>
Date: Fri, 13 Oct 2000 14:14:32 +0000 (+0000)
Subject: [project @ 2000-10-13 14:14:31 by sewardj]
X-Git-Tag: Approximately_9120_patches~3588
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=064a65d90058bbb5f48e311649a1211a32ad891d;p=ghc-hetmet.git

[project @ 2000-10-13 14:14:31 by sewardj]
Fix some typechecker bits.
---

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index ebe0aac..cb91e51 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -7,7 +7,8 @@
 module HscTypes ( TyThing(..), GlobalSymbolTable, OrigNameEnv, AvailEnv,
 		  WhetherHasOrphans, ImportVersion, ExportItem,
 		  PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
-		  IfaceInsts, IfaceRules, DeprecationEnv )
+		  IfaceInsts, IfaceRules, DeprecationEnv, ModDetails(..),
+		  InstEnv, lookupTypeEnv )
 where
 
 #include "HsVersions.h"
@@ -38,7 +39,8 @@ import CoreSyn		( CoreRule )
 import NameSet		( NameSet )
 import Type		( Type )
 import VarSet		( TyVarSet )
-import {-# SOURCE #-} TcInstUtil ( emptyInstEnv )
+import {-# SOURCE #-} 
+       TcInstUtil ( emptyInstEnv )
 import Panic		( panic )
 \end{code}
 
diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 13ce1ef..e106cba 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -12,7 +12,8 @@ module TcEnv(
 
 	-- Global environment
 	tcExtendGlobalEnv, tcExtendGlobalValEnv, 
-	tcLookupTy, tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
+	tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
+	tcLookupGlobal_maybe,
 
 	-- Local environment
 	tcExtendKindEnv, 
@@ -55,14 +56,15 @@ import Class	( Class, ClassOpItem, ClassContext, classTyCon )
 import Subst	( substTy )
 import Name	( Name, OccName, Provenance(..), ExportFlag(..), NamedThing(..), 
 		  nameOccName, nameModule, getSrcLoc, mkGlobalName,
-		  maybeWiredInTyConName, maybeWiredInIdName, isLocallyDefined,
+		  isLocallyDefined,
 		  NameEnv, emptyNameEnv, lookupNameEnv, nameEnvElts, 
 		  extendNameEnv, extendNameEnvList
 		)
 import OccName	( mkDFunOcc, mkDefaultMethodOcc, occNameString )
 import Module	( Module )
 import Unify	( unifyTyListsX, matchTys )
-import HscTypes	( ModDetails(..), InstEnv, lookupTypeEnv )
+import HscTypes	( ModDetails(..), InstEnv, lookupTypeEnv, TyThing(..),
+		  GlobalSymbolTable )
 import Unique	( pprUnique10, Unique, Uniquable(..) )
 import UniqFM
 import Unique	( Uniquable(..) )
@@ -71,6 +73,7 @@ import SrcLoc	( SrcLoc )
 import FastString	( FastString )
 import Maybes
 import Outputable
+import IOExts	( newIORef )
 \end{code}
 
 %************************************************************************
@@ -140,7 +143,7 @@ data TcTyThing
 
 initTcEnv :: GlobalSymbolTable -> InstEnv -> IO TcEnv
 initTcEnv gst inst_env
-  = do { gtv_var <- newIORef emptyVarSet
+  = do { gtv_var <- newIORef emptyVarSet ;
 	 return (TcEnv { tcGST    = gst,
 		      	 tcGEnv   = emptyNameEnv,
 		      	 tcInsts  = inst_env,
@@ -182,7 +185,7 @@ lookup_local env name
   = case lookupNameEnv (tcLEnv env) name of
 	Just thing -> Just thing
 	Nothing    -> case lookup_global env name of
-			Just thing -> AGlobal thing
+			Just thing -> Just (AGlobal thing)
 			Nothing	   -> Nothing
 
 explicitLookupId :: TcEnv -> Name -> Maybe Id
@@ -308,6 +311,7 @@ A variety of global lookups, when we know what we are looking for.
 
 \begin{code}
 tcLookupGlobal :: Name -> NF_TcM TyThing
+tcLookupGlobal name
   = tcLookupGlobal_maybe name	`thenNF_Tc` \ maybe_thing ->
     case maybe_thing of
 	Just thing -> returnNF_Tc thing
@@ -317,7 +321,7 @@ tcLookupGlobalId :: Name -> NF_TcM Id
 tcLookupGlobalId name
   = tcLookupGlobal_maybe name	`thenNF_Tc` \ maybe_id ->
     case maybe_id of
-	Just (AnId clas) -> returnNF_Tc id
+	Just (AnId clas) -> returnNF_Tc clas
 	other		 -> notFound "tcLookupGlobalId:" name
 	
 tcLookupDataCon :: Name -> TcM DataCon
diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index 1bcdd73..9dc5fca 100644
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -41,7 +41,7 @@ import HsSyn	-- oodles of it
 -- others:
 import Id	( idName, idType, idUnfolding, setIdType, omitIfaceSigForId, isIP, Id )
 import DataCon	( dataConWrapId )	
-import TcEnv	( tcLookupGlobal_maybe, tcExtendGlobalValEnv, tcGetEnv,
+import TcEnv	( tcLookupGlobal_maybe, tcExtendGlobalValEnv,
 		  TcEnv, TcId, tcInstId
 		)
 
@@ -54,6 +54,7 @@ import CoreUnfold( unfoldingTemplate )
 import BasicTypes ( RecFlag(..) )
 import Bag
 import Outputable
+import HscTypes	( TyThing(..) )
 \end{code}