Commit d76c18e0 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Straightened out implicit coercions for indexed types

Mon Sep 18 19:35:24 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Straightened out implicit coercions for indexed types
  Mon Sep  4 23:46:14 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * Straightened out implicit coercions for indexed types
    - HscTypes.implicitTyThings and LoadIface.ifaceDeclSubBndrs now
      include the coercion of indexed data/newtypes.
    - Name generation for the internal names of indexed data/newtypes now uses
      the same counter that generates the dfun unique indexes (ie, class and type
      instances are counted with the one counter).  We could make this two 
      separate counters if that's what's preferred.
    - The unique index of a data/newtype instances needs to go into the iface, so
      that we can generate the same names on slurping in the iface as when the
      original module was generated.  This is a bit yucky, but I don't see a way
      to avoid that (other than putting the full blown internal tycon name and 
      coercion name into the iface, which IMHO would be worse).
    - The predicate for when a datacon has a wrapper didn't take GADT
      equations nor whether it comes froma  family instance into account.
    
    *** WARNING!  This patch changed the interface file format. ***
    ***           Please recompile from scratch.                ***
parent a1899edb
......@@ -64,7 +64,7 @@ import TyCon ( TyCon, isNewTyCon, tyConDataCons, FieldLabel,
tyConStupidTheta, isProductTyCon, isDataTyCon,
isRecursiveTyCon, isFamInstTyCon,
tyConFamInst_maybe, tyConFamilyCoercion_maybe,
newTyConCo )
newTyConCo_maybe )
import Class ( Class, classTyCon, classSelIds )
import Var ( Id, TyVar, Var, setIdType )
import VarSet ( isEmptyVarSet, subVarSet, varSetElems )
......@@ -220,14 +220,14 @@ This coercion is conditionally applied by wrapFamInstBody.
mkDataConIds :: Name -> Name -> DataCon -> DataConIds
mkDataConIds wrap_name wkr_name data_con
| isNewTyCon tycon
= DCIds Nothing nt_work_id -- Newtype, only has a worker
= DCIds Nothing nt_work_id -- Newtype, only has a worker
| any isMarkedStrict all_strict_marks -- Algebraic, needs wrapper
|| not (null eq_spec)
|| isFamInstTyCon tycon
| any isMarkedStrict all_strict_marks -- Algebraic, needs wrapper
|| not (null eq_spec) -- NB: LoadIface.ifaceDeclSubBndrs
|| isFamInstTyCon tycon -- depends on this test
= DCIds (Just alg_wrap_id) wrk_id
| otherwise -- Algebraic, no wrapper
| otherwise -- Algebraic, no wrapper
= DCIds Nothing wrk_id
where
(univ_tvs, ex_tvs, eq_spec,
......@@ -860,7 +860,7 @@ wrapNewTypeBody tycon args result_expr
= wrapFamInstBody tycon args inner
where
inner
| Just co_con <- newTyConCo tycon
| Just co_con <- newTyConCo_maybe tycon
= mkCoerce (mkSymCoercion (mkTyConApp co_con args)) result_expr
| otherwise
= result_expr
......@@ -872,7 +872,7 @@ wrapNewTypeBody tycon args result_expr
--
unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
unwrapNewTypeBody tycon args result_expr
| Just co_con <- newTyConCo tycon
| Just co_con <- newTyConCo_maybe tycon
= mkCoerce (mkTyConApp co_con args) result_expr
| otherwise
= result_expr
......
......@@ -483,20 +483,19 @@ mkLocalOcc uniq occ
-- Derive a name for the representation type constructor of a data/newtype
-- instance.
--
mkInstTyTcOcc :: Unique -- Unique
mkInstTyTcOcc :: Int -- Index
-> OccName -- Local name (e.g. "Map")
-> OccName -- Nice unique version (":R23Map")
mkInstTyTcOcc uniq occ
= mk_deriv varName (":R" ++ show uniq) (occNameString occ)
mkInstTyTcOcc index occ
= mk_deriv varName (":R" ++ show index) (occNameString occ)
-- Derive a name for the coercion of a data/newtype instance.
--
mkInstTyCoOcc :: Unique -- Unique
mkInstTyCoOcc :: Int -- Index
-> OccName -- Local name (e.g. "Map")
-> OccName -- Nice unique version ("Co23Map")
mkInstTyCoOcc uniq occ
= mk_deriv varName ("Co" ++ show uniq) (occNameString occ)
-> OccName -- Nice unique version (":Co23Map")
mkInstTyCoOcc index occ
= mk_deriv varName (":Co" ++ show index) (occNameString occ)
\end{code}
\begin{code}
......
......@@ -69,7 +69,8 @@ buildAlgTyCon :: Name -> [TyVar]
-> RecFlag
-> Bool -- True <=> want generics functions
-> Bool -- True <=> was declared in GADT syntax
-> Maybe (TyCon, [Type]) -- Just (family, tys)
-> Maybe (TyCon, [Type],
Int) -- Just (family, tys, index)
-- <=> instance of `family' at `tys'
-> TcRnIf m n TyCon
......@@ -102,20 +103,19 @@ buildAlgTyCon tc_name tvs stupid_theta rhs is_rec want_generics gadt_syn
-- (3) Produce a `AlgTyConParent' value containing the parent and coercion
-- information.
--
maybeComputeFamilyInfo Nothing rep_tycon =
maybeComputeFamilyInfo Nothing rep_tycon =
return (tc_name, NoParentTyCon)
maybeComputeFamilyInfo (Just (family, instTys)) rep_tycon =
maybeComputeFamilyInfo (Just (family, instTys, index)) rep_tycon =
do { -- (1) New, derived name for the instance tycon
; uniq <- newUnique
; final_name <- newImplicitBinder tc_name (mkInstTyTcOcc uniq)
; final_name <- newImplicitBinder tc_name (mkInstTyTcOcc index)
-- (2) Create the coercion.
; co_tycon_name <- newImplicitBinder tc_name (mkInstTyCoOcc uniq)
; co_tycon_name <- newImplicitBinder tc_name (mkInstTyCoOcc index)
; let co_tycon = mkDataInstCoercion co_tycon_name tvs
family instTys rep_tycon
-- (3) Produce parent information.
; return (final_name, FamilyTyCon family instTys co_tycon)
; return (final_name, FamilyTyCon family instTys co_tycon index)
}
......
......@@ -87,7 +87,8 @@ data IfaceDecl
-- current compilation unit
ifFamInst :: Maybe -- Just _ <=> instance of fam
(IfaceTyCon, -- Family tycon
[IfaceType]) -- Instance types
[IfaceType], -- Instance types
Int ) -- Unique index for naming
}
| IfaceSyn { ifName :: OccName, -- Type constructor
......@@ -283,9 +284,10 @@ pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
pprGen True = ptext SLIT("Generics: yes")
pprGen False = ptext SLIT("Generics: no")
pprFamily Nothing = ptext SLIT("FamilyInstance: none")
pprFamily (Just (fam, tys)) = ptext SLIT("FamilyInstance:") <+>
ppr fam <+> hsep (map ppr tys)
pprFamily Nothing = ptext SLIT("FamilyInstance: none")
pprFamily (Just (fam, tys, index)) = ptext SLIT("FamilyInstance:") <+>
ppr fam <+> hsep (map ppr tys) <+>
brackets (ppr index)
instance Outputable IfaceClassOp where
ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
......@@ -554,10 +556,10 @@ eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
-- over the constructors (any more), but they do scope
-- over the stupid context in the IfaceConDecls
where
Nothing `eqIfTc_fam` Nothing = Equal
(Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) =
fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
_ `eqIfTc_fam` _ = NotEqual
Nothing `eqIfTc_fam` Nothing = Equal
(Just (fam1, tys1, co1)) `eqIfTc_fam` (Just (fam2, tys2, co2)) =
fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2 &&& bool (co1 == co2)
_ `eqIfTc_fam` _ = NotEqual
eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
= bool (ifName d1 == ifName d2) &&&
......
......@@ -49,9 +49,9 @@ import NameEnv
import MkId ( seqId )
import Module
import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc,
mkClassDataConOcc, mkSuperDictSelOcc,
mkDataConWrapperOcc, mkDataConWorkerOcc,
mkNewTyCoOcc )
mkClassDataConOcc, mkSuperDictSelOcc,
mkDataConWrapperOcc, mkDataConWorkerOcc,
mkNewTyCoOcc, mkInstTyTcOcc, mkInstTyCoOcc )
import SrcLoc ( importedSrcLoc )
import Maybes ( MaybeErr(..) )
import ErrUtils ( Message )
......@@ -64,6 +64,7 @@ import BinIface ( readBinIface, v_IgnoreHiWay )
import Binary ( getBinFileWithDict )
import Panic ( ghcError, tryMost, showException, GhcException(..) )
import List ( nub )
import Maybe ( isJust )
import DATA_IOREF ( writeIORef )
\end{code}
......@@ -300,7 +301,7 @@ loadDecl ignore_prags mod (_version, decl)
main_name <- mk_new_bndr mod Nothing (ifName decl)
; implicit_names <- mapM (mk_new_bndr mod (Just main_name))
(ifaceDeclSubBndrs decl)
; at_names <- mapM (mk_new_bndr mod Nothing) (atNames decl)
; at_names <- mapM (mk_new_bndr mod (Just main_name)) (atNames decl)
-- Typecheck the thing, lazily
-- NB. firstly, the laziness is there in case we never need the
......@@ -387,12 +388,18 @@ ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}
ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
ifCons = IfNewTyCon (
IfCon { ifConOcc = con_occ,
ifConFields = fields})})
= fields ++ [con_occ, mkDataConWrapperOcc con_occ, mkNewTyCoOcc tc_occ]
ifConFields = fields
}),
ifFamInst = famInst})
= fields ++ [con_occ, mkDataConWorkerOcc con_occ, mkNewTyCoOcc tc_occ]
++ famInstCo famInst tc_occ
ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
ifCons = IfDataTyCon cons,
ifFamInst = famInst})
= nub (concatMap ifConFields cons) -- Eliminate duplicate fields
++ concatMap dc_occs cons
++ famInstCo famInst tc_occ
where
dc_occs con_decl
| has_wrapper = [con_occ, work_occ, wrap_occ]
......@@ -403,9 +410,16 @@ ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
wrap_occ = mkDataConWrapperOcc con_occ
work_occ = mkDataConWorkerOcc con_occ
has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
|| not (null . ifConEqSpec $ con_decl)
|| isJust famInst
-- ToDo: may miss strictness in existential dicts
ifaceDeclSubBndrs _other = []
-- coercion for data/newtype family instances
famInstCo Nothing baseOcc = []
famInstCo (Just (_, _, index)) baseOcc = [mkInstTyTcOcc index baseOcc,
mkInstTyCoOcc index baseOcc]
\end{code}
......
......@@ -191,7 +191,7 @@ import TyCon ( TyCon, AlgTyConRhs(..), SynTyConRhs(..),
isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
tyConArity, tyConTyVars, algTyConRhs, tyConExtName,
tyConFamInst_maybe )
tyConFamInst_maybe, tyConFamInstIndex )
import DataCon ( dataConName, dataConFieldLabels, dataConStrictMarks,
dataConTyCon, dataConIsInfix, dataConUnivTyVars,
dataConExTyVars, dataConEqSpec, dataConTheta,
......@@ -379,17 +379,17 @@ mkExtNameFn hsc_env eps this_mod
occ = nameOccName name
par_occ = nameOccName (nameParent name)
-- The version of the *parent* is the one want
vers = lookupVersion mod par_occ
vers = lookupVersion mod par_occ occ
lookupVersion :: Module -> OccName -> Version
lookupVersion :: Module -> OccName -> OccName -> Version
-- Even though we're looking up a home-package thing, in
-- one-shot mode the imported interfaces may be in the PIT
lookupVersion mod occ
= mi_ver_fn iface occ `orElse`
pprPanic "lookupVers1" (ppr mod <+> ppr occ)
lookupVersion mod par_occ occ
= mi_ver_fn iface par_occ `orElse`
pprPanic "lookupVers1" (ppr mod <+> ppr par_occ <+> ppr occ)
where
iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
pprPanic "lookupVers2" (ppr mod <+> ppr occ)
pprPanic "lookupVers2" (ppr mod <+> ppr par_occ <+> ppr occ)
---------------------
......@@ -1036,7 +1036,8 @@ tyThingToIfaceDecl ext (ATyCon tycon)
ifRec = boolToRecFlag (isRecursiveTyCon tycon),
ifGadtSyntax = isGadtSyntaxTyCon tycon,
ifGeneric = tyConHasGenerics tycon,
ifFamInst = famInstToIface $ tyConFamInst_maybe tycon }
ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
(tyConFamInstIndex tycon) }
| isForeignTyCon tycon
= IfaceForeign { ifName = getOccName tycon,
......@@ -1087,9 +1088,9 @@ tyThingToIfaceDecl ext (ATyCon tycon)
to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
famInstToIface Nothing = Nothing
famInstToIface (Just (famTyCon, instTys)) =
Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys)
famInstToIface Nothing _ = Nothing
famInstToIface (Just (famTyCon, instTys)) index =
Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys, index)
tyThingToIfaceDecl ext (ADataCon dc)
= pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
......
......@@ -371,11 +371,11 @@ tcIfaceDecl (IfaceData {ifName = occ_name,
{ stupid_theta <- tcIfaceCtxt ctxt
; famInst <-
case mb_family of
Nothing -> return Nothing
Just (fam, tys) ->
Nothing -> return Nothing
Just (fam, tys, index) ->
do { famTyCon <- tcIfaceTyCon fam
; insttys <- mapM tcIfaceType tys
; return $ Just (famTyCon, insttys)
; return $ Just (famTyCon, insttys, index)
}
; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
; buildAlgTyCon tc_name tyvars stupid_theta
......
......@@ -83,7 +83,8 @@ import Id ( Id )
import Type ( TyThing(..) )
import Class ( Class, classSelIds, classTyCon )
import TyCon ( TyCon, tyConSelIds, tyConDataCons, isNewTyCon, newTyConCo )
import TyCon ( TyCon, tyConSelIds, tyConDataCons, isNewTyCon,
newTyConCo_maybe, tyConFamilyCoercion_maybe )
import DataCon ( dataConImplicitIds )
import PrelNames ( gHC_PRIM )
import Packages ( PackageId )
......@@ -105,6 +106,7 @@ import FastString ( FastString )
import DATA_IOREF ( IORef, readIORef )
import StringBuffer ( StringBuffer )
import Maybe ( catMaybes )
import Time ( ClockTime )
\end{code}
......@@ -626,9 +628,10 @@ implicitTyThings (AnId id) = []
-- and the selectors and generic-programming Ids too
--
-- Newtypes don't have a worker Id, so don't generate that?
implicitTyThings (ATyCon tc) = implicitNewCoTyCon tc ++
implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
map AnId (tyConSelIds tc) ++
concatMap (extras_plus . ADataCon) (tyConDataCons tc)
concatMap (extras_plus . ADataCon)
(tyConDataCons tc)
-- For classes, add the class TyCon too (and its extras)
-- and the class selector Ids
......@@ -639,10 +642,10 @@ implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++
-- For data cons add the worker and wrapper (if any)
implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
-- For newtypes, add the implicit coercion tycon
implicitNewCoTyCon tc
| isNewTyCon tc, Just co_con <- newTyConCo tc = [ATyCon co_con]
| otherwise = []
-- For newtypes and indexed data types, add the implicit coercion tycon
implicitCoTyCon tc
= map ATyCon . catMaybes $ [newTyConCo_maybe tc,
tyConFamilyCoercion_maybe tc]
extras_plus thing = thing : implicitTyThings thing
......
......@@ -33,7 +33,7 @@ import Type ( zipOpenTvSubst, substTheta, mkTyConApp, mkTyVarTy,
splitFunTys, TyThing(ATyCon), isTyVarTy, tcEqType,
substTys, emptyTvSubst, extendTvSubst )
import Coercion ( mkSymCoercion )
import TyCon ( TyCon, tyConName, newTyConCo, tyConTyVars,
import TyCon ( TyCon, tyConName, newTyConCo_maybe, tyConTyVars,
isTyConAssoc, tyConFamInst_maybe,
assocTyConArgPoss_maybe )
import DataCon ( classDataCon, dataConTyCon, dataConInstArgTys )
......@@ -550,7 +550,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec,
where
-- For newtype T a = MkT <ty>
-- The returned coercion has kind :: C (T a):=:C <ty>
co_fn tvs cls_tycon cls_inst_tys | Just co_con <- newTyConCo tycon
co_fn tvs cls_tycon cls_inst_tys | Just co_con <- newTyConCo_maybe tycon
= ExprCoFn (mkTyConApp cls_tycon (drop_tail 1 cls_inst_tys ++
[mkSymCoercion (mkTyConApp co_con (map mkTyVarTy tvs))]))
| otherwise
......
......@@ -319,6 +319,7 @@ tcIdxTyInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
; t_typats <- mappM tcHsKindedType k_typats
; stupid_theta <- tcHsKindedContext k_ctxt
; index <- nextDFunIndex -- to generate unique names
; tycon <- fixM (\ tycon -> do
{ data_cons <- mappM (addLocM (tcConDecl unbox_strict new_or_data
tycon t_tvs))
......@@ -330,7 +331,7 @@ tcIdxTyInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
ASSERT( isSingleton data_cons )
mkNewTyConRhs tc_name tycon (head data_cons)
; buildAlgTyCon tc_name t_tvs stupid_theta tc_rhs Recursive
False h98_syntax (Just (family, t_typats))
False h98_syntax (Just (family, t_typats, index))
-- We always assume that indexed types are recursive. Why?
-- (1) Due to their open nature, we can never be sure that a
-- further instance might not introduce a new recursive
......
......@@ -41,7 +41,7 @@ import Type ( Type, Kind, PredType, substTyWith, mkAppTy, mkForAllTy,
tyVarsOfType, mkTyVarTys
)
import TyCon ( TyCon, tyConArity, mkCoercionTyCon, isClosedNewTyCon,
newTyConRhs, newTyConCo,
newTyConRhs, newTyConCo_maybe,
isCoercionTyCon, isCoercionTyCon_maybe )
import Var ( Var, TyVar, isTyVar, tyVarKind )
import VarSet ( elemVarSet )
......@@ -459,6 +459,6 @@ splitNewTypeRepCo_maybe (TyConApp tc tys)
ASSERT( length tvs == length tys )
Just (substTyWith tvs tys rep_ty, mkTyConApp co_con tys)
where
co_con = maybe (pprPanic "splitNewTypeRepCo_maybe" (ppr tc)) id (newTyConCo tc)
co_con = maybe (pprPanic "splitNewTypeRepCo_maybe" (ppr tc)) id (newTyConCo_maybe tc)
splitNewTypeRepCo_maybe other = Nothing
\end{code}
......@@ -19,7 +19,7 @@ module TyCon(
isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo,
isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
isHiBootTyCon, isSuperKindTyCon,
isCoercionTyCon_maybe, isCoercionTyCon,
......@@ -50,6 +50,7 @@ module TyCon(
tyConArity,
isClassTyCon, tyConClass_maybe,
isFamInstTyCon, tyConFamInst_maybe, tyConFamilyCoercion_maybe,
tyConFamInstIndex,
synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,
tyConExtName, -- External name for foreign types
......@@ -274,6 +275,9 @@ data AlgTyConParent = -- An ordinary type constructor has no parent.
TyCon -- a *coercion* identifying
-- the representation type
-- with the type instance
Int -- index to generate unique
-- name (needed here to put
-- into iface)
data SynTyConRhs
= OpenSynTyCon Kind -- Type family: *result* kind given
......@@ -756,12 +760,9 @@ newTyConRep :: TyCon -> ([TyVar], Type)
newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
newTyConCo :: TyCon -> Maybe TyCon
newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }})
= co
newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = OpenNewTyCon})
= Nothing
newTyConCo tycon = pprPanic "newTyConCo" (ppr tycon)
newTyConCo_maybe :: TyCon -> Maybe TyCon
newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co
newTyConCo_maybe _ = Nothing
tyConPrimRep :: TyCon -> PrimRep
tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
......@@ -816,20 +817,25 @@ tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
tyConClass_maybe ther_tycon = Nothing
isFamInstTyCon :: TyCon -> Bool
isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _}) = True
isFamInstTyCon other_tycon = False
isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ _}) = True
isFamInstTyCon other_tycon = False
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) =
tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _ _}) =
Just (fam, instTys)
tyConFamInst_maybe ther_tycon =
tyConFamInst_maybe ther_tycon =
Nothing
tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) =
tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe _}) =
Just coe
tyConFamilyCoercion_maybe ther_tycon =
tyConFamilyCoercion_maybe ther_tycon =
Nothing
tyConFamInstIndex :: TyCon -> Int
tyConFamInstIndex (AlgTyCon {algTcParent = FamilyTyCon _ _ _ index}) = index
tyConFamInstIndex _ =
panic "tyConFamInstIndex"
\end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment