X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcModule.lhs;h=9a747c143ee79bb19d1d2d29246780f197684d2e;hb=4166dff80e8ec94022a040318ff2759913fbbe06;hp=463964b64a8cdca94d005842a2413d2918f1a277;hpb=e5ed694b59d3f4debdf86ab44e656568ecec39c9;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 463964b..9a747c1 100644
--- 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)