X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FIfaceType.lhs;h=7817b423aeb84de8ecc3fcb2960304a2edb6c764;hp=1688344556f134cc6721ff01ce382ce2bf891942;hb=febf1ced754a3996ac1a5877dcded87828560d1c;hpb=5e5310b3cb4f78e30cc7b90879eb016e97c214cb diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs index 1688344..7817b42 100644 --- a/compiler/iface/IfaceType.lhs +++ b/compiler/iface/IfaceType.lhs @@ -7,15 +7,20 @@ This module defines interface types and binders \begin{code} module IfaceType ( - IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..), + IfExtName, IfLclName, + + IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..), IfaceCoCon(..), IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion, ifaceTyConName, -- Conversion from Type -> IfaceType - toIfaceType, toIfacePred, toIfaceContext, + toIfaceType, toIfaceContext, toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs, toIfaceTyCon, toIfaceTyCon_name, + -- Conversion from Coercion -> IfaceType + coToIfaceType, + -- Printing pprIfaceType, pprParendIfaceType, pprIfaceContext, pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs, @@ -23,11 +28,13 @@ module IfaceType ( ) where -import TypeRep +import Coercion +import TypeRep hiding( maybeParen ) import TyCon import Id import Var import TysWiredIn +import TysPrim import Name import BasicTypes import Outputable @@ -41,59 +48,86 @@ import FastString %************************************************************************ \begin{code} +type IfLclName = FastString -- A local name in iface syntax + +type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn + -- (However Internal or System Names never should) + data IfaceBndr -- Local (non-top-level) binders = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr -type IfaceIdBndr = (FastString, IfaceType) -type IfaceTvBndr = (FastString, IfaceKind) +type IfaceIdBndr = (IfLclName, IfaceType) +type IfaceTvBndr = (IfLclName, IfaceKind) ------------------------------- type IfaceKind = IfaceType type IfaceCoercion = IfaceType -data IfaceType - = IfaceTyVar FastString -- Type variable only, not tycon +data IfaceType -- A kind of universal type, used for types, kinds, and coercions + = IfaceTyVar IfLclName -- Type/coercion variable only, not tycon | IfaceAppTy IfaceType IfaceType + | IfaceFunTy IfaceType IfaceType | IfaceForAllTy IfaceTvBndr IfaceType | IfacePredTy IfacePredType - | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated - -- Includes newtypes, synonyms, tuples - | IfaceFunTy IfaceType IfaceType + | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated + -- Includes newtypes, synonyms, tuples + | IfaceCoConApp IfaceCoCon [IfaceType] -- Always saturated data IfacePredType -- NewTypes are handled as ordinary TyConApps - = IfaceClassP Name [IfaceType] + = IfaceClassP IfExtName [IfaceType] | IfaceIParam (IPName OccName) IfaceType | IfaceEqPred IfaceType IfaceType type IfaceContext = [IfacePredType] --- NB: If you add a data constructor, remember to add a case to --- IfaceSyn.eqIfTc! -data IfaceTyCon -- Abbreviations for common tycons with known names - = IfaceTc Name -- The common case +data IfaceTyCon -- Encodes type consructors, kind constructors + -- coercion constructors, the lot + = IfaceTc IfExtName -- The common case | IfaceIntTc | IfaceBoolTc | IfaceCharTc | IfaceListTc | IfacePArrTc | IfaceTupTc Boxity Arity + | IfaceAnyTc IfaceKind -- Used for AnyTyCon (see Note [Any Types] in TysPrim) + -- other than 'Any :: *' itself + + -- Kind constructors | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc | IfaceUbxTupleKindTc | IfaceArgTypeKindTc - deriving( Eq ) + + -- Coercion constructors +data IfaceCoCon + = IfaceCoAx IfExtName + | IfaceReflCo | IfaceUnsafeCo | IfaceSymCo + | IfaceTransCo | IfaceInstCo + | IfaceNthCo Int ifaceTyConName :: IfaceTyCon -> Name -ifaceTyConName IfaceIntTc = intTyConName -ifaceTyConName IfaceBoolTc = boolTyConName -ifaceTyConName IfaceCharTc = charTyConName -ifaceTyConName IfaceListTc = listTyConName -ifaceTyConName IfacePArrTc = parrTyConName -ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar) +ifaceTyConName IfaceIntTc = intTyConName +ifaceTyConName IfaceBoolTc = boolTyConName +ifaceTyConName IfaceCharTc = charTyConName +ifaceTyConName IfaceListTc = listTyConName +ifaceTyConName IfacePArrTc = parrTyConName +ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar) ifaceTyConName IfaceLiftedTypeKindTc = liftedTypeKindTyConName ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName -ifaceTyConName (IfaceTc ext) = ext +ifaceTyConName (IfaceTc ext) = ext +ifaceTyConName (IfaceAnyTc k) = pprPanic "ifaceTyConName" (ppr k) + -- Note [The Name of an IfaceAnyTc] \end{code} +Note [The Name of an IfaceAnyTc] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It isn't easy to get the Name of an IfaceAnyTc in a pure way. What you +really need to do is to transform it to a TyCon, and get the Name of that. +But doing so needs the monad because there's an IfaceKind inside, and we +need a Kind. + +In fact, ifaceTyConName is only used for instances and rules, and we don't +expect to instantiate those at these (internal-ish) Any types, so rather +than solve this potential problem now, I'm going to defer it until it happens! %************************************************************************ %* * @@ -162,7 +196,7 @@ instance Outputable IfaceBndr where pprIfaceBndrs :: [IfaceBndr] -> SDoc pprIfaceBndrs bs = sep (map ppr bs) -pprIfaceIdBndr :: (FastString, IfaceType) -> SDoc +pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty] pprIfaceTvBndr :: IfaceTvBndr -> SDoc @@ -190,6 +224,10 @@ ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys ppr_ty _ (IfacePredTy st) = ppr st +ppr_ty ctxt_prec (IfaceCoConApp tc tys) + = maybeParen ctxt_prec tYCON_PREC + (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))]) + -- Function types ppr_ty ctxt_prec (IfaceFunTy ty1 ty2) = -- We don't want to lose synonyms, so we mustn't use splitFunTys here. @@ -244,14 +282,26 @@ instance Outputable IfacePredType where <+> sep (map pprParendIfaceType ts) instance Outputable IfaceTyCon where - ppr (IfaceTc ext) = ppr ext - ppr other_tc = ppr (ifaceTyConName other_tc) + ppr (IfaceAnyTc k) = ptext (sLit "Any") <> pprParendIfaceType k + -- We can't easily get the Name of an IfaceAnyTc + -- (see Note [The Name of an IfaceAnyTc]) + -- so we fake it. It's only for debug printing! + ppr other_tc = ppr (ifaceTyConName other_tc) + +instance Outputable IfaceCoCon where + ppr (IfaceCoAx n) = ppr n + ppr IfaceReflCo = ptext (sLit "Refl") + ppr IfaceUnsafeCo = ptext (sLit "Unsafe") + ppr IfaceSymCo = ptext (sLit "Sym") + ppr IfaceTransCo = ptext (sLit "Trans") + ppr IfaceInstCo = ptext (sLit "Inst") + ppr (IfaceNthCo d) = ptext (sLit "Nth:") <> int d ------------------- pprIfaceContext :: IfaceContext -> SDoc -- Prints "(C a, D b) =>", including the arrow pprIfaceContext [] = empty -pprIfaceContext theta = ppr_preds theta <+> ptext (sLit "=>") +pprIfaceContext theta = ppr_preds theta <+> darrow ppr_preds :: [IfacePredType] -> SDoc ppr_preds [pred] = ppr pred -- No parens @@ -270,11 +320,11 @@ pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]") \begin{code} ---------------- -toIfaceTvBndr :: TyVar -> (FastString, IfaceType) +toIfaceTvBndr :: TyVar -> (IfLclName, IfaceType) toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar)) -toIfaceIdBndr :: Id -> (FastString, IfaceType) +toIfaceIdBndr :: Id -> (IfLclName, IfaceType) toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id)) -toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)] +toIfaceTvBndrs :: [TyVar] -> [(IfLclName, IfaceType)] toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars toIfaceBndr :: Var -> IfaceBndr @@ -288,18 +338,15 @@ toIfaceKind = toIfaceType --------------------- toIfaceType :: Type -> IfaceType -- Synonyms are retained in the interface type -toIfaceType (TyVarTy tv) = - IfaceTyVar (occNameFS (getOccName tv)) -toIfaceType (AppTy t1 t2) = - IfaceAppTy (toIfaceType t1) (toIfaceType t2) -toIfaceType (FunTy t1 t2) = - IfaceFunTy (toIfaceType t1) (toIfaceType t2) -toIfaceType (TyConApp tc tys) = - IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys) -toIfaceType (ForAllTy tv t) = - IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t) -toIfaceType (PredTy st) = - IfacePredTy (toIfacePred st) +toIfaceType (TyVarTy tv) = IfaceTyVar (toIfaceTyCoVar tv) +toIfaceType (AppTy t1 t2) = IfaceAppTy (toIfaceType t1) (toIfaceType t2) +toIfaceType (FunTy t1 t2) = IfaceFunTy (toIfaceType t1) (toIfaceType t2) +toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys) +toIfaceType (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t) +toIfaceType (PredTy st) = IfacePredTy (toIfacePred toIfaceType st) + +toIfaceTyCoVar :: TyCoVar -> FastString +toIfaceTyCoVar = occNameFS . getOccName ---------------- -- A little bit of (perhaps optional) trickiness here. When @@ -312,6 +359,7 @@ toIfaceType (PredTy st) = toIfaceTyCon :: TyCon -> IfaceTyCon toIfaceTyCon tc | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc) + | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc)) | otherwise = toIfaceTyCon_name (tyConName tc) toIfaceTyCon_name :: Name -> IfaceTyCon @@ -323,7 +371,8 @@ toIfaceTyCon_name nm toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon toIfaceWiredInTyCon tc nm - | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc) + | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc) + | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc)) | nm == intTyConName = IfaceIntTc | nm == boolTyConName = IfaceBoolTc | nm == charTyConName = IfaceCharTc @@ -341,16 +390,39 @@ toIfaceTypes :: [Type] -> [IfaceType] toIfaceTypes ts = map toIfaceType ts ---------------- -toIfacePred :: PredType -> IfacePredType -toIfacePred (ClassP cls ts) = - IfaceClassP (getName cls) (toIfaceTypes ts) -toIfacePred (IParam ip t) = - IfaceIParam (mapIPName getOccName ip) (toIfaceType t) -toIfacePred (EqPred ty1 ty2) = - IfaceEqPred (toIfaceType ty1) (toIfaceType ty2) +toIfacePred :: (a -> IfaceType) -> Pred a -> IfacePredType +toIfacePred to (ClassP cls ts) = IfaceClassP (getName cls) (map to ts) +toIfacePred to (IParam ip t) = IfaceIParam (mapIPName getOccName ip) (to t) +toIfacePred to (EqPred ty1 ty2) = IfaceEqPred (to ty1) (to ty2) ---------------- toIfaceContext :: ThetaType -> IfaceContext -toIfaceContext cs = map toIfacePred cs +toIfaceContext cs = map (toIfacePred toIfaceType) cs + +---------------- +coToIfaceType :: Coercion -> IfaceType +coToIfaceType (Refl ty) = IfaceCoConApp IfaceReflCo [toIfaceType ty] +coToIfaceType (TyConAppCo tc cos) = IfaceTyConApp (toIfaceTyCon tc) + (map coToIfaceType cos) +coToIfaceType (AppCo co1 co2) = IfaceAppTy (coToIfaceType co1) + (coToIfaceType co2) +coToIfaceType (ForAllCo v co) = IfaceForAllTy (toIfaceTvBndr v) + (coToIfaceType co) +coToIfaceType (CoVarCo cv) = IfaceTyVar (toIfaceTyCoVar cv) +coToIfaceType (AxiomInstCo con cos) = IfaceCoConApp (IfaceCoAx (coAxiomName con)) + (map coToIfaceType cos) +coToIfaceType (UnsafeCo ty1 ty2) = IfaceCoConApp IfaceUnsafeCo + [ toIfaceType ty1 + , toIfaceType ty2 ] +coToIfaceType (SymCo co) = IfaceCoConApp IfaceSymCo + [ coToIfaceType co ] +coToIfaceType (TransCo co1 co2) = IfaceCoConApp IfaceTransCo + [ coToIfaceType co1 + , coToIfaceType co2 ] +coToIfaceType (NthCo d co) = IfaceCoConApp (IfaceNthCo d) + [ coToIfaceType co ] +coToIfaceType (InstCo co ty) = IfaceCoConApp IfaceInstCo + [ coToIfaceType co + , toIfaceType ty ] \end{code}