From: simonpj@microsoft.com Date: Wed, 2 May 2007 16:34:57 +0000 (+0000) Subject: Make records work properly with type families X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=ff8e1d01524b48e028b09e2b04b2e5303cb6d95f Make records work properly with type families This fixes Trac #1204. There's quite a delicate interaction of GADTs, type families, records, and in particular record updates. Test is indexed-types/should_compile/Records.hs --- diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index a3504a6..a83d5f8 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -492,18 +492,7 @@ mkDataCon name declared_infix -- The representation tycon looks like this: -- data :R7T b c where -- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1 - - orig_res_ty - | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tycon - , let fam_subst = zipTopTvSubst (tyConTyVars tycon) res_tys - = mkTyConApp fam_tc (substTys fam_subst fam_tys) - | otherwise - = mkTyConApp tycon res_tys - where - res_tys = substTyVars (mkTopTvSubst eq_spec) univ_tvs - -- In the example above, - -- univ_tvs = [ b1, c1 ] - -- res_tys = [ b1, b1 ] + orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs) -- Representation arguments and demands -- To do: eliminate duplication with MkId @@ -645,9 +634,9 @@ dataConStupidTheta dc = dcStupidTheta dc dataConUserType :: DataCon -> Type -- The user-declared type of the data constructor -- in the nice-to-read form --- T :: forall a. a -> T [a] +-- T :: forall a b. a -> b -> T [a] -- rather than --- T :: forall b. forall a. (a=[b]) => a -> T b +-- T :: forall a c. forall b. (c=[a]) => a -> b -> T c -- NB: If the constructor is part of a data instance, the result type -- mentions the family tycon, not the internal one. dataConUserType (MkData { dcUnivTyVars = univ_tvs, @@ -756,7 +745,8 @@ splitProductType_maybe ty -- and for constructors visible -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args) where - data_con = head (tyConDataCons tycon) + data_con = ASSERT( not (null (tyConDataCons tycon)) ) + head (tyConDataCons tycon) other -> Nothing splitProductType str ty diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 42515eb..c4618ca 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -493,6 +493,8 @@ mkRecordSelId tycon field_label con1 = 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 diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 530e7d2..e56f231 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -294,17 +294,17 @@ addTickHsExpr (ExplicitTuple es box) = liftM2 ExplicitTuple (mapM (addTickLHsExpr) es) (return box) -addTickHsExpr (RecordCon id ty rec_binds) = +addTickHsExpr (RecordCon id ty rec_binds) = liftM3 RecordCon (return id) (return ty) (addTickHsRecordBinds rec_binds) -addTickHsExpr (RecordUpd e rec_binds ty1 ty2) = - liftM4 RecordUpd +addTickHsExpr (RecordUpd e rec_binds cons tys1 tys2) = + liftM5 RecordUpd (addTickLHsExpr e) (addTickHsRecordBinds rec_binds) - (return ty1) - (return ty2) + (return cons) (return tys1) (return tys2) + addTickHsExpr (ExprWithTySig {}) = error "addTickHsExpr: ExprWithTySig" addTickHsExpr (ExprWithTySigOut e ty) = liftM2 ExprWithTySigOut diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 4163559..dd433ec 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -40,7 +40,6 @@ import CostCentre import Id import PrelInfo import DataCon -import TyCon import TysWiredIn import BasicTypes import PrelNames @@ -456,70 +455,50 @@ might do some argument-evaluation first; and may have to throw away some dictionaries. \begin{code} -dsExpr (RecordUpd record_expr (HsRecordBinds []) record_in_ty record_out_ty) +dsExpr (RecordUpd record_expr (HsRecordBinds []) _ _ _) = dsLExpr record_expr -dsExpr expr@(RecordUpd record_expr (HsRecordBinds rbinds) record_in_ty record_out_ty) - = dsLExpr record_expr `thenDs` \ record_expr' -> - - -- Desugar the rbinds, and generate let-bindings if - -- necessary so that we don't lose sharing - - let - in_inst_tys = tcTyConAppArgs record_in_ty -- Newtype opaque - out_inst_tys = tcTyConAppArgs record_out_ty -- Newtype opaque - in_out_ty = mkFunTy record_in_ty record_out_ty - - mk_val_arg field old_arg_id - = case [rhs | (L _ sel_id, rhs) <- rbinds, field == idName sel_id] of - (rhs:rest) -> ASSERT(null rest) rhs - [] -> nlHsVar old_arg_id - - mk_alt con - = ASSERT( isVanillaDataCon con ) - newSysLocalsDs (dataConInstOrigArgTys con in_inst_tys) `thenDs` \ arg_ids -> - -- This call to dataConInstOrigArgTys won't work for existentials - -- but existentials don't have record types anyway - let - val_args = zipWithEqual "dsExpr:RecordUpd" mk_val_arg - (dataConFieldLabels con) arg_ids - rhs = foldl (\a b -> nlHsApp a b) - (nlHsTyApp (dataConWrapId con) out_inst_tys) - val_args - in - returnDs (mkSimpleMatch [mkPrefixConPat con (map nlVarPat arg_ids) record_in_ty] rhs) - in - -- Record stuff doesn't work for existentials +dsExpr expr@(RecordUpd record_expr (HsRecordBinds rbinds) cons_to_upd in_inst_tys out_inst_tys) + = -- Record stuff doesn't work for existentials -- The type checker checks for this, but we need -- worry only about the constructors that are to be updated - ASSERT2( all isVanillaDataCon cons_to_upd, ppr expr ) + ASSERT2( notNull cons_to_upd && all isVanillaDataCon cons_to_upd, ppr expr ) + + do { record_expr' <- dsLExpr record_expr + ; let -- Awkwardly, for families, the match goes + -- from instance type to family type + tycon = dataConTyCon (head cons_to_upd) + in_ty = mkTyConApp tycon in_inst_tys + in_out_ty = mkFunTy in_ty + (mkFamilyTyConApp tycon out_inst_tys) + + mk_val_arg field old_arg_id + = case [rhs | (L _ sel_id, rhs) <- rbinds, field == idName sel_id] of + (rhs:rest) -> ASSERT(null rest) rhs + [] -> nlHsVar old_arg_id + + mk_alt con + = ASSERT( isVanillaDataCon con ) + do { arg_ids <- newSysLocalsDs (dataConInstOrigArgTys con in_inst_tys) + -- This call to dataConInstOrigArgTys won't work for existentials + -- but existentials don't have record types anyway + ; let val_args = zipWithEqual "dsExpr:RecordUpd" mk_val_arg + (dataConFieldLabels con) arg_ids + rhs = foldl (\a b -> nlHsApp a b) + (nlHsTyApp (dataConWrapId con) out_inst_tys) + val_args + pat = mkPrefixConPat con (map nlVarPat arg_ids) in_ty + + ; return (mkSimpleMatch [pat] rhs) } -- It's important to generate the match with matchWrapper, -- and the right hand sides with applications of the wrapper Id -- so that everything works when we are doing fancy unboxing on the -- constructor aguments. - mappM mk_alt cons_to_upd `thenDs` \ alts -> - matchWrapper RecUpd (MatchGroup alts in_out_ty) `thenDs` \ ([discrim_var], matching_code) -> + ; alts <- mapM mk_alt cons_to_upd + ; ([discrim_var], matching_code) <- matchWrapper RecUpd (MatchGroup alts in_out_ty) - returnDs (bindNonRec discrim_var record_expr' matching_code) - - where - updated_fields :: [FieldLabel] - updated_fields = [ idName sel_id | (L _ sel_id,_) <- rbinds] - - -- Get the type constructor from the record_in_ty - -- so that we are sure it'll have all its DataCons - -- (In GHCI, it's possible that some TyCons may not have all - -- their constructors, in a module-loop situation.) - tycon = tcTyConAppTyCon record_in_ty - data_cons = tyConDataCons tycon - cons_to_upd = filter has_all_fields data_cons - - has_all_fields :: DataCon -> Bool - has_all_fields con_id - = all (`elem` con_fields) updated_fields - where - con_fields = dataConFieldLabels con_id + ; return (bindNonRec discrim_var record_expr' matching_code) } \end{code} Here is where we desugar the Template Haskell brackets and escapes diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index fa7fafe..11a5323 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -531,7 +531,7 @@ repE (RecordCon c _ (HsRecordBinds flds)) = do { x <- lookupLOcc c; fs <- repFields flds; repRecCon x fs } -repE (RecordUpd e (HsRecordBinds flds) _ _) +repE (RecordUpd e (HsRecordBinds flds) _ _ _) = do { x <- repLE e; fs <- repFields flds; repRecUpd x fs } diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs index 4ed7364..241eb44 100644 --- a/compiler/hsSyn/Convert.lhs +++ b/compiler/hsSyn/Convert.lhs @@ -367,7 +367,7 @@ cvtl e = wrapL (cvt e) ; return $ RecordCon c' noPostTcExpr (HsRecordBinds flds') } cvt (RecUpdE e flds) = do { e' <- cvtl e ; flds' <- mapM cvtFld flds - ; return $ RecordUpd e' (HsRecordBinds flds') placeHolderType placeHolderType } + ; return $ RecordUpd e' (HsRecordBinds flds') [] [] [] } cvtFld (v,e) = do { v' <- vNameL v; e' <- cvtl e; return (v',e') } diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index 7759885..e56eeac 100644 --- a/compiler/hsSyn/HsExpr.lhs +++ b/compiler/hsSyn/HsExpr.lhs @@ -22,6 +22,7 @@ import HsBinds import Var import Name import BasicTypes +import DataCon import SrcLoc import Outputable import FastString @@ -158,9 +159,11 @@ data HsExpr id -- Record update | RecordUpd (LHsExpr id) (HsRecordBinds id) - PostTcType -- Type of *input* record - PostTcType -- Type of *result* record (may differ from - -- type of input record) + [DataCon] -- Filled in by the type checker to the *non-empty* + -- list of DataCons that have all the upd'd fields + [PostTcType] -- Argument types of *input* record type + [PostTcType] -- and *output* record type + -- For a type family, the arg types are of the *instance* tycon, not the family tycon | ExprWithTySig -- e :: type (LHsExpr id) @@ -380,7 +383,7 @@ ppr_expr (ExplicitTuple exprs boxity) ppr_expr (RecordCon con_id con_expr rbinds) = pp_rbinds (ppr con_id) rbinds -ppr_expr (RecordUpd aexp rbinds _ _) +ppr_expr (RecordUpd aexp rbinds _ _ _) = pp_rbinds (pprParendExpr aexp) rbinds ppr_expr (ExprWithTySig expr sig) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 7a6a0e9..8eea797 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -872,7 +872,7 @@ mkRecConstrOrUpdate mkRecConstrOrUpdate (L l (HsVar c)) loc fs | isRdrDataCon c = return (RecordCon (L l c) noPostTcExpr fs) mkRecConstrOrUpdate exp loc fs@(HsRecordBinds (_:_)) - = return (RecordUpd exp fs placeHolderType placeHolderType) + = return (RecordUpd exp fs [] [] []) mkRecConstrOrUpdate _ loc (HsRecordBinds []) = parseError loc "Empty record update" diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index e78e942..e5ce559 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -229,10 +229,10 @@ rnExpr (RecordCon con_id _ (HsRecordBinds rbinds)) returnM (RecordCon conname noPostTcExpr (HsRecordBinds rbinds'), fvRbinds `addOneFV` unLoc conname) -rnExpr (RecordUpd expr (HsRecordBinds rbinds) _ _) +rnExpr (RecordUpd expr (HsRecordBinds rbinds) _ _ _) = rnLExpr expr `thenM` \ (expr', fvExpr) -> rnRbinds "update" rbinds `thenM` \ (rbinds', fvRbinds) -> - returnM (RecordUpd expr' (HsRecordBinds rbinds') placeHolderType placeHolderType, + returnM (RecordUpd expr' (HsRecordBinds rbinds') [] [] [], fvExpr `plusFV` fvRbinds) rnExpr (ExprWithTySig expr pty) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 4151e0d..14a1d6d 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -382,7 +382,7 @@ tcExpr expr@(RecordCon (L loc con_name) _ rbinds) res_ty -- don't know how to do the update otherwise. -tcExpr expr@(RecordUpd record_expr hrbinds@(HsRecordBinds rbinds) _ _) res_ty +tcExpr expr@(RecordUpd record_expr hrbinds@(HsRecordBinds rbinds) _ _ _) res_ty = -- STEP 0 -- Check that the field names are really field names ASSERT( notNull rbinds ) @@ -407,7 +407,9 @@ tcExpr expr@(RecordUpd record_expr hrbinds@(HsRecordBinds rbinds) _ _) res_ty upd_field_lbls = recBindFields hrbinds sel_id : _ = sel_ids (tycon, _) = recordSelectorFieldLabel sel_id -- We've failed already if - data_cons = tyConDataCons tycon -- it's not a field label + data_cons = tyConDataCons tycon -- it's not a field label + -- NB: for a data type family, the tycon is the instance tycon + relevant_cons = filter is_relevant data_cons is_relevant con = all (`elem` dataConFieldLabels con) upd_field_lbls in @@ -432,12 +434,11 @@ tcExpr expr@(RecordUpd record_expr hrbinds@(HsRecordBinds rbinds) _ _) res_ty let -- A constructor is only relevant to this process if -- it contains *all* the fields that are being updated - con1 = head relevant_cons -- A representative constructor - con1_tyvars = dataConUnivTyVars con1 - con1_flds = dataConFieldLabels con1 - con1_arg_tys = dataConOrigArgTys con1 - common_tyvars = exactTyVarsOfTypes [ty | (fld,ty) <- con1_flds `zip` con1_arg_tys - , not (fld `elem` upd_field_lbls) ] + con1 = ASSERT( not (null relevant_cons) ) head relevant_cons -- A representative constructor + (con1_tyvars, theta, con1_arg_tys, con1_res_ty) = dataConSig con1 + con1_flds = dataConFieldLabels con1 + common_tyvars = exactTyVarsOfTypes [ty | (fld,ty) <- con1_flds `zip` con1_arg_tys + , not (fld `elem` upd_field_lbls) ] is_common_tv tv = tv `elemVarSet` common_tyvars @@ -445,43 +446,49 @@ tcExpr expr@(RecordUpd record_expr hrbinds@(HsRecordBinds rbinds) _ _) res_ty | is_common_tv tv = returnM result_inst_ty -- Same as result type | otherwise = newFlexiTyVarTy (tyVarKind tv) -- Fresh type, of correct kind in - tcInstTyVars con1_tyvars `thenM` \ (_, result_inst_tys, inst_env) -> - zipWithM mk_inst_ty con1_tyvars result_inst_tys `thenM` \ inst_tys -> + ASSERT( null theta ) -- Vanilla datacon + tcInstTyVars con1_tyvars `thenM` \ (_, result_inst_tys, result_inst_env) -> + zipWithM mk_inst_ty con1_tyvars result_inst_tys `thenM` \ scrut_inst_tys -> - -- STEP 3 - -- Typecheck the update bindings. - -- (Do this after checking for bad fields in case there's a field that - -- doesn't match the constructor.) + -- STEP 3: Typecheck the update bindings. + -- Do this after checking for bad fields in case + -- there's a field that doesn't match the constructor. let - result_record_ty = mkTyConApp tycon result_inst_tys - con1_arg_tys' = map (substTy inst_env) con1_arg_tys + result_ty = substTy result_inst_env con1_res_ty + con1_arg_tys' = map (substTy result_inst_env) con1_arg_tys in - tcSubExp result_record_ty res_ty `thenM` \ co_fn -> + tcSubExp result_ty res_ty `thenM` \ co_fn -> tcRecordBinds con1 con1_arg_tys' hrbinds `thenM` \ rbinds' -> - -- STEP 5 - -- Typecheck the expression to be updated + -- STEP 5: Typecheck the expression to be updated let - record_ty = ASSERT( length inst_tys == tyConArity tycon ) - mkTyConApp tycon inst_tys + scrut_inst_env = zipTopTvSubst con1_tyvars scrut_inst_tys + scrut_ty = substTy scrut_inst_env con1_res_ty -- This is one place where the isVanilla check is important - -- So that inst_tys matches the tycon + -- So that inst_tys matches the con1_tyvars in - tcMonoExpr record_expr record_ty `thenM` \ record_expr' -> + tcMonoExpr record_expr scrut_ty `thenM` \ record_expr' -> - -- STEP 6 - -- Figure out the LIE we need. We have to generate some - -- dictionaries for the data type context, since we are going to - -- do pattern matching over the data cons. + -- STEP 6: Figure out the LIE we need. + -- We have to generate some dictionaries for the data type context, + -- since we are going to do pattern matching over the data cons. -- - -- What dictionaries do we need? The tyConStupidTheta tells us. + -- What dictionaries do we need? The dataConStupidTheta tells us. let - theta' = substTheta inst_env (tyConStupidTheta tycon) + theta' = substTheta scrut_inst_env (dataConStupidTheta con1) in instStupidTheta RecordUpdOrigin theta' `thenM_` + -- Step 7: make a cast for the scrutinee, in the case that it's from a type family + let scrut_co | Just co_con <- tyConFamilyCoercion_maybe tycon + = WpCo $ mkTyConApp co_con scrut_inst_tys + | otherwise + = idHsWrapper + scrut_ty = mkTyConApp tycon scrut_inst_tys -- Type of pattern, the result of the cast + in -- Phew! - returnM (mkHsWrap co_fn (RecordUpd record_expr' rbinds' record_ty result_record_ty)) + returnM (mkHsWrap co_fn (RecordUpd (mkLHsWrap scrut_co record_expr') rbinds' + relevant_cons scrut_inst_tys result_inst_tys)) \end{code} @@ -856,6 +863,7 @@ tcArgs fun args qtvs qtys arg_tys ; qtys' <- mapM refineBox qtys -- Exploit new info ; (qtys'', args') <- go (n+1) qtys' args arg_tys ; return (qtys'', arg':args') } + go n qtys args arg_tys = panic "tcArgs" tcArg :: LHsExpr Name -- The function -> Int -- and arg number (for error messages) @@ -1131,7 +1139,8 @@ predCtxt expr = hang (ptext SLIT("In the predicate expression:")) 4 (ppr expr) nonVanillaUpd tycon - = vcat [ptext SLIT("Record update for the non-Haskell-98 data type") <+> quotes (ppr tycon) + = vcat [ptext SLIT("Record update for the non-Haskell-98 data type") + <+> quotes (pprSourceTyCon tycon) <+> ptext SLIT("is not (yet) supported"), ptext SLIT("Use pattern-matching instead")] badFieldsUpd rbinds @@ -1162,8 +1171,7 @@ missingFields con fields = ptext SLIT("Fields of") <+> quotes (ppr con) <+> ptext SLIT("not initialised:") <+> pprWithCommas ppr fields -callCtxt fun args - = ptext SLIT("In the call") <+> parens (ppr (foldl mkHsApp fun args)) +-- callCtxt fun args = ptext SLIT("In the call") <+> parens (ppr (foldl mkHsApp fun args)) #ifdef GHCI polySpliceErr :: Id -> SDoc diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index 3736184..9411a3a 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -463,12 +463,12 @@ zonkExpr env (RecordCon data_con con_expr rbinds) zonkRbinds env rbinds `thenM` \ new_rbinds -> returnM (RecordCon data_con new_con_expr new_rbinds) -zonkExpr env (RecordUpd expr rbinds in_ty out_ty) - = zonkLExpr env expr `thenM` \ new_expr -> - zonkTcTypeToType env in_ty `thenM` \ new_in_ty -> - zonkTcTypeToType env out_ty `thenM` \ new_out_ty -> - zonkRbinds env rbinds `thenM` \ new_rbinds -> - returnM (RecordUpd new_expr new_rbinds new_in_ty new_out_ty) +zonkExpr env (RecordUpd expr rbinds cons in_tys out_tys) + = zonkLExpr env expr `thenM` \ new_expr -> + mapM (zonkTcTypeToType env) in_tys `thenM` \ new_in_tys -> + mapM (zonkTcTypeToType env) out_tys `thenM` \ new_out_tys -> + zonkRbinds env rbinds `thenM` \ new_rbinds -> + returnM (RecordUpd new_expr new_rbinds cons new_in_tys new_out_tys) zonkExpr env (ExprWithTySigOut e ty) = do { e' <- zonkLExpr env e diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 25c5968..37f915b 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -54,7 +54,7 @@ module Type ( applyTy, applyTys, isForAllTy, dropForAlls, -- Source types - predTypeRep, mkPredTy, mkPredTys, pprSourceTyCon, + predTypeRep, mkPredTy, mkPredTys, pprSourceTyCon, mkFamilyTyConApp, -- Newtypes splitRecNewType_maybe, newTyConInstRhs, @@ -603,13 +603,27 @@ predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys -- look through that too if necessary predTypeRep (EqPred ty1 ty2) = pprPanic "predTypeRep" (ppr (EqPred ty1 ty2)) +mkFamilyTyConApp :: TyCon -> [Type] -> Type +-- Given a family instance TyCon and its arg types, return the +-- corresponding family type. E.g. +-- data family T a +-- data instance T (Maybe b) = MkT b -- Instance tycon :RTL +-- Then +-- mkFamilyTyConApp :RTL Int = T (Maybe Int) +mkFamilyTyConApp tc tys + | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc + , let fam_subst = zipTopTvSubst (tyConTyVars tc) tys + = mkTyConApp fam_tc (substTys fam_subst fam_tys) + | otherwise + = mkTyConApp tc tys + -- Pretty prints a tycon, using the family instance in case of a -- representation tycon. For example -- e.g. data T [a] = ... -- In that case we want to print `T [a]', where T is the family TyCon pprSourceTyCon tycon - | Just (repTyCon, tys) <- tyConFamInst_maybe tycon - = ppr $ repTyCon `TyConApp` tys -- can't be FunTyCon + | Just (fam_tc, tys) <- tyConFamInst_maybe tycon + = ppr $ fam_tc `TyConApp` tys -- can't be FunTyCon | otherwise = ppr tycon \end{code} @@ -637,9 +651,6 @@ splitRecNewType_maybe (TyConApp tc tys) Just (substTyWith tvs tys rep_ty) splitRecNewType_maybe other = Nothing - - - \end{code}