\begin{code}
------------------------------------------------------
-buildSynTyCon :: Name -> [TyVar] -> SynTyConRhs -> TyCon
-buildSynTyCon name tvs rhs@(OpenSynTyCon rhs_ki _)
- = mkSynTyCon name kind tvs rhs
- where
- kind = mkArrowKinds (map tyVarKind tvs) rhs_ki
-buildSynTyCon name tvs rhs@(SynonymTyCon rhs_ty)
- = mkSynTyCon name kind tvs rhs
- where
- kind = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
+buildSynTyCon :: Name -> [TyVar]
+ -> SynTyConRhs
+ -> Maybe (TyCon, [Type]) -- family instance if applicable
+ -> TcRnIf m n TyCon
+buildSynTyCon tc_name tvs rhs@(OpenSynTyCon rhs_ki _) _
+ = let
+ kind = mkArrowKinds (map tyVarKind tvs) rhs_ki
+ in
+ return $ mkSynTyCon tc_name kind tvs rhs NoParentTyCon
+
+buildSynTyCon tc_name tvs rhs@(SynonymTyCon rhs_ty) mb_family
+ = do { -- We need to tie a knot as the coercion of a data instance depends
+ -- on the instance representation tycon and vice versa.
+ ; tycon <- fixM (\ tycon_rec -> do
+ { parent <- mkParentInfo mb_family tc_name tvs tycon_rec
+ ; let { tycon = mkSynTyCon tc_name kind tvs rhs parent
+ ; kind = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
+ }
+ ; return tycon
+ })
+ ; return tycon
+ }
------------------------------------------------------
buildAlgTyCon :: Name -> [TyVar]
= do { -- We need to tie a knot as the coercion of a data instance depends
-- on the instance representation tycon and vice versa.
; tycon <- fixM (\ tycon_rec -> do
- { parent <- parentInfo mb_family tycon_rec
+ { parent <- mkParentInfo mb_family tc_name tvs tycon_rec
; let { tycon = mkAlgTyCon tc_name kind tvs stupid_theta rhs
fields parent is_rec want_generics gadt_syn
; kind = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
})
; return tycon
}
- where
- -- If a family tycon with instance types is given, the current tycon is an
- -- instance of that family and we need to
- --
- -- (1) create a coercion that identifies the family instance type and the
- -- representation type from Step (1); ie, it is of the form
- -- `Co tvs :: F ts :=: R tvs', where `Co' is the name of the coercion,
- -- `F' the family tycon and `R' the (derived) representation tycon,
- -- and
- -- (2) produce a `AlgTyConParent' value containing the parent and coercion
- -- information.
- --
- parentInfo Nothing rep_tycon =
- return NoParentTyCon
- parentInfo (Just (family, instTys)) rep_tycon =
- do { -- Create the coercion
- ; co_tycon_name <- newImplicitBinder tc_name mkInstTyCoOcc
- ; let co_tycon = mkDataInstCoercion co_tycon_name tvs
- family instTys rep_tycon
- ; return $ FamilyTyCon family instTys co_tycon
- }
-
+-- If a family tycon with instance types is given, the current tycon is an
+-- instance of that family and we need to
+--
+-- (1) create a coercion that identifies the family instance type and the
+-- representation type from Step (1); ie, it is of the form
+-- `Co tvs :: F ts :=: R tvs', where `Co' is the name of the coercion,
+-- `F' the family tycon and `R' the (derived) representation tycon,
+-- and
+-- (2) produce a `TyConParent' value containing the parent and coercion
+-- information.
+--
+mkParentInfo :: Maybe (TyCon, [Type])
+ -> Name -> [TyVar]
+ -> TyCon
+ -> TcRnIf m n TyConParent
+mkParentInfo Nothing _ _ _ =
+ return NoParentTyCon
+mkParentInfo (Just (family, instTys)) tc_name tvs rep_tycon =
+ do { -- Create the coercion
+ ; co_tycon_name <- newImplicitBinder tc_name mkInstTyCoOcc
+ ; let co_tycon = mkFamInstCoercion co_tycon_name tvs
+ family instTys rep_tycon
+ ; return $ FamilyTyCon family instTys co_tycon
+ }
+
------------------------------------------------------
mkAbstractTyConRhs :: AlgTyConRhs
mkAbstractTyConRhs = AbstractTyCon
; rhs_tyki <- tcIfaceType rdr_rhs_ty
; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
else SynonymTyCon rhs_tyki
- ; return (ATyCon (buildSynTyCon tc_name tyvars rhs))
+ -- !!!TODO: read mb_family info from iface and pass as last argument
+ ; tycon <- buildSynTyCon tc_name tyvars rhs Nothing
+ ; return $ ATyCon tycon
}
tcIfaceDecl ignore_prags
import Var ( TyVar, tyVarKind )
import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons,
mkTupleTyCon, mkAlgTyCon, tyConName,
- AlgTyConParent(NoParentTyCon) )
+ TyConParent(NoParentTyCon) )
import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed,
StrictnessMark(..) )
newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
\end{code}
-Make a name for the representation tycon of a data/newtype instance. It's an
+Make a name for the representation tycon of a family instance. It's an
*external* name, like otber top-level names, and hence must be made with
newGlobalBinder.
tcFamInstDecl1 :: TyClDecl Name -> TcM (Maybe TyThing) -- Nothing if error
-tcFamInstDecl1 (decl@TySynonym {})
+ -- "type instance"
+tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name})
= kcIdxTyPats decl $ \k_tvs k_typats resKind family ->
do { -- check that the family declaration is for a synonym
unless (isSynTyCon family) $
; t_typats <- mappM tcHsKindedType k_typats
; t_rhs <- tcHsKindedType k_rhs
- -- !!!of the form: forall t_tvs. (tcdLName decl) t_typats = t_rhs
- ; return Nothing -- !!!TODO: need TyThing for indexed synonym
+ -- (3) construct representation tycon
+ ; rep_tc_name <- newFamInstTyConName tc_name (srcSpanStart loc)
+ ; tycon <- buildSynTyCon rep_tc_name t_tvs (SynonymTyCon t_rhs)
+ (Just (family, t_typats))
+
+ ; return $ Just (ATyCon tycon)
}}
-
+
+ -- "newtype instance" and "data instance"
tcFamInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
tcdCons = cons})
= kcIdxTyPats decl $ \k_tvs k_typats resKind family ->
; t_typats <- mappM tcHsKindedType k_typats
; stupid_theta <- tcHsKindedContext k_ctxt
+ -- (3) construct representation tycon
; rep_tc_name <- newFamInstTyConName tc_name (srcSpanStart loc)
; tycon <- fixM (\ tycon -> do
{ data_cons <- mappM (addLocM (tcConDecl unbox_strict tycon t_tvs))
; syn_tcs <- tcExtendGlobalEnv [syn_tc] (tcSynDecls decls)
; return (syn_tc : syn_tcs) }
+ -- "type"
tcSynDecl
(TySynonym {tcdLName = L _ tc_name, tcdTyVars = tvs, tcdSynRhs = rhs_ty})
= tcTyVarBndrs tvs $ \ tvs' -> do
{ traceTc (text "tcd1" <+> ppr tc_name)
; rhs_ty' <- tcHsKindedType rhs_ty
- ; return (ATyCon (buildSynTyCon tc_name tvs' (SynonymTyCon rhs_ty'))) }
+ ; tycon <- buildSynTyCon tc_name tvs' (SynonymTyCon rhs_ty') Nothing
+ ; return (ATyCon tycon)
+ }
--------------------
tcTyClDecl :: (Name -> RecFlag) -> TyClDecl Name -> TcM [TyThing]
-- Check that we don't use families without -findexed-types
; checkTc idx_tys $ badFamInstDecl tc_name
- ; return [ATyCon $ buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing)]
+ ; tycon <- buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing) Nothing
+ ; return [ATyCon tycon]
}
-- "newtype family" or "data family" declaration
; return [ATyCon tycon]
}
- -- "newtype", "data", "newtype instance", "data instance"
+ -- "newtype" and "data"
tcTyClDecl1 calc_isrec
(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs,
tcdLName = L _ tc_name, tcdKindSig = mb_ksig, tcdCons = cons})
mkSymCoercion, mkTransCoercion,
mkLeftCoercion, mkRightCoercion, mkInstCoercion, mkAppCoercion,
mkForAllCoercion, mkFunCoercion, mkInstsCoercion, mkUnsafeCoercion,
- mkNewTypeCoercion, mkDataInstCoercion, mkAppsCoercion,
+ mkNewTypeCoercion, mkFamInstCoercion, mkAppsCoercion,
splitNewTypeRepCo_maybe, decomposeCo,
rule args = ASSERT( co_con_arity == length args )
(TyConApp tycon args, substTyWith tvs args rhs_ty)
--- Coercion identifying a data/newtype representation type and its family
--- instance. It has the form `Co tvs :: F ts :=: R tvs', where `Co' is the
--- coercion tycon built here, `F' the family tycon and `R' the (derived)
+-- Coercion identifying a data/newtype/synonym representation type and its
+-- family instance. It has the form `Co tvs :: F ts :=: R tvs', where `Co' is
+-- the coercion tycon built here, `F' the family tycon and `R' the (derived)
-- representation tycon.
--
-mkDataInstCoercion :: Name -- unique name for the coercion tycon
- -> [TyVar] -- type parameters of the coercion (`tvs')
- -> TyCon -- family tycon (`F')
- -> [Type] -- type instance (`ts')
- -> TyCon -- representation tycon (`R')
- -> TyCon -- => coercion tycon (`Co')
-mkDataInstCoercion name tvs family instTys rep_tycon
+mkFamInstCoercion :: Name -- unique name for the coercion tycon
+ -> [TyVar] -- type parameters of the coercion (`tvs')
+ -> TyCon -- family tycon (`F')
+ -> [Type] -- type instance (`ts')
+ -> TyCon -- representation tycon (`R')
+ -> TyCon -- => coercion tycon (`Co')
+mkFamInstCoercion name tvs family instTys rep_tycon
= mkCoercionTyCon name coArity rule
where
coArity = length tvs
-- Used for "rough matching"; same idea as for class instances
, fi_tcs :: [Maybe Name] -- Top of type args
- -- INVARIANT: fi_tcs = roughMatchTcs is_tys
+ -- INVARIANT: fi_tcs = roughMatchTcs fi_tys
-- Used for "proper matching"; ditto
, fi_tvs :: TyVarSet -- Template tyvars for full match
tyConPrimRep,
AlgTyConRhs(..), visibleDataCons,
- AlgTyConParent(..),
+ TyConParent(..),
SynTyConRhs(..),
isFunTyCon, isUnLiftedTyCon, isProductTyCon,
hasGenerics :: Bool, -- True <=> generic to/from functions are available
-- (in the exports of the data type's source module)
- algTcParent :: AlgTyConParent -- Gives the class or family tycon for
+ algTcParent :: TyConParent -- Gives the class or family tycon for
-- derived tycons representing classes
-- or family instances, respectively.
}
tyConTyVars :: [TyVar], -- Bound tyvars
- synTcRhs :: SynTyConRhs -- Expanded type in here
+ synTcRhs :: SynTyConRhs, -- Expanded type in here
+
+ synTcParent :: TyConParent -- Gives the family tycon of
+ -- representation tycons of family
+ -- instances
+
}
| PrimTyCon { -- Primitive types; cannot be defined in Haskell
visibleDataCons (DataTyCon{ data_cons = cs }) = cs
visibleDataCons (NewTyCon{ data_con = c }) = [c]
--- Both type classes as well as data/newtype family instances imply implicit
--- type constructors. These implicit type constructors refer to their parent
+-- Both type classes as well as family instances imply implicit type
+-- constructors. These implicit type constructors refer to their parent
-- structure (ie, the class or family from which they derive) using a type of
--- the following form.
+-- the following form. We use `TyConParent' for both algebraic and synonym
+-- types, but the variant `ClassTyCon' will only be used by algebraic tycons.
--
-data AlgTyConParent
+data TyConParent
= NoParentTyCon -- An ordinary type constructor has no parent.
| ClassTyCon -- Type constructors representing a class dictionary.
| SynonymTyCon Type -- Mentioning head type vars. Acts as a template for
-- the expansion when the tycon is applied to some
- -- types.
+ -- types.
\end{code}
Note [Newtype coercions]
tyConExtName = Nothing
}
-mkSynTyCon name kind tyvars rhs
+mkSynTyCon name kind tyvars rhs parent
= SynTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConKind = kind,
tyConArity = length tyvars,
tyConTyVars = tyvars,
- synTcRhs = rhs
+ synTcRhs = rhs,
+ synTcParent = parent
}
mkCoercionTyCon name arity kindRule
isFamInstTyCon :: TyCon -> Bool
isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon (SynTyCon {synTcParent = FamilyTyCon _ _ _ }) = True
isFamInstTyCon other_tycon = False
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) =
Just (fam, instTys)
+tyConFamInst_maybe (SynTyCon {synTcParent = FamilyTyCon fam instTys _}) =
+ Just (fam, instTys)
tyConFamInst_maybe other_tycon =
Nothing
tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) =
Just coe
+tyConFamilyCoercion_maybe (SynTyCon {synTcParent = FamilyTyCon _ _ coe}) =
+ Just coe
tyConFamilyCoercion_maybe other_tycon =
Nothing
\end{code}
projects / ghc-hetmet.git / commitdiff