From: sof <unknown>
Date: Fri, 14 Aug 1998 11:17:28 +0000 (+0000)
Subject: [project @ 1998-08-14 11:17:28 by sof]
X-Git-Tag: Approx_2487_patches~422
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=336989ca0004d47dcdf9dbb08989ef6be0a23008;hp=c9ebf62fd1e19d1937a6ca541ad330892fea21a9;p=ghc-hetmet.git

[project @ 1998-08-14 11:17:28 by sof]
Export tcPolyExpr
---

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