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,
-- 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}