X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=403d309b9c306950d8298b5ce98b1da221b3e8c8;hb=4ae1e17253f4417303e46d59f5a737cc1d7fd78e;hp=42515ebe3f9b63e3a27f2b01860fc7e3975669e0;hpb=683a26900e9170ba57c561a2dc94a3a4eb38cfdf;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 42515eb..403d309 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -279,7 +279,7 @@ mkDataConIds wrap_name wkr_name data_con
 	  	   wrapNewTypeBody tycon res_ty_args
                        (Var id_arg1)
 
-    id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
+    id_arg1 = ASSERT( not (null orig_arg_tys) ) mkTemplateLocal 1 (head orig_arg_tys)
 
 	----------- Wrapper --------------
 	-- We used to include the stupid theta in the wrapper's args
@@ -478,7 +478,8 @@ mkRecordSelId tycon field_label
   | otherwise  = sel_id
   where
     is_naughty = not (tyVarsOfType field_ty `subVarSet` data_tv_set)
-    sel_id_details = RecordSelId tycon field_label is_naughty
+    sel_id_details = RecordSelId { sel_tycon = tycon, sel_label = field_label, sel_naughty = is_naughty }
+	-- For a data type family, the tycon is the *instance* TyCon
 
     -- Escapist case here for naughty constructors
     -- We give it no IdInfo, and a type of forall a.a (never looked at)
@@ -491,8 +492,10 @@ mkRecordSelId tycon field_label
     data_cons_w_field = filter has_field data_cons	-- Can't be empty!
     has_field con     = field_label `elem` dataConFieldLabels con
 
-    con1	= head data_cons_w_field
+    con1	= ASSERT( not (null data_cons_w_field) ) head data_cons_w_field
     (univ_tvs, _, eq_spec, _, _, data_ty) = dataConFullSig con1
+	-- For a data type family, the data_ty (and hence selector_ty) mentions
+	-- only the family TyCon, not the instance TyCon
     data_tv_set	= tyVarsOfType data_ty
     data_tvs	= varSetElems data_tv_set
     field_ty	= dataConFieldType con1 field_label