From: Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Date: Wed, 20 Sep 2006 18:16:42 +0000 (+0000)
Subject: Fix assertion and default case for GADT record selectors
X-Git-Tag: After_FC_branch_merge~55
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=37a594c2ef06b4655444e2e5a1b0fb386ff9f950

Fix assertion and default case for GADT record selectors
Mon Sep 18 17:16:10 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Fix assertion and default case for GADT record selectors
  Sun Aug  6 20:53:39 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * Fix assertion and default case for GADT record selectors
    Wed Aug  2 11:04:21 EDT 2006  kevind@bu.edu
---

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 6c9029c..fdc4300 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -551,7 +551,7 @@ mkRecordSelId tycon field_label
 	--	foo = /\a. \t:T. case t of { MkT f -> f a }
 
     mk_alt data_con 
-      =   ASSERT2( res_ty `tcEqType` field_tau, ppr data_con $$ ppr res_ty $$ ppr field_tau )
+      =   ASSERT2( res_ty `tcEqType` field_ty, ppr data_con $$ ppr res_ty $$ ppr field_ty )
 	  mkReboxingAlt rebox_uniqs data_con (ex_tvs ++ co_tvs ++ arg_vs) rhs
       where
            -- get pattern binders with types appropriately instantiated
@@ -581,7 +581,7 @@ mkRecordSelId tycon field_label
     	the_arg_id  = assoc "mkRecordSelId:mk_alt" (field_lbls `zip` field_vs) field_label
     	field_lbls  = dataConFieldLabels data_con
 
-    error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
+    error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_ty full_msg
     full_msg   = showSDoc (sep [text "No match in record selector", ppr sel_id])
 
 -- unbox a product type...