Skip to content

GitLab

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

Massive patch for the first months work adding System FC to GHC #35 

Broken up massive patch -=chak
Original log message:  
This is (sadly) all done in one patch to avoid Darcs bugs.
It's not complete work... more FC stuff to come.  A compiler
using just this patch will fail dismally.
parent f3c4792f
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 627 additions and 785 deletions
compiler/types/Class.lhs
View file @ c76c69c5
......@@ -5,9 +5,11 @@
\begin{code}
module Class (
Class, ClassOpItem, FunDep,
Class, ClassOpItem,
DefMeth (..),
FunDep, pprFundeps,
mkClass, classTyVars, classArity,
classKey, className, classSelIds, classTyCon, classMethods,
classBigSig, classExtraBigSig, classTvsFds, classSCTheta
......@@ -159,6 +161,12 @@ instance Outputable DefMeth where
ppr DefMeth = text "{- has default method -}"
ppr GenDefMeth = text "{- has generic method -}"
ppr NoDefMeth = empty -- No default method
\end{code}
pprFundeps :: Outputable a => [FunDep a] -> SDoc
pprFundeps [] = empty
pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))
where
ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"),
interppSP vs]
\end{code}
compiler/types/FunDeps.lhs
View file @ c76c69c5
......@@ -17,8 +17,8 @@ module FunDeps (
import Name ( Name, getSrcLoc )
import Var ( TyVar )
import Class ( Class, FunDep, classTvsFds )
import Unify ( tcUnifyTys, BindFlag(..) )
import Class ( Class, FunDep, pprFundeps, classTvsFds )
import TcGadt ( tcUnifyTys, BindFlag(..) )
import Type ( substTys, notElemTvSubst )
import TcType ( Type, PredType(..), tcEqType,
predTyUnique, mkClassPred, tyVarsOfTypes, tyVarsOfPred )
......@@ -485,17 +485,4 @@ trimRoughMatchTcs clas_tvs (ltvs,_) mb_tcs
\end{code}
%************************************************************************
%* *
\subsection{Miscellaneous}
%* *
%************************************************************************
\begin{code}
pprFundeps :: Outputable a => [FunDep a] -> SDoc
pprFundeps [] = empty
pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))
ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"), interppSP vs]
\end{code}
compiler/types/InstEnv.lhs
View file @ c76c69c5
......@@ -33,8 +33,10 @@ import TcType ( Type, PredType, tcEqType,
tyClsNamesOfType, tcSplitTyConApp_maybe
)
import TyCon ( tyConName )
import Unify ( tcMatchTys, tcUnifyTys, BindFlag(..) )
import TcGadt ( tcUnifyTys, BindFlag(..) )
import Unify ( tcMatchTys )
import Outputable
import BasicTypes ( OverlapFlag(..) )
import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM )
import Id ( idType, idName )
import SrcLoc ( pprDefnLoc )
......@@ -61,7 +63,8 @@ data Instance
, is_tys :: [Type] -- Full arg types
, is_dfun :: DFunId
, is_flag :: OverlapFlag
, is_flag :: OverlapFlag -- See detailed comments with
-- the decl of BasicTypes.OverlapFlag
, is_orph :: Maybe OccName }
......@@ -213,39 +216,6 @@ instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
-- False is non-committal
instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
instanceCantMatch ts as = False -- Safe
---------------------------------------------------
data OverlapFlag
= NoOverlap -- This instance must not overlap another
| OverlapOk -- Silently ignore this instance if you find a
-- more specific one that matches the constraint
-- you are trying to resolve
--
-- Example: constraint (Foo [Int])
-- instances (Foo [Int])
-- (Foo [a]) OverlapOk
-- Since the second instance has the OverlapOk flag,
-- the first instance will be chosen (otherwise
-- its ambiguous which to choose)
| Incoherent -- Like OverlapOk, but also ignore this instance
-- if it doesn't match the constraint you are
-- trying to resolve, but could match if the type variables
-- in the constraint were instantiated
--
-- Example: constraint (Foo [b])
-- instances (Foo [Int]) Incoherent
-- (Foo [a])
-- Without the Incoherent flag, we'd complain that
-- instantiating 'b' would change which instance
-- was chosen
deriving( Eq )
instance Outputable OverlapFlag where
ppr NoOverlap = empty
ppr OverlapOk = ptext SLIT("[overlap ok]")
ppr Incoherent = ptext SLIT("[incoherent]")
\end{code}
......
compiler/types/Kind.lhs deleted 100644 → 0
View file @ f3c4792f
%
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\begin{code}
module Kind (
Kind(..), SimpleKind,
openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
argTypeKind, ubxTupleKind,
isLiftedTypeKind, isUnliftedTypeKind, isUnliftedBoxedTypeKind,
isArgTypeKind, isOpenTypeKind,
mkArrowKind, mkArrowKinds,
isSubKind, defaultKind,
kindFunResult, splitKindFunTys,
KindVar, mkKindVar, kindVarRef, kindVarUniq,
kindVarOcc, setKindVarOcc,
pprKind, pprParendKind
) where
#include "HsVersions.h"
import Unique ( Unique )
import OccName ( OccName, mkOccName, tvName )
import Outputable
import DATA_IOREF
\end{code}
Kinds
~~~~~
There's a little subtyping at the kind level:
?
/ \
/ \
?? (#)
/ | \
* ! #
where * [LiftedTypeKind] means boxed type
# [UnboxedTypeKind] means unboxed type
(#) [UbxTupleKind] means unboxed tuple
?? [ArgTypeKind] is the lub of *,#
? [OpenTypeKind] means any type at all
In particular:
error :: forall a:?. String -> a
(->) :: ?? -> ? -> *
(\(x::t) -> ...) Here t::?? (i.e. not unboxed tuple)
\begin{code}
data Kind
= LiftedTypeKind -- *
| OpenTypeKind -- ?
| UnboxedTypeKind -- #
| UnliftedTypeKind -- !
| UbxTupleKind -- (##)
| ArgTypeKind -- ??
| FunKind Kind Kind -- k1 -> k2
| KindVar KindVar
deriving( Eq )
data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-- INVARIANT: a KindVar can only be instantiated by a SimpleKind
type SimpleKind = Kind
-- A SimpleKind has no ? or # kinds in it:
-- sk ::= * | sk1 -> sk2 | kvar
instance Eq KindVar where
(KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
mkKindVar :: Unique -> IORef (Maybe Kind) -> KindVar
mkKindVar u r = KVar u kind_var_occ r
kindVarRef :: KindVar -> IORef (Maybe Kind)
kindVarRef (KVar _ _ ref) = ref
kindVarUniq :: KindVar -> Unique
kindVarUniq (KVar uniq _ _) = uniq
kindVarOcc :: KindVar -> OccName
kindVarOcc (KVar _ occ _) = occ
setKindVarOcc :: KindVar -> OccName -> KindVar
setKindVarOcc (KVar u _ r) occ = KVar u occ r
kind_var_occ :: OccName -- Just one for all KindVars
-- They may be jiggled by tidying
kind_var_occ = mkOccName tvName "k"
\end{code}
Kind inference
~~~~~~~~~~~~~~
During kind inference, a kind variable unifies only with
a "simple kind", sk
sk ::= * | sk1 -> sk2
For example
data T a = MkT a (T Int#)
fails. We give T the kind (k -> *), and the kind variable k won't unify
with # (the kind of Int#).
Type inference
~~~~~~~~~~~~~~
When creating a fresh internal type variable, we give it a kind to express
constraints on it. E.g. in (\x->e) we make up a fresh type variable for x,
with kind ??.
During unification we only bind an internal type variable to a type
whose kind is lower in the sub-kind hierarchy than the kind of the tyvar.
When unifying two internal type variables, we collect their kind constraints by
finding the GLB of the two. Since the partial order is a tree, they only
have a glb if one is a sub-kind of the other. In that case, we bind the
less-informative one to the more informative one. Neat, eh?
\begin{code}
liftedTypeKind = LiftedTypeKind
unboxedTypeKind = UnboxedTypeKind
unliftedTypeKind = UnliftedTypeKind
openTypeKind = OpenTypeKind
argTypeKind = ArgTypeKind
ubxTupleKind = UbxTupleKind
mkArrowKind :: Kind -> Kind -> Kind
mkArrowKind k1 k2 = k1 `FunKind` k2
mkArrowKinds :: [Kind] -> Kind -> Kind
mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
\end{code}
%************************************************************************
%* *
Functions over Kinds
%* *
%************************************************************************
\begin{code}
kindFunResult :: Kind -> Kind
kindFunResult (FunKind _ k) = k
kindFunResult k = pprPanic "kindFunResult" (ppr k)
splitKindFunTys :: Kind -> ([Kind],Kind)
splitKindFunTys (FunKind k1 k2) = case splitKindFunTys k2 of
(as, r) -> (k1:as, r)
splitKindFunTys k = ([], k)
isLiftedTypeKind, isUnliftedTypeKind :: Kind -> Bool
isLiftedTypeKind LiftedTypeKind = True
isLiftedTypeKind other = False
isUnliftedBoxedTypeKind UnliftedTypeKind = True
isUnliftedBoxedTypeKind other = False
isUnliftedTypeKind UnliftedTypeKind = True
isUnliftedTypeKind UnboxedTypeKind = True
isUnliftedTypeKind other = False
isArgTypeKind :: Kind -> Bool
-- True of any sub-kind of ArgTypeKind
isArgTypeKind LiftedTypeKind = True
isArgTypeKind UnliftedTypeKind = True
isArgTypeKind UnboxedTypeKind = True
isArgTypeKind ArgTypeKind = True
isArgTypeKind other = False
isOpenTypeKind :: Kind -> Bool
-- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
isOpenTypeKind (FunKind _ _) = False
isOpenTypeKind (KindVar _) = False -- This is a conservative answer
-- It matters in the call to isSubKind in
-- checkExpectedKind.
isOpenTypeKind other = True
isSubKind :: Kind -> Kind -> Bool
-- (k1 `isSubKind` k2) checks that k1 <: k2
isSubKind LiftedTypeKind LiftedTypeKind = True
isSubKind UnliftedTypeKind UnliftedTypeKind = True
isSubKind UnboxedTypeKind UnboxedTypeKind = True
isSubKind UbxTupleKind UbxTupleKind = True
isSubKind k1 OpenTypeKind = isOpenTypeKind k1
isSubKind k1 ArgTypeKind = isArgTypeKind k1
isSubKind (FunKind a1 r1) (FunKind a2 r2) = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
isSubKind k1 k2 = False
defaultKind :: Kind -> Kind
-- Used when generalising: default kind '?' and '??' to '*'
--
-- When we generalise, we make generic type variables whose kind is
-- simple (* or *->* etc). So generic type variables (other than
-- built-in constants like 'error') always have simple kinds. This is important;
-- consider
-- f x = True
-- We want f to get type
-- f :: forall (a::*). a -> Bool
-- Not
-- f :: forall (a::??). a -> Bool
-- because that would allow a call like (f 3#) as well as (f True),
--and the calling conventions differ. This defaulting is done in TcMType.zonkTcTyVarBndr.
defaultKind OpenTypeKind = LiftedTypeKind
defaultKind ArgTypeKind = LiftedTypeKind
defaultKind kind = kind
\end{code}
%************************************************************************
%* *
Pretty printing
%* *
%************************************************************************
\begin{code}
instance Outputable KindVar where
ppr (KVar uniq occ _) = ppr occ <> ifPprDebug (ppr uniq)
instance Outputable Kind where
ppr k = pprKind k
pprParendKind :: Kind -> SDoc
pprParendKind k@(FunKind _ _) = parens (pprKind k)
pprParendKind k = pprKind k
pprKind (KindVar v) = ppr v
pprKind LiftedTypeKind = ptext SLIT("*")
pprKind UnliftedTypeKind = ptext SLIT("!")
pprKind UnboxedTypeKind = ptext SLIT("#")
pprKind OpenTypeKind = ptext SLIT("?")
pprKind ArgTypeKind = ptext SLIT("??")
pprKind UbxTupleKind = ptext SLIT("(#)")
pprKind (FunKind k1 k2) = sep [ pprParendKind k1, arrow <+> pprKind k2]
\end{code}
compiler/types/TyCon.lhs
View file @ c76c69c5
......@@ -14,12 +14,13 @@ module TyCon(
isFunTyCon, isUnLiftedTyCon, isProductTyCon,
isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
isEnumerationTyCon,
isEnumerationTyCon, isGadtSyntaxTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
isRecursiveTyCon, newTyConRep, newTyConRhs,
isHiBootTyCon,
isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo,
isHiBootTyCon, isSuperKindTyCon,
isCoercionTyCon_maybe, isCoercionTyCon,
tcExpandTyCon_maybe, coreExpandTyCon_maybe,
tcExpandTyCon_maybe, coreExpandTyCon_maybe, stgExpandTyCon_maybe,
makeTyConAbstract, isAbstractTyCon,
......@@ -29,9 +30,12 @@ module TyCon(
mkClassTyCon,
mkFunTyCon,
mkPrimTyCon,
mkVoidPrimTyCon,
mkLiftedPrimTyCon,
mkTupleTyCon,
mkSynTyCon,
mkSuperKindTyCon,
mkCoercionTyCon,
tyConName,
tyConKind,
......@@ -54,16 +58,11 @@ module TyCon(
#include "HsVersions.h"
import {-# SOURCE #-} TypeRep ( Type, PredType )
-- Should just be Type(Type), but this fails due to bug present up to
-- and including 4.02 involving slurping of hi-boot files. Bug is now fixed.
import {-# SOURCE #-} TypeRep ( Kind, Type, Coercion, PredType )
import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
import Var ( TyVar, Id )
import Class ( Class )
import Kind ( Kind )
import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed )
import Name ( Name, nameUnique, NamedThing(getName) )
import PrelNames ( Unique, Uniquable(..) )
......@@ -102,6 +101,10 @@ data TyCon
algTcSelIds :: [Id], -- Its record selectors (empty if none):
algTcGadtSyntax :: Bool, -- True <=> the data type was declared using GADT syntax
-- That doesn't mean it's a true GADT; only that the "where"
-- form was used. This field is used only to guide
-- pretty-printinng
algTcStupidTheta :: [PredType], -- The "stupid theta" for the data type
-- (always empty for GADTs)
......@@ -117,8 +120,33 @@ data TyCon
-- Just cl if this tycon came from a class declaration
}
| TupleTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
tyConBoxed :: Boxity,
tyConTyVars :: [TyVar],
dataCon :: DataCon,
hasGenerics :: Bool
}
| SynTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
tyConTyVars :: [TyVar], -- Bound tyvars
synTcRhs :: Type, -- Right-hand side, mentioning these type vars.
-- Acts as a template for the expansion when
-- the tycon is applied to some types.
argVrcs :: ArgVrcs
}
| PrimTyCon { -- Primitive types; cannot be defined in Haskell
-- Now includes foreign-imported types
-- Also includes Kinds
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
......@@ -134,29 +162,23 @@ data TyCon
tyConExtName :: Maybe FastString -- Just xx for foreign-imported types
}
| TupleTyCon {
| CoercionTyCon { -- E.g. (:=:), sym, trans, left, right
-- INVARIANT: coercions are always fully applied
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConName :: Name,
tyConArity :: Arity,
tyConBoxed :: Boxity,
tyConTyVars :: [TyVar],
dataCon :: DataCon,
hasGenerics :: Bool
coKindFun :: [Type] -> Kind
}
| SuperKindTyCon { -- Super Kinds, TY (box) and CO (diamond).
-- They have no kind; and arity zero
tyConUnique :: Unique,
tyConName :: Name
}
| SynTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
type KindCon = TyCon
tyConTyVars :: [TyVar], -- Bound tyvars
synTcRhs :: Type, -- Right-hand side, mentioning these type vars.
-- Acts as a template for the expansion when
-- the tycon is applied to some types.
argVrcs :: ArgVrcs
}
type SuperKindCon = TyCon
type FieldLabel = Name
......@@ -183,6 +205,11 @@ data AlgTyConRhs
nt_rhs :: Type, -- Cached: the argument type of the constructor
-- = the representation type of the tycon
-- The free tyvars of this type are the tyConTyVars
nt_co :: TyCon, -- The coercion used to create the newtype
-- from the representation
-- See Note [Newtype coercions]
nt_etad_rhs :: ([TyVar], Type) ,
-- The same again, but this time eta-reduced
......@@ -211,6 +238,20 @@ visibleDataCons (DataTyCon{ data_cons = cs }) = cs
visibleDataCons (NewTyCon{ data_con = c }) = [c]
\end{code}
Note [Newtype coercions]
~~~~~~~~~~~~~~~~~~~~~~~~
The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
which is used for coercing from the representation type of the
newtype, to the newtype itself. For example,
newtype T a = MkT [a]
the NewTyCon for T will contain nt_co = CoT where CoT t : [t] :=: T t.
This TyCon is a CoercionTyCon, so it does not have a kind on its own;
it basically has its own typing rule for the fully-applied version.
If the newtype T has k type variables then CoT has arity k.
Note [Newtype eta]
~~~~~~~~~~~~~~~~~~
Consider
......@@ -304,7 +345,7 @@ mkFunTyCon name kind
-- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
-- but now you also have to pass in the generic information about the type
-- constructor - you can get hold of it easily (see Generics module)
mkAlgTyCon name kind tyvars argvrcs stupid rhs sel_ids is_rec gen_info
mkAlgTyCon name kind tyvars argvrcs stupid rhs sel_ids is_rec gen_info gadt_syn
= AlgTyCon {
tyConName = name,
tyConUnique = nameUnique name,
......@@ -317,6 +358,7 @@ mkAlgTyCon name kind tyvars argvrcs stupid rhs sel_ids is_rec gen_info
algTcSelIds = sel_ids,
algTcClass = Nothing,
algTcRec = is_rec,
algTcGadtSyntax = gadt_syn,
hasGenerics = gen_info
}
......@@ -333,6 +375,7 @@ mkClassTyCon name kind tyvars argvrcs rhs clas is_rec
algTcSelIds = [],
algTcClass = Just clas,
algTcRec = is_rec,
algTcGadtSyntax = False, -- Doesn't really matter
hasGenerics = False
}
......@@ -370,6 +413,9 @@ mkForeignTyCon name ext_name kind arity arg_vrcs
mkPrimTyCon name kind arity arg_vrcs rep
= mkPrimTyCon' name kind arity arg_vrcs rep True
mkVoidPrimTyCon name kind arity arg_vrcs
= mkPrimTyCon' name kind arity arg_vrcs VoidRep True
-- but RealWorld is lifted
mkLiftedPrimTyCon name kind arity arg_vrcs rep
= mkPrimTyCon' name kind arity arg_vrcs rep False
......@@ -396,6 +442,21 @@ mkSynTyCon name kind tyvars rhs argvrcs
synTcRhs = rhs,
argVrcs = argvrcs
}
mkCoercionTyCon name arity kindRule
= CoercionTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConArity = arity,
coKindFun = kindRule
}
-- Super kinds always have arity zero
mkSuperKindTyCon name
= SuperKindTyCon {
tyConName = name,
tyConUnique = nameUnique name
}
\end{code}
\begin{code}
......@@ -467,6 +528,10 @@ isSynTyCon :: TyCon -> Bool
isSynTyCon (SynTyCon {}) = True
isSynTyCon _ = False
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
isGadtSyntaxTyCon other = False
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
isEnumerationTyCon other = False
......@@ -506,6 +571,18 @@ isForeignTyCon :: TyCon -> Bool
-- isForeignTyCon identifies foreign-imported type constructors
isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
isForeignTyCon other = False
isSuperKindTyCon :: TyCon -> Bool
isSuperKindTyCon (SuperKindTyCon {}) = True
isSuperKindTyCon other = False
isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> Kind)
isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule})
= Just (ar, rule)
isCoercionTyCon_maybe other = Nothing
isCoercionTyCon (CoercionTyCon {}) = True
isCoercionTyCon other = False
\end{code}
......@@ -527,15 +604,26 @@ tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, synTcRhs = rhs }) tys
tcExpandTyCon_maybe other_tycon tys = Nothing
---------------
-- For the *Core* view, we expand synonyms *and* non-recursive newtypes
-- For the *Core* view, we expand synonyms only as well
{-
coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive, -- Not recursive
algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys
= case etad_rhs of -- Don't do this in the pattern match, lest we accidentally
-- match the etad_rhs of a *recursive* newtype
(tvs,rhs) -> expand tvs rhs tys
-}
coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
---------------
-- For the *STG* view, we expand synonyms *and* non-recursive newtypes
stgExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive, -- Not recursive
algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys
= case etad_rhs of -- Don't do this in the pattern match, lest we accidentally
-- match the etad_rhs of a *recursive* newtype
(tvs,rhs) -> expand tvs rhs tys
stgExpandTyCon_maybe tycon tys = coreExpandTyCon_maybe tycon tys
----------------
expand :: [TyVar] -> Type -- Template
-> [Type] -- Args
......@@ -593,6 +681,10 @@ newTyConRep :: TyCon -> ([TyVar], Type)
newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
newTyConCo :: TyCon -> TyCon
newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }}) = co
newTyConCo tycon = pprPanic "newTyConCo" (ppr tycon)
tyConPrimRep :: TyCon -> PrimRep
tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
......
compiler/types/Type.lhs
View file @ c76c69c5
This diff is collapsed.
compiler/types/TypeRep.lhs
View file @ c76c69c5
......@@ -17,29 +17,51 @@ module TypeRep (
pprType, pprParendType, pprTyThingCategory,
pprPred, pprTheta, pprThetaArrow, pprClassPred,
-- Re-export fromKind
-- Kinds
liftedTypeKind, unliftedTypeKind, openTypeKind,
isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
argTypeKind, ubxTupleKind,
isLiftedTypeKindCon, isLiftedTypeKind,
mkArrowKind, mkArrowKinds,
-- Kind constructors...