X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;fp=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=7b1d5a60c38fc0b95e8c6e0284f8eed5956dfb2c;hp=b9f7913d44f0fe08e29685fc38bf31d0f44488c4;hb=d76d9636aeebe933d160157331b8c8c0087e73ac;hpb=4ac2bb39dffb4b825ece73b349ff0d56d79092d7

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index b9f7913..7b1d5a6 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -1269,11 +1269,25 @@ tcGhciStmts stmts
 	let {
 	    ret_ty    = mkListTy unitTy ;
 	    io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
-	    tc_io_stmts stmts = tcStmts GhciStmt tcDoStmt stmts io_ret_ty ;
-
+	    tc_io_stmts stmts = tcStmtsAndThen GhciStmt tcDoStmt stmts io_ret_ty ;
 	    names = collectLStmtsBinders stmts ;
+	 } ;
+
+	-- OK, we're ready to typecheck the stmts
+	traceTc "TcRnDriver.tcGhciStmts: tc stmts" empty ;
+	((tc_stmts, ids), lie) <- captureConstraints $ 
+                                  tc_io_stmts stmts  $ \ _ ->
+                           	  mapM tcLookupId names  ;
+			-- Look up the names right in the middle,
+			-- where they will all be in scope
 
-		-- mk_return builds the expression
+	-- Simplify the context
+	traceTc "TcRnDriver.tcGhciStmts: simplify ctxt" empty ;
+	const_binds <- checkNoErrs (simplifyInteractive lie) ;
+		-- checkNoErrs ensures that the plan fails if context redn fails
+
+	traceTc "TcRnDriver.tcGhciStmts: done" empty ;
+        let {   -- mk_return builds the expression
 		--	returnIO @ [()] [coerce () x, ..,  coerce () z]
 		--
 		-- Despite the inconvenience of building the type applications etc,
@@ -1284,27 +1298,14 @@ tcGhciStmts stmts
 		-- then the type checker would instantiate x..z, and we wouldn't
 		-- get their *polymorphic* values.  (And we'd get ambiguity errs
 		-- if they were overloaded, since they aren't applied to anything.)
-	    mk_return ids = nlHsApp (nlHsTyApp ret_id [ret_ty]) 
-			 	    (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
+	    ret_expr = nlHsApp (nlHsTyApp ret_id [ret_ty]) 
+		       (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
 	    mk_item id = nlHsApp (nlHsTyApp unsafeCoerceId [idType id, unitTy])
-		    	         (nlHsVar id) 
-	 } ;
-
-	-- OK, we're ready to typecheck the stmts
-	traceTc "TcRnDriver.tcGhciStmts: tc stmts" empty ;
-	((tc_stmts, ids), lie) <- captureConstraints $ tc_io_stmts stmts $ \ _ ->
-					   mapM tcLookupId names ;
-					-- Look up the names right in the middle,
-					-- where they will all be in scope
-
-	-- Simplify the context
-	traceTc "TcRnDriver.tcGhciStmts: simplify ctxt" empty ;
-	const_binds <- checkNoErrs (simplifyInteractive lie) ;
-		-- checkNoErrs ensures that the plan fails if context redn fails
-
-	traceTc "TcRnDriver.tcGhciStmts: done" empty ;
+		    	         (nlHsVar id) ;
+	    stmts = tc_stmts ++ [noLoc (mkLastStmt ret_expr)]
+        } ;
 	return (ids, mkHsDictLet (EvBinds const_binds) $
-		     noLoc (HsDo GhciStmt tc_stmts (mk_return ids) noSyntaxExpr io_ret_ty))
+		     noLoc (HsDo GhciStmt stmts io_ret_ty))
     }
 \end{code}