[project @ 2000-11-06 08:15:20 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcIfaceSig.lhs

diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index f1a747f..ed543f6 100644 (file)
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -8,16 +8,16 @@ module TcIfaceSig ( tcInterfaceSigs, tcVar, tcCoreExpr, tcCoreLamBndrs ) where
 
 #include "HsVersions.h"
 
-import HsSyn           ( HsDecl(..), IfaceSig(..), HsTupCon(..) )
+import HsSyn           ( HsDecl(..), TyClDecl(..), HsTupCon(..) )
 import TcMonad
 import TcMonoType      ( tcHsType )
                                -- NB: all the tyars in interface files are kinded,
                                -- so tcHsType will do the Right Thing without
                                -- having to mess about with zonking
 
-import TcEnv           ( TcEnv, tcExtendTyVarEnv, 
+import TcEnv           ( TcEnv, RecTcEnv, tcExtendTyVarEnv, 
                          tcExtendGlobalValEnv, tcSetEnv,
-                         tcLookupGlobal_maybe, explicitLookupId, tcEnvIds
+                         tcLookupGlobal_maybe, tcLookupRecId, tcEnvIds
                        )
 
 import RnHsSyn         ( RenamedHsDecl )
@@ -51,16 +51,18 @@ As always, we do not have to worry about user-pragmas in interface
 signatures.
 
 \begin{code}
-tcInterfaceSigs :: TcEnv               -- Envt to use when checking unfoldings
+tcInterfaceSigs :: RecTcEnv            -- Envt to use when checking unfoldings
                -> [RenamedHsDecl]      -- Ignore non-sig-decls in these decls
                -> TcM [Id]
                
 
 tcInterfaceSigs unf_env decls
   = listTc [ do_one name ty id_infos src_loc
-          | SigD (IfaceSig name ty id_infos src_loc) <- decls]
+          | TyClD (IfaceSig name ty id_infos src_loc) <- decls]
   where
-    in_scope_vars = filter isLocallyDefined (tcEnvIds unf_env)
+    in_scope_vars = [] -- I think this will be OK
+                       -- If so, don't pass it around
+                       -- Was: filter isLocallyDefined (tcEnvIds unf_env)
 
     do_one name ty id_infos src_loc
       = tcAddSrcLoc src_loc                            $       
@@ -108,11 +110,11 @@ tcWorkerInfo unf_env ty info worker_name
   = uniqSMToTcM (mkWrapper ty arity demands res_bot cpr_info) `thenNF_Tc` \ wrap_fn ->
     let
        -- Watch out! We can't pull on unf_env too eagerly!
-       info' = case explicitLookupId unf_env worker_name of
-                       Just worker_id -> info `setUnfoldingInfo`  mkTopUnfolding (wrap_fn worker_id)
-                                               `setWorkerInfo`     HasWorker worker_id arity
+       info' = case tcLookupRecId unf_env worker_name of
+                 Just worker_id -> info `setUnfoldingInfo`  mkTopUnfolding (wrap_fn worker_id)
+                                         `setWorkerInfo`     HasWorker worker_id arity
 
-                       Nothing        -> pprTrace "tcWorkerInfo failed:" (ppr worker_name) info
+                 Nothing        -> pprTrace "tcWorkerInfo failed:" (ppr worker_name) info
     in
     returnTc info'
   where
@@ -143,7 +145,7 @@ tcPragExpr unf_env name in_scope_vars expr
   where
     doc = text "unfolding of" <+> ppr name
 
-tcDelay :: TcEnv -> SDoc -> TcM a -> NF_TcM (Maybe a)
+tcDelay :: RecTcEnv -> SDoc -> TcM a -> NF_TcM (Maybe a)
 tcDelay unf_env doc thing_inside
   = forkNF_Tc (
        recoverNF_Tc bad_value (
@@ -257,9 +259,6 @@ tcCoreExpr (UfNote note expr)
        UfInlineCall   -> returnTc (Note InlineCall expr')
        UfInlineMe     -> returnTc (Note InlineMe   expr')
        UfSCC cc       -> returnTc (Note (SCC cc)   expr')
-
-tcCoreNote (UfSCC cc)   = returnTc (SCC cc)
-tcCoreNote UfInlineCall = returnTc InlineCall 
 \end{code}
 
 \begin{code}