X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=687f3d59187f5b40ef3c4367c32a285d8e3b51da;hb=57984dc34dcb242772bb81f1795c9afa3b7c36c1;hp=540292cbb4fe8aa8b66682a84051691c82af5d42;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 540292c..687f3d5 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -809,12 +809,12 @@ tcId :: InstOrigin
      -> BoxyRhoType				-- Result type
      -> TcM (HsExpr TcId)
 tcId orig fun_name res_ty
-  = do	{ traceTc (text "tcId" <+> ppr fun_name <+> ppr res_ty)
-	; (fun, fun_ty) <- lookupFun orig fun_name
-
+  = do	{ (fun, fun_ty) <- lookupFun orig fun_name
+        ; traceTc (text "tcId" <+> ppr fun_name <+> (ppr fun_ty $$ ppr res_ty))
+	
 	-- Split up the function type
 	; let (tv_theta_prs, fun_tau) = tcMultiSplitSigmaTy fun_ty
-	      qtvs = concatMap fst tv_theta_prs	-- Quantified tyvars
+	      qtvs = concatMap fst tv_theta_prs  	-- Quantified tyvars
 	      tau_qtvs = exactTyVarsOfType fun_tau	-- Mentioned in the tau part
 	; qtv_tys <- preSubType qtvs tau_qtvs fun_tau res_ty
 
@@ -822,6 +822,8 @@ tcId orig fun_name res_ty
 	; let res_subst = zipTopTvSubst qtvs qtv_tys
 	      fun_tau'  = substTy res_subst fun_tau
 
+        ; traceTc (text "tcId2" <+> ppr fun_name <+> (ppr qtvs $$ ppr qtv_tys))
+
 	; co_fn <- tcSubExp orig fun_tau' res_ty
 
 	-- And pack up the results
@@ -1189,9 +1191,11 @@ tcRecordBinds data_con arg_tys (HsRecFields rbinds dd)
 	do { rhs' <- tcPolyExprNC rhs field_ty
 	   ; let field_id = mkUserLocal (nameOccName field_lbl)
 				        (nameUnique field_lbl)
-					field_ty loc
-		-- The field_id has the *unique* of the selector Id
-		-- but is a LocalId with the appropriate type of the RHS
+					field_ty loc 
+		-- Yuk: the field_id has the *unique* of the selector Id
+		-- 	    (so we can find it easily)
+		--      but is a LocalId with the appropriate type of the RHS
+		--	    (so the desugarer knows the type of local binder to make)
 	   ; return (Just (fld { hsRecFieldId = L loc field_id, hsRecFieldArg = rhs' })) }
       | otherwise
       = do { addErrTc (badFieldCon data_con field_lbl)