[project @ 2000-10-13 14:14:31 by sewardj]
authorsewardj <unknown>
Fri, 13 Oct 2000 14:14:32 +0000 (14:14 +0000)
committersewardj <unknown>
Fri, 13 Oct 2000 14:14:32 +0000 (14:14 +0000)
Fix some typechecker bits.

ghc/compiler/main/HscTypes.lhs
ghc/compiler/typecheck/TcEnv.lhs
ghc/compiler/typecheck/TcHsSyn.lhs

index ebe0aac..cb91e51 100644 (file)
@@ -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}
 
index 13ce1ef..e106cba 100644 (file)
@@ -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
index 1bcdd73..9dc5fca 100644 (file)
@@ -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}