[project @ 2000-11-24 09:51:38 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 463964b..9a747c1 100644 (file)
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -18,12 +18,13 @@ import HsTypes              ( toHsType )
 import RnHsSyn         ( RenamedHsBinds, RenamedHsDecl, RenamedHsExpr )
 import TcHsSyn         ( TypecheckedMonoBinds, TypecheckedHsExpr,
                          TypecheckedForeignDecl, TypecheckedRuleDecl,
-                         zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet
+                         zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet,
+                         zonkExpr
                        )
 
 
 import TcMonad
-import TcType          ( newTyVarTy )
+import TcType          ( newTyVarTy, zonkTcType )
 import Inst            ( plusLIE )
 import TcBinds         ( tcTopBinds )
 import TcClassDcl      ( tcClassDecls2 )
@@ -107,7 +108,7 @@ typecheckExpr :: DynFlags
              -> Module
              -> (RenamedHsExpr,        -- The expression itself
                  [RenamedHsDecl])      -- Plus extra decls it sucked in from interface files
-             -> IO (Maybe (PersistentCompilerState, TypecheckedHsExpr))
+             -> IO (Maybe (PersistentCompilerState, TypecheckedHsExpr, TcType))
 
 typecheckExpr dflags pcs hst unqual this_mod (expr, decls)
   = typecheck dflags pcs hst unqual $
@@ -121,7 +122,10 @@ typecheckExpr dflags pcs hst unqual this_mod (expr, decls)
     newTyVarTy openTypeKind    `thenTc` \ ty ->
     tcMonoExpr expr ty         `thenTc` \ (expr', lie) ->
     tcSimplifyTop lie          `thenTc` \ binds ->
-    returnTc (new_pcs, mkHsLet binds expr') 
+    let all_expr = mkHsLet binds expr' in
+    zonkExpr all_expr          `thenNF_Tc` \ zonked_expr ->
+    zonkTcType ty              `thenNF_Tc` \ zonked_ty ->
+    returnTc (new_pcs, zonked_expr, zonked_ty) 
   where
     get_fixity :: Name -> Maybe Fixity
     get_fixity n = pprPanic "typecheckExpr" (ppr n)