[project @ 2001-09-26 16:19:28 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 03f953f..53fff48 100644 (file)
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -6,6 +6,7 @@
 \begin{code}
 module TcModule (
        typecheckModule, typecheckIface, typecheckStmt, typecheckExpr,
+       typecheckExtraDecls,
        TcResults(..)
     ) where
 
@@ -289,6 +290,33 @@ typecheckExpr dflags pcs hst ic_type_env unqual this_mod (expr, decls)
 
 %************************************************************************
 %*                                                                     *
+\subsection{Typechecking extra declarations}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+typecheckExtraDecls 
+   :: DynFlags
+   -> PersistentCompilerState
+   -> HomeSymbolTable
+   -> PrintUnqualified    -- For error printing
+   -> Module              -- Is this really needed
+   -> [RenamedHsDecl]     -- extra decls sucked in from interface files
+   -> IO (Maybe PersistentCompilerState)
+
+typecheckExtraDecls  dflags pcs hst unqual this_mod decls
+ = typecheck dflags pcs hst unqual $
+     fixTc (\ ~(unf_env, _, _, _, _) ->
+         tcImports unf_env pcs hst get_fixity this_mod decls
+     ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
+     ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
+     returnTc new_pcs
+ where
+    get_fixity n = pprPanic "typecheckExpr" (ppr n)
+\end{code}
+
+%************************************************************************
+%*                                                                     *
 \subsection{Typechecking a module}
 %*                                                                     *
 %************************************************************************
@@ -552,7 +580,7 @@ tcImports unf_env pcs hst get_fixity this_mod decls
     tcExtendGlobalValEnv sig_ids               $
     
     
-    tcIfaceRules (pcs_rules pcs) this_mod iface_rules  `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
+    tcIfaceRules unf_env (pcs_rules pcs) this_mod iface_rules  `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
        -- When relinking this module from its interface-file decls
        -- we'll have IfaceRules that are in fact local to this module
        -- That's the reason we we get any local_rules out here