X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=229d39047350cec9327d872e62da4c9a0dd8bbb6;hb=29969878d9e3f50633e4ae03cc8fab48d60af528;hp=bcfd33d3516625172e6ed91af804e71f0e39d75c;hpb=55710e16202e985f8e4f910a09dfc2d0298ca255;p=ghc-hetmet.git diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index bcfd33d..229d390 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -21,6 +21,7 @@ module MkId ( mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId, mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody, + wrapFamInstBody, unwrapFamInstScrut, mkUnpackCase, mkProductBox, -- And some particular Ids; see below for why they are wired in @@ -72,7 +73,7 @@ import Outputable import FastString import ListSetOps import Module -\end{code} +\end{code} %************************************************************************ %* * @@ -211,7 +212,6 @@ Now we want mkDataConIds :: Name -> Name -> DataCon -> DataConIds mkDataConIds wrap_name wkr_name data_con | isNewTyCon tycon -- Newtype, only has a worker - , not (isFamInstTyCon tycon) -- unless it's a family instancex = DCIds Nothing nt_work_id | any isMarkedStrict all_strict_marks -- Algebraic, needs wrapper @@ -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 @@ -492,7 +492,7 @@ 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