From 336989ca0004d47dcdf9dbb08989ef6be0a23008 Mon Sep 17 00:00:00 2001 From: sof Date: Fri, 14 Aug 1998 11:17:28 +0000 Subject: [PATCH] [project @ 1998-08-14 11:17:28 by sof] Export tcPolyExpr --- ghc/compiler/typecheck/TcExpr.lhs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs index b449863..116ddb4 100644 --- a/ghc/compiler/typecheck/TcExpr.lhs +++ b/ghc/compiler/typecheck/TcExpr.lhs @@ -4,7 +4,7 @@ \section[TcExpr]{Typecheck an expression} \begin{code} -module TcExpr ( tcExpr, tcId ) where +module TcExpr ( tcExpr, tcPolyExpr, tcId ) where #include "HsVersions.h" @@ -361,14 +361,14 @@ tcMonoExpr (CCall lbl args may_gc is_asm ignored_fake_result_ty) res_ty let io_result_ty = mkTyConApp ioTyCon [result_ty] in - case tyConDataCons ioTyCon of { [ioDataCon] -> unifyTauTy res_ty io_result_ty `thenTc_` -- Construct the extra insts, which encode the -- constraints on the argument and result types. - mapNF_Tc new_arg_dict (zipEqual "tcMonoExpr:CCall" args ty_vars) `thenNF_Tc` \ ccarg_dicts_s -> - newDicts result_origin [(cReturnableClass, [result_ty])] `thenNF_Tc` \ (ccres_dict, _) -> + mapNF_Tc new_arg_dict (zipEqual "tcMonoExpr:CCall" args ty_vars) `thenNF_Tc` \ ccarg_dicts_s -> + newDicts result_origin [(cReturnableClass, [result_ty])] `thenNF_Tc` \ (ccres_dict, _) -> + case tyConDataCons ioTyCon of { [ioDataCon] -> returnTc (HsApp (HsVar (RealId ioDataCon) `TyApp` [result_ty]) (CCall lbl args' may_gc is_asm io_result_ty), -- do the wrapping in the newtype constructor here -- 1.7.10.4