X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FTypeRep.lhs;h=7447e88fd65af62057ca63622848ee8cd9d7b409;hb=95f1b72e5398f6d4b694ff7a62e73243dd9a6ee9;hp=a00b86f6280d47ddfd5798cc9bc962312e5417f8;hpb=d069cec2bd92d4156aeab80f7eb1f222a82e4103;p=ghc-hetmet.git diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs index a00b86f..7447e88 100644 --- a/ghc/compiler/types/TypeRep.lhs +++ b/ghc/compiler/types/TypeRep.lhs @@ -5,9 +5,10 @@ \begin{code} module TypeRep ( - Type(..), TyNote(..), SourceType(..), -- Representation visible to friends + Type(..), TyNote(..), -- Representation visible + SourceType(..), -- to friends - Kind, TauType, PredType, ThetaType, -- Synonyms + Kind, PredType, ThetaType, -- Synonyms TyVarSubst, superKind, superBoxity, -- KX and BX respectively @@ -17,29 +18,24 @@ module TypeRep ( liftedTypeKind, unliftedTypeKind, openTypeKind, -- :: KX mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX - usageKindCon, -- :: KX - usageTypeKind, -- :: KX - usOnceTyCon, usManyTyCon, -- :: $ - usOnce, usMany, -- :: $ - funTyCon ) where #include "HsVersions.h" -- friends: -import Var ( TyVar ) -import VarEnv -import VarSet - -import Name ( Name ) -import TyCon ( TyCon, KindCon, mkFunTyCon, mkKindCon, mkSuperKindCon ) -import Class ( Class ) +import Var ( TyVar ) +import VarEnv ( TyVarEnv ) +import VarSet ( TyVarSet ) +import Name ( Name ) +import BasicTypes ( IPName ) +import TyCon ( TyCon, KindCon, mkFunTyCon, mkKindCon, mkSuperKindCon ) +import Class ( Class ) +import Binary -- others import PrelNames ( superKindName, superBoxityName, liftedConName, unliftedConName, typeConName, openKindConName, - usageKindConName, usOnceTyConName, usManyTyConName, funTyConName ) \end{code} @@ -118,10 +114,19 @@ and its representation as distinct right through the compiler. That's what you get if you use recursive newtypes. (They are rare, so who cares if they are a tiny bit less efficient.) +So: non-recursive newtypes are represented using a SourceTy (see below) + recursive newtypes are represented using a TyConApp + The TyCon still says "I'm a newtype", but we do not represent the newtype application as a SourceType; instead as a TyConApp. +NOTE: currently [March 02] we regard a newtype as 'recursive' if it's in a +mutually recursive group. That's a bit conservative: only if there's a loop +consisting only of newtypes do we need consider it as recursive. But it's +not so easy to discover that, and the situation isn't that common. + + %************************************************************************ %* * \subsection{The data type} @@ -132,7 +137,6 @@ newtype application as a SourceType; instead as a TyConApp. \begin{code} type SuperKind = Type type Kind = Type -type TauType = Type type TyVarSubst = TyVarEnv Type @@ -159,10 +163,6 @@ data Type | SourceTy -- A high level source type SourceType -- ...can be expanded to a representation type... - | UsageTy -- A usage-annotated type - Type -- - Annotation of kind $ (i.e., usage annotation) - Type -- - Annotated type - | NoteTy -- A type with a note attached TyNote Type -- The expanded version @@ -173,12 +173,8 @@ data TyNote | SynNote Type -- Used for type synonyms -- The Type is always a TyConApp, and is the un-expanded form. -- The type to which the note is attached is the expanded form. -\end{code} -INVARIANT: UsageTys are optional, but may *only* appear immediately -under a FunTy (either argument), or at top-level of a Type permitted -to be annotated (such as the type of an Id). NoteTys are transparent -for the purposes of this rule. +\end{code} ------------------------------------- Source types @@ -204,10 +200,11 @@ Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called *predicates* Predicates are represented inside GHC by PredType: \begin{code} -data SourceType = ClassP Class [Type] -- Class predicate - | IParam Name Type -- Implicit parameter - | NType TyCon [Type] -- A *saturated*, *non-recursive* newtype application - -- [See notes at top about newtypes] +data SourceType + = ClassP Class [Type] -- Class predicate + | IParam (IPName Name) Type -- Implicit parameter + | NType TyCon [Type] -- A *saturated*, *non-recursive* newtype application + -- [See notes at top about newtypes] type PredType = SourceType -- A subtype for predicates type ThetaType = [PredType] @@ -239,8 +236,6 @@ kind :: KX = kind -> kind | Type liftedness -- (Type *) is printed as just * -- (Type #) is printed as just # - | UsageKind -- Printed '$'; used for usage annotations - | OpenKind -- Can be lifted or unlifted -- Printed '?' @@ -266,8 +261,8 @@ in two situations: type variable, one that may very well later be unified with a type. For example, suppose f::a, and we see an application (f x). Then a must be a function type, so we unify a with (b->c). But what kind - are b and c? They can be lifted or unlifted types, so we give them - kind '?'. + are b and c? They can be lifted or unlifted types, or indeed type schemes, + so we give them kind '?'. When the type checker generalises over a bunch of type variables, it makes any that still have kind '?' into kind '*'. So kind '?' is never @@ -291,13 +286,15 @@ Define boxities: @*@ and @#@ \begin{code} liftedBoxity, unliftedBoxity :: Kind -- :: BX -liftedBoxity = TyConApp (mkKindCon liftedConName superBoxity) [] +liftedBoxity = TyConApp liftedBoxityCon [] +unliftedBoxity = TyConApp unliftedBoxityCon [] -unliftedBoxity = TyConApp (mkKindCon unliftedConName superBoxity) [] +liftedBoxityCon = mkKindCon liftedConName superBoxity +unliftedBoxityCon = mkKindCon unliftedConName superBoxity \end{code} ------------------------------------------ -Define kinds: Type, Type *, Type #, OpenKind, and UsageKind +Define kinds: Type, Type *, Type #, OpenKind \begin{code} typeCon :: KindCon -- :: BX -> KX @@ -310,9 +307,6 @@ unliftedTypeKind = TyConApp typeCon [unliftedBoxity] openKindCon = mkKindCon openKindConName superKind openTypeKind = TyConApp openKindCon [] - -usageKindCon = mkKindCon usageKindConName superKind -usageTypeKind = TyConApp usageKindCon [] \end{code} ------------------------------------------ @@ -326,6 +320,27 @@ mkArrowKinds :: [Kind] -> Kind -> Kind mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds \end{code} +----------------------------------------------------------------------------- +Binary kinds for interface files + +\begin{code} +instance Binary Kind where + put_ bh k@(TyConApp tc []) + | tc == openKindCon = putByte bh 0 + put_ bh k@(TyConApp tc [TyConApp bc _]) + | tc == typeCon && bc == liftedBoxityCon = putByte bh 2 + | tc == typeCon && bc == unliftedBoxityCon = putByte bh 3 + put_ bh (FunTy f a) = do putByte bh 4; put_ bh f; put_ bh a + put_ bh _ = error "Binary.put(Kind): strange-looking Kind" + + get bh = do + b <- getByte bh + case b of + 0 -> return openTypeKind + 2 -> return liftedTypeKind + 3 -> return unliftedTypeKind + _ -> do f <- get bh; a <- get bh; return (FunTy f a) +\end{code} %************************************************************************ %* * @@ -337,19 +352,13 @@ We define a few wired-in type constructors here to avoid module knots \begin{code} funTyCon = mkFunTyCon funTyConName (mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind) + -- You might think that (->) should have type (? -> ? -> *), and you'd be right + -- But if we do that we get kind errors when saying + -- instance Control.Arrow (->) + -- becuase the expected kind is (*->*->*). The trouble is that the + -- expected/actual stuff in the unifier does not go contra-variant, whereas + -- the kind sub-typing does. Sigh. It really only matters if you use (->) in + -- a prefix way, thus: (->) Int# Int#. And this is unusual. \end{code} ------------------------------------------- -Usage tycons @.@ and @!@ - -The usage tycons are of kind usageTypeKind (`$'). The types contain -no values, and are used purely for usage annotation. - -\begin{code} -usOnceTyCon = mkKindCon usOnceTyConName usageTypeKind -usOnce = TyConApp usOnceTyCon [] - -usManyTyCon = mkKindCon usManyTyConName usageTypeKind -usMany = TyConApp usManyTyCon [] -\end{code}