s/boxed/lifted/
The typechecker's notion of "boxed" versus "unboxed" kind should
really have been "unlifted" versus "lifted" instead. It is illegal to
unify an unlifted (but boxed) type with a polymorphic type variable,
since an unlifted/boxed type is always assumed to be a pointer to the
object itself, never a thunk or indirection.
This commit removes isUnboxedType, and renames a bunch of things that
were previously boxed/unboxed to unlifted/lifted.
20 files changed:
import Class ( FunDep )
import Type ( Type, Kind, PredType(..), ClassContext,
import Class ( FunDep )
import Type ( Type, Kind, PredType(..), ClassContext,
- splitSigmaTy, boxedTypeKind
+ splitSigmaTy, liftedTypeKind
)
import TypeRep ( Type(..), TyNote(..) ) -- toHsType sees the representation
import TyCon ( isTupleTyCon, tupleTyConBoxity, tyConArity, getSynTyConDefn )
)
import TypeRep ( Type(..), TyNote(..) ) -- toHsType sees the representation
import TyCon ( isTupleTyCon, tupleTyConBoxity, tyConArity, getSynTyConDefn )
ppr (HsPIParam n ty) = hsep [char '?' <> ppr n, text "::", ppr ty]
pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
ppr (HsPIParam n ty) = hsep [char '?' <> ppr n, text "::", ppr ty]
pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
-pprHsTyVarBndr name kind | kind == boxedTypeKind = ppr name
- | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
+pprHsTyVarBndr name kind | kind == liftedTypeKind = ppr name
+ | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
pprHsForAll [] [] = empty
pprHsForAll tvs cxt
pprHsForAll [] [] = empty
pprHsForAll tvs cxt
usManyTyConName = kindQual SLIT("!") usManyTyConKey
superKindName = kindQual SLIT("KX") kindConKey
superBoxityName = kindQual SLIT("BX") boxityConKey
usManyTyConName = kindQual SLIT("!") usManyTyConKey
superKindName = kindQual SLIT("KX") kindConKey
superBoxityName = kindQual SLIT("BX") boxityConKey
-boxedConName = kindQual SLIT("*") boxedConKey
-unboxedConName = kindQual SLIT("#") unboxedConKey
+liftedConName = kindQual SLIT("*") liftedConKey
+unliftedConName = kindQual SLIT("#") unliftedConKey
openKindConName = kindQual SLIT("?") anyBoxConKey
usageKindConName = kindQual SLIT("$") usageConKey
typeConName = kindQual SLIT("Type") typeConKey
openKindConName = kindQual SLIT("?") anyBoxConKey
usageKindConName = kindQual SLIT("$") usageConKey
typeConName = kindQual SLIT("Type") typeConKey
word32TyConKey = mkPreludeTyConUnique 61
word64PrimTyConKey = mkPreludeTyConUnique 62
word64TyConKey = mkPreludeTyConUnique 63
word32TyConKey = mkPreludeTyConUnique 61
word64PrimTyConKey = mkPreludeTyConUnique 62
word64TyConKey = mkPreludeTyConUnique 63
-boxedConKey = mkPreludeTyConUnique 64
-unboxedConKey = mkPreludeTyConUnique 65
+liftedConKey = mkPreludeTyConUnique 64
+unliftedConKey = mkPreludeTyConUnique 65
anyBoxConKey = mkPreludeTyConUnique 66
kindConKey = mkPreludeTyConUnique 67
boxityConKey = mkPreludeTyConUnique 68
anyBoxConKey = mkPreludeTyConUnique 66
kindConKey = mkPreludeTyConUnique 67
boxityConKey = mkPreludeTyConUnique 68
import PrimRep ( PrimRep(..), isFollowableRep )
import TyCon ( TyCon, ArgVrcs, mkPrimTyCon )
import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
import PrimRep ( PrimRep(..), isFollowableRep )
import TyCon ( TyCon, ArgVrcs, mkPrimTyCon )
import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
- unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds
+ unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKinds
)
import Unique ( mkAlphaTyVarUnique )
import PrelNames
)
import Unique ( mkAlphaTyVarUnique )
import PrelNames
\begin{code}
alphaTyVars :: [TyVar]
\begin{code}
alphaTyVars :: [TyVar]
-alphaTyVars = [ mkSysTyVar u boxedTypeKind
+alphaTyVars = [ mkSysTyVar u liftedTypeKind
| u <- map mkAlphaTyVarUnique [2..] ]
betaTyVars = tail alphaTyVars
| u <- map mkAlphaTyVarUnique [2..] ]
betaTyVars = tail alphaTyVars
(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
-- openAlphaTyVar is prepared to be instantiated
(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
-- openAlphaTyVar is prepared to be instantiated
- -- to a boxed or unboxed type variable. It's used for the
+ -- to a lifted or unlifted type variable. It's used for the
-- result type for "error", so that we can have (error Int# "Help")
openAlphaTyVar :: TyVar
openAlphaTyVar = mkSysTyVar (mkAlphaTyVarUnique 1) openTypeKind
-- result type for "error", so that we can have (error Int# "Help")
openAlphaTyVar :: TyVar
openAlphaTyVar = mkSysTyVar (mkAlphaTyVarUnique 1) openTypeKind
pcPrimTyCon name arity arg_vrcs rep
= the_tycon
where
pcPrimTyCon name arity arg_vrcs rep
= the_tycon
where
- the_tycon = mkPrimTyCon name kind arity arg_vrcs rep
- kind = mkArrowKinds (take arity (repeat boxedTypeKind)) result_kind
- result_kind | isFollowableRep rep = boxedTypeKind -- Represented by a GC-ish ptr
- | otherwise = unboxedTypeKind -- Represented by a non-ptr
+ the_tycon = mkPrimTyCon name kind arity arg_vrcs rep
+ kind = mkArrowKinds (take arity (repeat liftedTypeKind)) result_kind
+ result_kind = unliftedTypeKind -- all primitive types are unlifted
charPrimTy = mkTyConTy charPrimTyCon
charPrimTyCon = pcPrimTyCon charPrimTyConName 0 [] CharRep
charPrimTy = mkTyConTy charPrimTyCon
charPrimTyCon = pcPrimTyCon charPrimTyConName 0 [] CharRep
%* *
%************************************************************************
%* *
%************************************************************************
-State# is the primitive, unboxed type of states. It has one type parameter,
+State# is the primitive, unlifted type of states. It has one type parameter,
statePrimTyCon = pcPrimTyCon statePrimTyConName 1 vrcsZ VoidRep
\end{code}
statePrimTyCon = pcPrimTyCon statePrimTyConName 1 vrcsZ VoidRep
\end{code}
-@_RealWorld@ is deeply magical. It {\em is primitive}, but it
-{\em is not unboxed} (hence PtrRep).
-We never manipulate values of type RealWorld; it's only used in the type
-system, to parameterise State#.
+RealWorld is deeply magical. It is *primitive*, but it is not
+*unlifted* (hence PrimPtrRep). We never manipulate values of type
+RealWorld; it's only used in the type system, to parameterise State#.
+realWorldTyCon = mkPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep
realWorldTy = mkTyConTy realWorldTyCon
realWorldTy = mkTyConTy realWorldTyCon
-realWorldTyCon = pcPrimTyCon realWorldTyConName 0 [] PrimPtrRep
realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld
\end{code}
realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld
\end{code}
primitive TyCon for a given PrimRep.
\begin{code}
primitive TyCon for a given PrimRep.
\begin{code}
-primRepTyCon CharRep = charPrimTyCon
-primRepTyCon Int8Rep = charPrimTyCon
-primRepTyCon IntRep = intPrimTyCon
-primRepTyCon WordRep = wordPrimTyCon
-primRepTyCon Int64Rep = int64PrimTyCon
-primRepTyCon Word64Rep = word64PrimTyCon
-primRepTyCon AddrRep = addrPrimTyCon
-primRepTyCon FloatRep = floatPrimTyCon
-primRepTyCon DoubleRep = doublePrimTyCon
+primRepTyCon CharRep = charPrimTyCon
+primRepTyCon Int8Rep = charPrimTyCon
+primRepTyCon IntRep = intPrimTyCon
+primRepTyCon WordRep = wordPrimTyCon
+primRepTyCon Int64Rep = int64PrimTyCon
+primRepTyCon Word64Rep = word64PrimTyCon
+primRepTyCon AddrRep = addrPrimTyCon
+primRepTyCon FloatRep = floatPrimTyCon
+primRepTyCon DoubleRep = doublePrimTyCon
primRepTyCon StablePtrRep = stablePtrPrimTyCon
primRepTyCon ForeignObjRep = foreignObjPrimTyCon
primRepTyCon StablePtrRep = stablePtrPrimTyCon
primRepTyCon ForeignObjRep = foreignObjPrimTyCon
-primRepTyCon WeakPtrRep = weakPrimTyCon
-primRepTyCon other = pprPanic "primRepTyCon" (ppr other)
+primRepTyCon WeakPtrRep = weakPrimTyCon
+primRepTyCon other = pprPanic "primRepTyCon" (ppr other)
import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed )
import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTys,
import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed )
import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTys,
- mkArrowKinds, boxedTypeKind, unboxedTypeKind,
+ mkArrowKinds, liftedTypeKind, unliftedTypeKind,
splitTyConApp_maybe, repType,
TauType, ClassContext )
import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique )
splitTyConApp_maybe, repType,
TauType, ClassContext )
import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique )
gen_info
mod = nameModule name
gen_info
mod = nameModule name
- kind = mkArrowKinds (map tyVarKind tyvars) boxedTypeKind
+ kind = mkArrowKinds (map tyVarKind tyvars) liftedTypeKind
gen_info = mk_tc_gen_info mod (nameUnique name) name tycon
-- We generate names for the generic to/from Ids by incrementing
gen_info = mk_tc_gen_info mod (nameUnique name) name tycon
-- We generate names for the generic to/from Ids by incrementing
tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info
tc_name = mkWiredInName mod (mkOccFS tcName name_str) tc_uniq
tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info
tc_name = mkWiredInName mod (mkOccFS tcName name_str) tc_uniq
tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
- res_kind | isBoxed boxity = boxedTypeKind
- | otherwise = unboxedTypeKind
+ res_kind | isBoxed boxity = liftedTypeKind
+ | otherwise = unliftedTypeKind
tyvars | isBoxed boxity = take arity alphaTyVars
| otherwise = take arity openAlphaTyVars
tyvars | isBoxed boxity = take arity alphaTyVars
| otherwise = take arity openAlphaTyVars
--
-- data Void = -- No constructors!
--
--
-- data Void = -- No constructors!
--
--- ) It's boxed; there is only one value of this
+-- ) It's lifted; there is only one value of this
-- type, namely "void", whose semantics is just bottom.
--
-- Haskell 98 drops the definition of a Void type, so we just 'simulate'
-- type, namely "void", whose semantics is just bottom.
--
-- Haskell 98 drops the definition of a Void type, so we just 'simulate'
)
import CostCentre ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
import CallConv ( cCallConv )
)
import CostCentre ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
import CallConv ( cCallConv )
-import Type ( Kind, mkArrowKind, boxedTypeKind, openTypeKind, usageTypeKind )
+import Type ( Kind, mkArrowKind, liftedTypeKind, openTypeKind, usageTypeKind )
import IdInfo ( exactArity, InlinePragInfo(..) )
import PrimOp ( CCall(..), CCallTarget(..) )
import Lex
import IdInfo ( exactArity, InlinePragInfo(..) )
import PrimOp ( CCall(..), CCallTarget(..) )
import Lex
tv_bndr :: { HsTyVarBndr RdrName }
: tv_name '::' akind { IfaceTyVar $1 $3 }
tv_bndr :: { HsTyVarBndr RdrName }
: tv_name '::' akind { IfaceTyVar $1 $3 }
- | tv_name { IfaceTyVar $1 boxedTypeKind }
+ | tv_name { IfaceTyVar $1 liftedTypeKind }
tv_bndrs :: { [HsTyVarBndr RdrName] }
: tv_bndrs1 { $1 }
tv_bndrs :: { [HsTyVarBndr RdrName] }
: tv_bndrs1 { $1 }
akind :: { Kind }
: VARSYM { if $1 == SLIT("*") then
akind :: { Kind }
: VARSYM { if $1 == SLIT("*") then
else if $1 == SLIT("?") then
openTypeKind
else if $1 == SLIT("\36") then
else if $1 == SLIT("?") then
openTypeKind
else if $1 == SLIT("\36") then
core_tv_bndr :: { UfBinder RdrName }
core_tv_bndr : '@' tv_name '::' akind { UfTyBinder $2 $4 }
core_tv_bndr :: { UfBinder RdrName }
core_tv_bndr : '@' tv_name '::' akind { UfTyBinder $2 $4 }
- | '@' tv_name { UfTyBinder $2 boxedTypeKind }
+ | '@' tv_name { UfTyBinder $2 liftedTypeKind }
ccall_string :: { FAST_STRING }
: STRING { $1 }
ccall_string :: { FAST_STRING }
: STRING { $1 }
import Type ( mkTyVarTy, tyVarsOfTypes, mkTyConApp,
mkForAllTys, mkFunTys,
mkPredTy, mkForAllTy, isUnLiftedType,
import Type ( mkTyVarTy, tyVarsOfTypes, mkTyConApp,
mkForAllTys, mkFunTys,
mkPredTy, mkForAllTy, isUnLiftedType,
- isUnboxedType, unboxedTypeKind, boxedTypeKind, openTypeKind
+ unliftedTypeKind, liftedTypeKind, openTypeKind
)
import FunDeps ( oclose )
import Var ( tyVarKind )
)
import FunDeps ( oclose )
import Var ( tyVarKind )
-- Create specialisations of functions bound here
-- We want to keep non-recursive things non-recursive
-- Create specialisations of functions bound here
-- We want to keep non-recursive things non-recursive
- -- so that we desugar unboxed bindings correctly
+ -- so that we desugar unlifted bindings correctly
case (top_lvl, is_rec) of
-- For the top level don't bother will all this bindInstsOfLocalFuns stuff
case (top_lvl, is_rec) of
-- For the top level don't bother will all this bindInstsOfLocalFuns stuff
-- If typechecking the binds fails, then return with each
-- signature-less binder given type (forall a.a), to minimise subsequent
-- error messages
-- If typechecking the binds fails, then return with each
-- signature-less binder given type (forall a.a), to minimise subsequent
-- error messages
- newTyVar boxedTypeKind `thenNF_Tc` \ alpha_tv ->
+ newTyVar liftedTypeKind `thenNF_Tc` \ alpha_tv ->
let
forall_a_a = mkForAllTy alpha_tv (mkTyVarTy alpha_tv)
binder_names = collectMonoBinders mbind
let
forall_a_a = mkForAllTy alpha_tv (mkTyVarTy alpha_tv)
binder_names = collectMonoBinders mbind
getTyVarsToGen is_unrestricted mono_id_tys lie_req `thenNF_Tc` \ (tyvars_not_to_gen, tyvars_to_gen) ->
-- Finally, zonk the generalised type variables to real TyVars
getTyVarsToGen is_unrestricted mono_id_tys lie_req `thenNF_Tc` \ (tyvars_not_to_gen, tyvars_to_gen) ->
-- Finally, zonk the generalised type variables to real TyVars
- -- This commits any unbound kind variables to boxed kind
+ -- This commits any unbound kind variables to lifted kind
-- I'm a little worried that such a kind variable might be
-- free in the environment, but I don't think it's possible for
-- this to happen when the type variable is not free in the envt
-- I'm a little worried that such a kind variable might be
-- free in the environment, but I don't think it's possible for
-- this to happen when the type variable is not free in the envt
- ASSERT( not (any ((== unboxedTypeKind) . tyVarKind) real_tyvars_to_gen_list) )
+ ASSERT( not (any ((== unliftedTypeKind) . tyVarKind) real_tyvars_to_gen_list) )
-- The instCantBeGeneralised stuff in tcSimplify should have
-- already raised an error if we're trying to generalise an
-- The instCantBeGeneralised stuff in tcSimplify should have
-- already raised an error if we're trying to generalise an
- -- unboxed tyvar (NB: unboxed tyvars are always introduced
+ -- unlifted tyvar (NB: unlifted tyvars are always introduced
-- along with a class constraint) and it's better done there
-- because we have more precise origin information.
-- That's why we just use an ASSERT here.
-- along with a class constraint) and it's better done there
-- because we have more precise origin information.
-- That's why we just use an ASSERT here.
pat_binders :: [Name]
pat_binders = collectMonoBinders (justPatBindings mbind EmptyMonoBinds)
in
pat_binders :: [Name]
pat_binders = collectMonoBinders (justPatBindings mbind EmptyMonoBinds)
in
- -- CHECK FOR UNBOXED BINDERS IN PATTERN BINDINGS
+ -- CHECK FOR UNLIFTED BINDERS IN PATTERN BINDINGS
mapTc (\id -> checkTc (not (idName id `elem` pat_binders
mapTc (\id -> checkTc (not (idName id `elem` pat_binders
- && isUnboxedType (idType id)))
- (unboxedPatBindErr id)) zonked_mono_ids
+ && isUnLiftedType (idType id)))
+ (unliftedPatBindErr id)) zonked_mono_ids
`thenTc_`
-- BUILD RESULTS
`thenTc_`
-- BUILD RESULTS
-- Figure out the appropriate kind for the pattern,
-- and generate a suitable type variable
kind = case is_rec of
-- Figure out the appropriate kind for the pattern,
-- and generate a suitable type variable
kind = case is_rec of
- Recursive -> boxedTypeKind -- Recursive, so no unboxed types
- NonRecursive -> openTypeKind -- Non-recursive, so we permit unboxed types
+ Recursive -> liftedTypeKind -- Recursive, so no unlifted types
+ NonRecursive -> openTypeKind -- Non-recursive, so we permit unlifted types
\end{code}
%************************************************************************
\end{code}
%************************************************************************
= -- First unify the main_id with IO t, for any old t
tcSetErrCtxt mainTyCheckCtxt (
tcLookupTyCon ioTyConName `thenTc` \ ioTyCon ->
= -- First unify the main_id with IO t, for any old t
tcSetErrCtxt mainTyCheckCtxt (
tcLookupTyCon ioTyConName `thenTc` \ ioTyCon ->
- newTyVarTy boxedTypeKind `thenNF_Tc` \ t_tv ->
+ newTyVarTy liftedTypeKind `thenNF_Tc` \ t_tv ->
unifyTauTy ((mkTyConApp ioTyCon [t_tv]))
(idType main_mono_id)
) `thenTc_`
unifyTauTy ((mkTyConApp ioTyCon [t_tv]))
(idType main_mono_id)
) `thenTc_`
nest 4 (ppr v <+> dcolon <+> ppr ty)]
-----------------------------------------------
nest 4 (ppr v <+> dcolon <+> ppr ty)]
-----------------------------------------------
-unboxedPatBindErr id
- = ptext SLIT("variable in a lazy pattern binding has unboxed type: ")
+unliftedPatBindErr id
+ = ptext SLIT("variable in a lazy pattern binding has unlifted type: ")
<+> quotes (ppr id)
-----------------------------------------------
<+> quotes (ppr id)
-----------------------------------------------
tyConTheta, maybeTyConSingleCon, isDataTyCon,
isEnumerationTyCon, TyCon
)
tyConTheta, maybeTyConSingleCon, isDataTyCon,
isEnumerationTyCon, TyCon
)
-import Type ( TauType, PredType(..), mkTyVarTys, mkTyConApp, isUnboxedType )
+import Type ( TauType, PredType(..), mkTyVarTys, mkTyConApp,
+ isUnLiftedType )
import Var ( TyVar )
import PrelNames
import Util ( zipWithEqual, sortLt )
import Var ( TyVar )
import PrelNames
import Util ( zipWithEqual, sortLt )
mk_constraints data_con
= [ (clas, [arg_ty])
| arg_ty <- dataConArgTys data_con tyvar_tys,
mk_constraints data_con
= [ (clas, [arg_ty])
| arg_ty <- dataConArgTys data_con tyvar_tys,
- not (isUnboxedType arg_ty) -- No constraints for unboxed types?
+ not (isUnLiftedType arg_ty) -- No constraints for unlifted types?
]
in
case chk_out clas tycon of
]
in
case chk_out clas tycon of
con2tag_Foo :: Foo ... -> Int#
tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int#
con2tag_Foo :: Foo ... -> Int#
tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int#
-maxtag_Foo :: Int -- ditto (NB: not unboxed)
+maxtag_Foo :: Int -- ditto (NB: not unlifted)
We have a @con2tag@ function for a tycon if:
We have a @con2tag@ function for a tycon if:
splitRhoTy,
isTauTy, tyVarsOfType, tyVarsOfTypes,
isSigmaTy, splitAlgTyConApp, splitAlgTyConApp_maybe,
splitRhoTy,
isTauTy, tyVarsOfType, tyVarsOfTypes,
isSigmaTy, splitAlgTyConApp, splitAlgTyConApp_maybe,
- boxedTypeKind, openTypeKind, mkArrowKind,
+ liftedTypeKind, openTypeKind, mkArrowKind,
tidyOpenType
)
import TyCon ( TyCon, tyConTyVars )
tidyOpenType
)
import TyCon ( TyCon, tyConTyVars )
newTyVarTys (length tv_idxs) openTypeKind `thenNF_Tc` \ arg_tys ->
tcMonoExprs args arg_tys `thenTc` \ (args', args_lie) ->
newTyVarTys (length tv_idxs) openTypeKind `thenNF_Tc` \ arg_tys ->
tcMonoExprs args arg_tys `thenTc` \ (args', args_lie) ->
- -- The argument types can be unboxed or boxed; the result
- -- type must, however, be boxed since it's an argument to the IO
+ -- The argument types can be unlifted or lifted; the result
+ -- type must, however, be lifted since it's an argument to the IO
- newTyVarTy boxedTypeKind `thenNF_Tc` \ result_ty ->
+ newTyVarTy liftedTypeKind `thenNF_Tc` \ result_ty ->
let
io_result_ty = mkTyConApp ioTyCon [result_ty]
in
let
io_result_ty = mkTyConApp ioTyCon [result_ty]
in
mk_inst_ty (tyvar, result_inst_ty)
| tyvar `elemVarSet` common_tyvars = returnNF_Tc result_inst_ty -- Same as result type
mk_inst_ty (tyvar, result_inst_ty)
| tyvar `elemVarSet` common_tyvars = returnNF_Tc result_inst_ty -- Same as result type
- | otherwise = newTyVarTy boxedTypeKind -- Fresh type
+ | otherwise = newTyVarTy liftedTypeKind -- Fresh type
in
mapNF_Tc mk_inst_ty (zip con_tyvars result_inst_tys) `thenNF_Tc` \ inst_tys ->
in
mapNF_Tc mk_inst_ty (zip con_tyvars result_inst_tys) `thenNF_Tc` \ inst_tys ->
ASSERT( not (null stmts) )
tcAddSrcLoc src_loc $
ASSERT( not (null stmts) )
tcAddSrcLoc src_loc $
- newTyVarTy (mkArrowKind boxedTypeKind boxedTypeKind) `thenNF_Tc` \ m ->
- newTyVarTy boxedTypeKind `thenNF_Tc` \ elt_ty ->
+ newTyVarTy (mkArrowKind liftedTypeKind liftedTypeKind) `thenNF_Tc` \ m ->
+ newTyVarTy liftedTypeKind `thenNF_Tc` \ elt_ty ->
unifyTauTy res_ty (mkAppTy m elt_ty) `thenTc_`
-- If it's a comprehension we're dealing with,
unifyTauTy res_ty (mkAppTy m elt_ty) `thenTc_`
-- If it's a comprehension we're dealing with,
import TcMonad
import TcEnv ( newLocalId )
import TcMonad
import TcEnv ( newLocalId )
-import TcMonoType ( tcHsBoxedSigType )
+import TcMonoType ( tcHsLiftedSigType )
import TcHsSyn ( TcMonoBinds, TypecheckedForeignDecl,
TcForeignExportDecl )
import TcExpr ( tcPolyExpr )
import TcHsSyn ( TcMonoBinds, TypecheckedForeignDecl,
TcForeignExportDecl )
import TcExpr ( tcPolyExpr )
tcFImport fo@(ForeignDecl nm FoExport hs_ty Dynamic cconv src_loc) =
tcAddSrcLoc src_loc $
tcAddErrCtxt (foreignDeclCtxt fo) $
tcFImport fo@(ForeignDecl nm FoExport hs_ty Dynamic cconv src_loc) =
tcAddSrcLoc src_loc $
tcAddErrCtxt (foreignDeclCtxt fo) $
- tcHsBoxedSigType hs_ty `thenTc` \ sig_ty ->
+ tcHsLiftedSigType hs_ty `thenTc` \ sig_ty ->
let
-- drop the foralls before inspecting the structure
-- of the foreign type.
let
-- drop the foralls before inspecting the structure
-- of the foreign type.
tcFImport fo@(ForeignDecl nm FoLabel hs_ty ext_nm cconv src_loc) =
tcAddSrcLoc src_loc $
tcAddErrCtxt (foreignDeclCtxt fo) $
tcFImport fo@(ForeignDecl nm FoLabel hs_ty ext_nm cconv src_loc) =
tcAddSrcLoc src_loc $
tcAddErrCtxt (foreignDeclCtxt fo) $
- tcHsBoxedSigType hs_ty `thenTc` \ sig_ty ->
+ tcHsLiftedSigType hs_ty `thenTc` \ sig_ty ->
let
-- drop the foralls before inspecting the structure
-- of the foreign type.
let
-- drop the foralls before inspecting the structure
-- of the foreign type.
tcAddSrcLoc src_loc $
tcAddErrCtxt (foreignDeclCtxt fo) $
tcAddSrcLoc src_loc $
tcAddErrCtxt (foreignDeclCtxt fo) $
- tcHsBoxedSigType hs_ty `thenTc` \ ty ->
+ tcHsLiftedSigType hs_ty `thenTc` \ ty ->
-- Check that the type has the right shape
-- and that the argument and result types are acceptable.
let
-- Check that the type has the right shape
-- and that the argument and result types are acceptable.
let
tcAddSrcLoc src_loc $
tcAddErrCtxt (foreignDeclCtxt fo) $
tcAddSrcLoc src_loc $
tcAddErrCtxt (foreignDeclCtxt fo) $
- tcHsBoxedSigType hs_ty `thenTc` \ sig_ty ->
+ tcHsLiftedSigType hs_ty `thenTc` \ sig_ty ->
tcPolyExpr (HsVar nm) sig_ty `thenTc` \ (rhs, lie, _, _, _) ->
let
tcPolyExpr (HsVar nm) sig_ty `thenTc` \ (rhs, lie, _, _, _) ->
let
import TyCon ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
maybeTyConSingleCon, tyConFamilySize
)
import TyCon ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
maybeTyConSingleCon, tyConFamilySize
)
-import Type ( isUnLiftedType, isUnboxedType, Type )
+import Type ( isUnLiftedType, Type )
import TysPrim ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
floatPrimTy, doublePrimTy
)
import TysPrim ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
floatPrimTy, doublePrimTy
)
(==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
\end{verbatim}
(==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
\end{verbatim}
- Note: if we're comparing unboxed things, e.g., if \tr{a1} and
+ Note: if we're comparing unlifted things, e.g., if \tr{a1} and
\tr{a2} are \tr{Float#}s, then we have to generate
\begin{verbatim}
case (a1 `eqFloat#` a2) of
\tr{a2} are \tr{Float#}s, then we have to generate
\begin{verbatim}
case (a1 `eqFloat#` a2) of
- Again, we must be careful about unboxed comparisons. For example,
+ Again, we must be careful about unlifted comparisons. For example,
if \tr{a1} and \tr{a2} were \tr{Int#}s in the 2nd example above, we'd need to
generate:
if \tr{a1} and \tr{a2} were \tr{Int#}s in the 2nd example above, we'd need to
generate:
-(modulo suitable case-ification to handle the unboxed tags)
+(modulo suitable case-ification to handle the unlifted tags)
For a single-constructor type (NB: this includes all tuples), e.g.,
\begin{verbatim}
For a single-constructor type (NB: this includes all tuples), e.g.,
\begin{verbatim}
con2tag_Foo :: Foo ... -> Int#
tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int#
con2tag_Foo :: Foo ... -> Int#
tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int#
-maxtag_Foo :: Int -- ditto (NB: not unboxed)
+maxtag_Foo :: Int -- ditto (NB: not unlifted)
\end{verbatim}
The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
\end{verbatim}
The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
generatedSrcLoc
careful_compare_Case ty lt eq gt a b
generatedSrcLoc
careful_compare_Case ty lt eq gt a b
- = if not (isUnboxedType ty) then
+ = if not (isUnLiftedType ty) then
compare_gen_Case compare_RDR lt eq gt a b
else -- we have to do something special for primitive things...
compare_gen_Case compare_RDR lt eq gt a b
else -- we have to do something special for primitive things...
eq_Expr :: Type -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
eq_Expr ty a b
eq_Expr :: Type -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
eq_Expr ty a b
- = if not (isUnboxedType ty) then
+ = if not (isUnLiftedType ty) then
genOpApp a eq_RDR b
else -- we have to do something special for primitive things...
genOpApp a relevant_eq_op b
genOpApp a eq_RDR b
else -- we have to do something special for primitive things...
genOpApp a relevant_eq_op b
import BasicTypes ( RecFlag(..) )
import Type ( tyVarsOfType, isTauTy, mkArrowKind, mkAppTy, mkFunTy,
import BasicTypes ( RecFlag(..) )
import Type ( tyVarsOfType, isTauTy, mkArrowKind, mkAppTy, mkFunTy,
- boxedTypeKind, openTypeKind )
+ liftedTypeKind, openTypeKind )
import SrcLoc ( SrcLoc )
import VarSet
import Var ( Id )
import SrcLoc ( SrcLoc )
import VarSet
import Var ( Id )
\begin{code}
tcParStep src_loc stmts
\begin{code}
tcParStep src_loc stmts
- = newTyVarTy (mkArrowKind boxedTypeKind boxedTypeKind) `thenTc` \ m ->
- newTyVarTy boxedTypeKind `thenTc` \ elt_ty ->
+ = newTyVarTy (mkArrowKind liftedTypeKind liftedTypeKind) `thenTc` \ m ->
+ newTyVarTy liftedTypeKind `thenTc` \ elt_ty ->
unifyListTy (mkAppTy m elt_ty) `thenTc_`
tcStmts ListComp (mkAppTy m) elt_ty src_loc stmts `thenTc` \ ((stmts', val_env), stmts_lie) ->
unifyListTy (mkAppTy m elt_ty) `thenTc_`
tcStmts ListComp (mkAppTy m) elt_ty src_loc stmts `thenTc` \ ((stmts', val_env), stmts_lie) ->
tcStmts do_or_lc m elt_ty loc (stmt@(BindStmt pat exp src_loc) : stmts)
= tcAddSrcLoc src_loc (
tcSetErrCtxt (stmtCtxt do_or_lc stmt) $
tcStmts do_or_lc m elt_ty loc (stmt@(BindStmt pat exp src_loc) : stmts)
= tcAddSrcLoc src_loc (
tcSetErrCtxt (stmtCtxt do_or_lc stmt) $
- newTyVarTy boxedTypeKind `thenNF_Tc` \ pat_ty ->
+ newTyVarTy liftedTypeKind `thenNF_Tc` \ pat_ty ->
tcPat tcPatBndr_NoSigs pat pat_ty `thenTc` \ (pat', pat_lie, pat_tvs, pat_ids, avail) ->
tcExpr exp (m pat_ty) `thenTc` \ (exp', exp_lie) ->
returnTc (pat', exp',
tcPat tcPatBndr_NoSigs pat pat_ty `thenTc` \ (pat', pat_lie, pat_tvs, pat_ids, avail) ->
tcExpr exp (m pat_ty) `thenTc` \ (exp', exp_lie) ->
returnTc (pat', exp',
\begin{code}
module TcMonoType ( tcHsType, tcHsRecType,
\begin{code}
module TcMonoType ( tcHsType, tcHsRecType,
- tcHsSigType, tcHsBoxedSigType,
+ tcHsSigType, tcHsLiftedSigType,
tcRecClassContext, checkAmbiguity,
-- Kind checking
kcHsTyVar, kcHsTyVars, mkTyClTyVars,
tcRecClassContext, checkAmbiguity,
-- Kind checking
kcHsTyVar, kcHsTyVars, mkTyClTyVars,
- kcHsType, kcHsSigType, kcHsBoxedSigType, kcHsContext,
+ kcHsType, kcHsSigType, kcHsLiftedSigType, kcHsContext,
tcTyVars, tcHsTyVars, mkImmutTyVars,
TcSigInfo(..), tcTySig, mkTcSig, maybeSig,
tcTyVars, tcHsTyVars, mkImmutTyVars,
TcSigInfo(..), tcTySig, mkTcSig, maybeSig,
zipFunTys, hoistForAllTys,
mkSigmaTy, mkPredTy, mkTyConApp,
mkAppTys, splitForAllTys, splitRhoTy, mkRhoTy,
zipFunTys, hoistForAllTys,
mkSigmaTy, mkPredTy, mkTyConApp,
mkAppTys, splitForAllTys, splitRhoTy, mkRhoTy,
- boxedTypeKind, unboxedTypeKind, mkArrowKind,
+ liftedTypeKind, unliftedTypeKind, mkArrowKind,
mkArrowKinds, getTyVar_maybe, getTyVar, splitFunTy_maybe,
tidyOpenType, tidyOpenTypes, tidyTyVar, tidyTyVars,
tyVarsOfType, tyVarsOfPred, mkForAllTys,
mkArrowKinds, getTyVar_maybe, getTyVar, splitFunTy_maybe,
tidyOpenType, tidyOpenTypes, tidyTyVar, tidyTyVars,
tyVarsOfType, tyVarsOfPred, mkForAllTys,
returnNF_Tc (name, kind)
---------------------------
returnNF_Tc (name, kind)
---------------------------
-kcBoxedType :: RenamedHsType -> TcM ()
- -- The type ty must be a *boxed* *type*
-kcBoxedType ty
+kcLiftedType :: RenamedHsType -> TcM ()
+ -- The type ty must be a *lifted* *type*
+kcLiftedType ty
= kcHsType ty `thenTc` \ kind ->
tcAddErrCtxt (typeKindCtxt ty) $
= kcHsType ty `thenTc` \ kind ->
tcAddErrCtxt (typeKindCtxt ty) $
- unifyKind boxedTypeKind kind
+ unifyKind liftedTypeKind kind
---------------------------
kcTypeType :: RenamedHsType -> TcM ()
---------------------------
kcTypeType :: RenamedHsType -> TcM ()
- -- The type ty must be a *type*, but it can be boxed or unboxed.
+ -- The type ty must be a *type*, but it can be lifted or unlifted.
kcTypeType ty
= kcHsType ty `thenTc` \ kind ->
tcAddErrCtxt (typeKindCtxt ty) $
unifyOpenTypeKind kind
---------------------------
kcTypeType ty
= kcHsType ty `thenTc` \ kind ->
tcAddErrCtxt (typeKindCtxt ty) $
unifyOpenTypeKind kind
---------------------------
-kcHsSigType, kcHsBoxedSigType :: RenamedHsType -> TcM ()
+kcHsSigType, kcHsLiftedSigType :: RenamedHsType -> TcM ()
-- Used for type signatures
kcHsSigType = kcTypeType
-- Used for type signatures
kcHsSigType = kcTypeType
-kcHsBoxedSigType = kcBoxedType
+kcHsLiftedSigType = kcLiftedType
---------------------------
kcHsType :: RenamedHsType -> TcM TcKind
kcHsType (HsTyVar name) = kcTyVar name
kcHsType (HsListTy ty)
---------------------------
kcHsType :: RenamedHsType -> TcM TcKind
kcHsType (HsTyVar name) = kcTyVar name
kcHsType (HsListTy ty)
- = kcBoxedType ty `thenTc` \ tau_ty ->
- returnTc boxedTypeKind
+ = kcLiftedType ty `thenTc` \ tau_ty ->
+ returnTc liftedTypeKind
kcHsType (HsTupleTy (HsTupCon _ boxity _) tys)
= mapTc kcTypeType tys `thenTc_`
returnTc (case boxity of
kcHsType (HsTupleTy (HsTupCon _ boxity _) tys)
= mapTc kcTypeType tys `thenTc_`
returnTc (case boxity of
- Boxed -> boxedTypeKind
- Unboxed -> unboxedTypeKind)
+ Boxed -> liftedTypeKind
+ Unboxed -> unliftedTypeKind)
kcHsType (HsFunTy ty1 ty2)
= kcTypeType ty1 `thenTc_`
kcTypeType ty2 `thenTc_`
kcHsType (HsFunTy ty1 ty2)
= kcTypeType ty1 `thenTc_`
kcTypeType ty2 `thenTc_`
+ returnTc liftedTypeKind
kcHsType ty@(HsOpTy ty1 op ty2)
= kcTyVar op `thenTc` \ op_kind ->
kcHsType ty@(HsOpTy ty1 op ty2)
= kcTyVar op `thenTc` \ op_kind ->
kcHsType (HsPredTy pred)
= kcHsPred pred `thenTc_`
kcHsType (HsPredTy pred)
= kcHsPred pred `thenTc_`
+ returnTc liftedTypeKind
kcHsType ty@(HsAppTy ty1 ty2)
= kcHsType ty1 `thenTc` \ tc_kind ->
kcHsType ty@(HsAppTy ty1 ty2)
= kcHsType ty1 `thenTc` \ tc_kind ->
tcExtendKindEnv kind_env $
kcHsContext context `thenTc_`
kcHsType ty `thenTc_`
tcExtendKindEnv kind_env $
kcHsContext context `thenTc_`
kcHsType ty `thenTc_`
+ returnTc liftedTypeKind
---------------------------
kcAppKind fun_kind arg_kind
---------------------------
kcAppKind fun_kind arg_kind
kcHsPred :: RenamedHsPred -> TcM ()
kcHsPred pred@(HsPIParam name ty)
= tcAddErrCtxt (appKindCtxt (ppr pred)) $
kcHsPred :: RenamedHsPred -> TcM ()
kcHsPred pred@(HsPIParam name ty)
= tcAddErrCtxt (appKindCtxt (ppr pred)) $
kcHsPred pred@(HsPClass cls tys)
= tcAddErrCtxt (appKindCtxt (ppr pred)) $
kcClass cls `thenTc` \ kind ->
mapTc kcHsType tys `thenTc` \ arg_kinds ->
kcHsPred pred@(HsPClass cls tys)
= tcAddErrCtxt (appKindCtxt (ppr pred)) $
kcClass cls `thenTc` \ kind ->
mapTc kcHsType tys `thenTc` \ arg_kinds ->
- unifyKind kind (mkArrowKinds arg_kinds boxedTypeKind)
+ unifyKind kind (mkArrowKinds arg_kinds liftedTypeKind)
---------------------------
kcTyVar name -- Could be a tyvar or a tycon
---------------------------
kcTyVar name -- Could be a tyvar or a tycon
%* *
%************************************************************************
%* *
%************************************************************************
-tcHsSigType and tcHsBoxedSigType
+tcHsSigType and tcHsLiftedSigType
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-tcHsSigType and tcHsBoxedSigType are used for type signatures written by the programmer
+tcHsSigType and tcHsLiftedSigType are used for type signatures written by the programmer
* We hoist any inner for-alls to the top
* We hoist any inner for-alls to the top
so the kind returned is indeed a Kind not a TcKind
\begin{code}
so the kind returned is indeed a Kind not a TcKind
\begin{code}
-tcHsSigType, tcHsBoxedSigType :: RenamedHsType -> TcM Type
+tcHsSigType, tcHsLiftedSigType :: RenamedHsType -> TcM Type
-- Do kind checking, and hoist for-alls to the top
tcHsSigType ty = kcTypeType ty `thenTc_` tcHsType ty
-- Do kind checking, and hoist for-alls to the top
tcHsSigType ty = kcTypeType ty `thenTc_` tcHsType ty
-tcHsBoxedSigType ty = kcBoxedType ty `thenTc_` tcHsType ty
+tcHsLiftedSigType ty = kcLiftedType ty `thenTc_` tcHsType ty
tcHsType :: RenamedHsType -> TcM Type
tcHsRecType :: RecFlag -> RenamedHsType -> TcM Type
tcHsType :: RenamedHsType -> TcM Type
tcHsRecType :: RecFlag -> RenamedHsType -> TcM Type
import DataCon ( dataConSig, dataConFieldLabels,
dataConSourceArity
)
import DataCon ( dataConSig, dataConFieldLabels,
dataConSourceArity
)
-import Type ( isTauTy, mkTyConApp, mkClassPred, boxedTypeKind )
+import Type ( isTauTy, mkTyConApp, mkClassPred, liftedTypeKind )
import Subst ( substTy, substClasses )
import TysPrim ( charPrimTy, intPrimTy, floatPrimTy,
doublePrimTy, addrPrimTy
import Subst ( substTy, substClasses )
import TysPrim ( charPrimTy, intPrimTy, floatPrimTy,
doublePrimTy, addrPrimTy
-- If foo isn't one of R's fields, we don't want to crash when
-- typechecking the "a+b".
[] -> addErrTc (badFieldCon name field_label) `thenNF_Tc_`
-- If foo isn't one of R's fields, we don't want to crash when
-- typechecking the "a+b".
[] -> addErrTc (badFieldCon name field_label) `thenNF_Tc_`
- newTyVarTy boxedTypeKind `thenNF_Tc_`
+ newTyVarTy liftedTypeKind `thenNF_Tc_`
returnTc (error "Bogus selector Id", pat_ty)
-- The normal case, when the field comes from the right constructor
returnTc (error "Bogus selector Id", pat_ty)
-- The normal case, when the field comes from the right constructor
tcExtendKindEnv, tcLookup, tcExtendGlobalEnv, tcExtendGlobalValEnv )
import TcTyDecls ( tcTyDecl1, kcConDetails, mkNewTyConRep )
import TcClassDcl ( tcClassDecl1 )
tcExtendKindEnv, tcLookup, tcExtendGlobalEnv, tcExtendGlobalValEnv )
import TcTyDecls ( tcTyDecl1, kcConDetails, mkNewTyConRep )
import TcClassDcl ( tcClassDecl1 )
-import TcMonoType ( kcHsTyVars, kcHsType, kcHsBoxedSigType, kcHsContext, mkTyClTyVars )
+import TcMonoType ( kcHsTyVars, kcHsType, kcHsLiftedSigType, kcHsContext, mkTyClTyVars )
import TcType ( TcKind, newKindVar, zonkKindEnv )
import TcUnify ( unifyKind )
import TcType ( TcKind, newKindVar, zonkKindEnv )
import TcUnify ( unifyKind )
Step 6: tcTyClDecl1 again
For a recursive group only, check all the decls again, just
but this time with the wimp flag off. Now we can check things
Step 6: tcTyClDecl1 again
For a recursive group only, check all the decls again, just
but this time with the wimp flag off. Now we can check things
- like whether a function argument is an unboxed tuple, looking
+ like whether a function argument is an unlifted tuple, looking
through type synonyms properly. We can't do that in Step 5.
Step 7: Extend environment
through type synonyms properly. We can't do that in Step 5.
Step 7: Extend environment
kcHsContext context `thenTc_`
mapTc_ kc_sig (filter isClassOpSig class_sigs)
where
kcHsContext context `thenTc_`
mapTc_ kc_sig (filter isClassOpSig class_sigs)
where
- kc_sig (ClassOpSig _ _ op_ty loc) = kcHsBoxedSigType op_ty
+ kc_sig (ClassOpSig _ _ op_ty loc) = kcHsLiftedSigType op_ty
kcTyClDeclBody :: RenamedTyClDecl -> (Kind -> TcM a) -> TcM a
-- Extend the env with bindings for the tyvars, taken from
kcTyClDeclBody :: RenamedTyClDecl -> (Kind -> TcM a) -> TcM a
-- Extend the env with bindings for the tyvars, taken from
import BasicTypes ( NewOrData(..), RecFlag, isRec )
import TcMonoType ( tcHsRecType, tcHsTyVars, tcRecClassContext,
import BasicTypes ( NewOrData(..), RecFlag, isRec )
import TcMonoType ( tcHsRecType, tcHsTyVars, tcRecClassContext,
- kcHsContext, kcHsSigType, kcHsBoxedSigType
+ kcHsContext, kcHsSigType, kcHsLiftedSigType
)
import TcEnv ( tcExtendTyVarEnv,
tcLookupTyCon, tcLookupRecId,
)
import TcEnv ( tcExtendTyVarEnv,
tcLookupTyCon, tcLookupRecId,
where
kc_sig_type = case new_or_data of
DataType -> kcHsSigType
where
kc_sig_type = case new_or_data of
DataType -> kcHsSigType
- NewType -> kcHsBoxedSigType
- -- Can't allow an unboxed type here, because we're effectively
- -- going to remove the constructor while coercing it to a boxed type.
+ NewType -> kcHsLiftedSigType
+ -- Can't allow an unlifted type here, because we're effectively
+ -- going to remove the constructor while coercing it to a lifted type.
tcConDecl :: RecFlag -> NewOrData -> TyCon -> [TyVar] -> ClassContext -> RenamedConDecl -> TcM DataCon
tcConDecl :: RecFlag -> NewOrData -> TyCon -> [TyVar] -> ClassContext -> RenamedConDecl -> TcM DataCon
getTyVar, mkAppTy, mkUTy,
splitPredTy_maybe, splitForAllTys,
isTyVarTy, mkTyVarTy, mkTyVarTys,
getTyVar, mkAppTy, mkUTy,
splitPredTy_maybe, splitForAllTys,
isTyVarTy, mkTyVarTy, mkTyVarTys,
- openTypeKind, boxedTypeKind,
+ openTypeKind, liftedTypeKind,
- defaultKind, boxedBoxity
+ defaultKind, liftedBoxity
)
import Subst ( Subst, mkTopTyVarSubst, substTy )
import TyCon ( mkPrimTyCon )
)
import Subst ( Subst, mkTopTyVarSubst, substTy )
import TyCon ( mkPrimTyCon )
-- When zonking a kind, we want to
-- zonk a *kind* variable to (Type *)
-- zonk a *boxity* variable to *
-- When zonking a kind, we want to
-- zonk a *kind* variable to (Type *)
-- zonk a *boxity* variable to *
- zonk_unbound_kind_var kv | tyVarKind kv == superKind = tcPutTyVar kv boxedTypeKind
- | tyVarKind kv == superBoxity = tcPutTyVar kv boxedBoxity
+ zonk_unbound_kind_var kv | tyVarKind kv == superKind = tcPutTyVar kv liftedTypeKind
+ | tyVarKind kv == superBoxity = tcPutTyVar kv liftedBoxity
| otherwise = pprPanic "zonkKindEnv" (ppr kv)
zonkTcTypeToType :: TcType -> NF_TcM Type
zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
where
-- Zonk a mutable but unbound type variable to
| otherwise = pprPanic "zonkKindEnv" (ppr kv)
zonkTcTypeToType :: TcType -> NF_TcM Type
zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
where
-- Zonk a mutable but unbound type variable to
- -- Void if it has kind Boxed
+ -- Void if it has kind Lifted
-- :Void otherwise
zonk_unbound_tyvar tv
-- :Void otherwise
zonk_unbound_tyvar tv
- | kind == boxedTypeKind
+ | kind == liftedTypeKind
= tcPutTyVar tv voidTy -- Just to avoid creating a new tycon in
-- this vastly common case
| otherwise
= tcPutTyVar tv voidTy -- Just to avoid creating a new tycon in
-- this vastly common case
| otherwise
zonkTcTyVarToTyVar tv
= let
-- Make an immutable version, defaulting
zonkTcTyVarToTyVar tv
= let
-- Make an immutable version, defaulting
- -- the kind to boxed if necessary
+ -- the kind to lifted if necessary
immut_tv = mkTyVar (tyVarName tv) (defaultKind (tyVarKind tv))
immut_tv_ty = mkTyVarTy immut_tv
immut_tv = mkTyVar (tyVarName tv) (defaultKind (tyVarKind tv))
immut_tv_ty = mkTyVarTy immut_tv
-- friends:
import TcMonad
import TypeRep ( Type(..), PredType(..) ) -- friend
-- friends:
import TcMonad
import TypeRep ( Type(..), PredType(..) ) -- friend
-import Type ( unboxedTypeKind, boxedTypeKind, openTypeKind,
+import Type ( unliftedTypeKind, liftedTypeKind, openTypeKind,
typeCon, openKindCon, hasMoreBoxityInfo,
tyVarsOfType, typeKind,
mkFunTy, splitFunTy_maybe, splitTyConApp_maybe,
typeCon, openKindCon, hasMoreBoxityInfo,
tyVarsOfType, typeKind,
mkFunTy, splitFunTy_maybe, splitTyConApp_maybe,
checkKinds swapped tv1 ty2
-- We're about to unify a type variable tv1 with a non-tyvar-type ty2.
checkKinds swapped tv1 ty2
-- We're about to unify a type variable tv1 with a non-tyvar-type ty2.
--- We need to check that we don't unify a boxed type variable with an
--- unboxed type: e.g. (id 3#) is illegal
- | tk1 == boxedTypeKind && tk2 == unboxedTypeKind
+-- We need to check that we don't unify a lifted type variable with an
+-- unlifted type: e.g. (id 3#) is illegal
+ | tk1 == liftedTypeKind && tk2 == unliftedTypeKind
= tcAddErrCtxtM (unifyKindCtxt swapped tv1 ty2) $
unifyMisMatch k1 k2
| otherwise
= tcAddErrCtxtM (unifyKindCtxt swapped tv1 ty2) $
unifyMisMatch k1 k2
| otherwise
other -> unify_list_ty_help ty
unify_list_ty_help ty -- Revert to ordinary unification
other -> unify_list_ty_help ty
unify_list_ty_help ty -- Revert to ordinary unification
- = newTyVarTy boxedTypeKind `thenNF_Tc` \ elt_ty ->
+ = newTyVarTy liftedTypeKind `thenNF_Tc` \ elt_ty ->
unifyTauTy ty (mkListTy elt_ty) `thenTc_`
returnTc elt_ty
\end{code}
unifyTauTy ty (mkListTy elt_ty) `thenTc_`
returnTc elt_ty
\end{code}
unifyTauTy ty (mkTupleTy boxity arity arg_tys) `thenTc_`
returnTc arg_tys
where
unifyTauTy ty (mkTupleTy boxity arity arg_tys) `thenTc_`
returnTc arg_tys
where
- kind | isBoxed boxity = boxedTypeKind
+ kind | isBoxed boxity = liftedTypeKind
| otherwise = openTypeKind
\end{code}
| otherwise = openTypeKind
\end{code}
-- friends:
-- (PprType can see all the representations it's trying to print)
-- friends:
-- (PprType can see all the representations it's trying to print)
-import TypeRep ( Type(..), TyNote(..), Kind, boxedTypeKind ) -- friend
+import TypeRep ( Type(..), TyNote(..), Kind, liftedTypeKind ) -- friend
import Type ( PredType(..), ThetaType,
splitPredTy_maybe,
splitForAllTys, splitSigmaTy, splitRhoTy,
import Type ( PredType(..), ThetaType,
splitPredTy_maybe,
splitForAllTys, splitSigmaTy, splitRhoTy,
\begin{code}
pprTyVarBndr tyvar
= getPprStyle $ \ sty ->
\begin{code}
pprTyVarBndr tyvar
= getPprStyle $ \ sty ->
- if (ifaceStyle sty && kind /= boxedTypeKind) || debugStyle sty then
+ if (ifaceStyle sty && kind /= liftedTypeKind) || debugStyle sty then
hsep [ppr tyvar, dcolon, pprParendKind kind]
-- See comments with ppDcolon in PprCore.lhs
else
hsep [ppr tyvar, dcolon, pprParendKind kind]
-- See comments with ppDcolon in PprCore.lhs
else
Kind, TyVarSubst,
superKind, superBoxity, -- KX and BX respectively
Kind, TyVarSubst,
superKind, superBoxity, -- KX and BX respectively
- boxedBoxity, unboxedBoxity, -- :: BX
+ liftedBoxity, unliftedBoxity, -- :: BX
openKindCon, -- :: KX
typeCon, -- :: BX -> KX
openKindCon, -- :: KX
typeCon, -- :: BX -> KX
- boxedTypeKind, unboxedTypeKind, openTypeKind, -- :: KX
+ liftedTypeKind, unliftedTypeKind, openTypeKind, -- :: KX
mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
funTyCon,
mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
funTyCon,
getDFunTyKey,
-- Lifting and boxity
getDFunTyKey,
-- Lifting and boxity
- isUnLiftedType, isUnboxedType, isUnboxedTupleType, isAlgType, isDataType, isNewType,
+ isUnLiftedType, isUnboxedTupleType, isAlgType, isDataType, isNewType,
-- Free variables
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-- Free variables
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-- others
import Maybes ( maybeToBool )
import SrcLoc ( noSrcLoc )
-- others
import Maybes ( maybeToBool )
import SrcLoc ( noSrcLoc )
-import PrimRep ( PrimRep(..), isFollowableRep )
+import PrimRep ( PrimRep(..) )
import Unique ( Uniquable(..) )
import Util ( mapAccumL, seqList, thenCmp )
import Outputable
import Unique ( Uniquable(..) )
import Util ( mapAccumL, seqList, thenCmp )
import Outputable
defaultKind :: Kind -> Kind
-- Used when generalising: default kind '?' to '*'
defaultKind :: Kind -> Kind
-- Used when generalising: default kind '?' to '*'
-defaultKind kind | kind == openTypeKind = boxedTypeKind
+defaultKind kind | kind == openTypeKind = liftedTypeKind
| otherwise = kind
\end{code}
| otherwise = kind
\end{code}
typeKind (TyVarTy tyvar) = tyVarKind tyvar
typeKind (TyConApp tycon tys) = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
typeKind (NoteTy _ ty) = typeKind ty
typeKind (TyVarTy tyvar) = tyVarKind tyvar
typeKind (TyConApp tycon tys) = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
typeKind (NoteTy _ ty) = typeKind ty
-typeKind (PredTy _) = boxedTypeKind -- Predicates are always
- -- represented by boxed types
+typeKind (PredTy _) = liftedTypeKind -- Predicates are always
+ -- represented by lifted types
typeKind (AppTy fun arg) = funResultTy (typeKind fun)
typeKind (FunTy arg res) = fix_up (typeKind res)
where
fix_up (TyConApp tycon _) | tycon == typeCon
typeKind (AppTy fun arg) = funResultTy (typeKind fun)
typeKind (FunTy arg res) = fix_up (typeKind res)
where
fix_up (TyConApp tycon _) | tycon == typeCon
- || tycon == openKindCon = boxedTypeKind
+ || tycon == openKindCon = liftedTypeKind
fix_up (NoteTy _ kind) = fix_up kind
fix_up kind = kind
-- The basic story is
-- typeKind (FunTy arg res) = typeKind res
fix_up (NoteTy _ kind) = fix_up kind
fix_up kind = kind
-- The basic story is
-- typeKind (FunTy arg res) = typeKind res
- -- But a function is boxed regardless of its result type
+ -- But a function is lifted regardless of its result type
-- Hence the strange fix-up.
-- Note that 'res', being the result of a FunTy, can't have
-- a strange kind like (*->*).
-- Hence the strange fix-up.
-- Note that 'res', being the result of a FunTy, can't have
-- a strange kind like (*->*).
%************************************************************************
%* *
%************************************************************************
%* *
-\subsection{Boxedness and liftedness}
%* *
%************************************************************************
\begin{code}
%* *
%************************************************************************
\begin{code}
-isUnboxedType :: Type -> Bool
-isUnboxedType ty = not (isFollowableRep (typePrimRep ty))
-
isUnLiftedType :: Type -> Bool
-- isUnLiftedType returns True for forall'd unlifted types:
-- x :: forall a. Int#
isUnLiftedType :: Type -> Bool
-- isUnLiftedType returns True for forall'd unlifted types:
-- x :: forall a. Int#
TyVarSubst,
superKind, superBoxity, -- KX and BX respectively
TyVarSubst,
superKind, superBoxity, -- KX and BX respectively
- boxedBoxity, unboxedBoxity, -- :: BX
+ liftedBoxity, unliftedBoxity, -- :: BX
openKindCon, -- :: KX
typeCon, -- :: BX -> KX
openKindCon, -- :: KX
typeCon, -- :: BX -> KX
- boxedTypeKind, unboxedTypeKind, openTypeKind, -- :: KX
+ liftedTypeKind, unliftedTypeKind, openTypeKind, -- :: KX
mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
usageKindCon, -- :: KX
mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
usageKindCon, -- :: KX
import Class ( Class )
-- others
import Class ( Class )
-- others
-import PrelNames ( superKindName, superBoxityName, boxedConName,
- unboxedConName, typeConName, openKindConName, funTyConName,
- usageKindConName, usOnceTyConName, usManyTyConName
+import PrelNames ( superKindName, superBoxityName, liftedConName,
+ unliftedConName, typeConName, openKindConName,
+ usageKindConName, usOnceTyConName, usManyTyConName,
+ funTyConName
A type is
*unboxed* iff its representation is other than a pointer
A type is
*unboxed* iff its representation is other than a pointer
- Unboxed types cannot instantiate a type variable.
- Unboxed types are always unlifted.
+ Unboxed types are also unlifted.
*lifted* A type is lifted iff it has bottom as an element.
Closures always have lifted types: i.e. any
let-bound identifier in Core must have a lifted
type. Operationally, a lifted object is one that
can be entered.
*lifted* A type is lifted iff it has bottom as an element.
Closures always have lifted types: i.e. any
let-bound identifier in Core must have a lifted
type. Operationally, a lifted object is one that
can be entered.
- (NOTE: previously "pointed").
+
+ Only lifted types may be unified with a type variable.
*algebraic* A type with one or more constructors, whether declared
with "data" or "newtype".
*algebraic* A type with one or more constructors, whether declared
with "data" or "newtype".
~~~~~
kind :: KX = kind -> kind
~~~~~
kind :: KX = kind -> kind
- | Type boxity -- (Type *) is printed as just *
+ | Type liftedness -- (Type *) is printed as just *
-- (Type #) is printed as just #
| UsageKind -- Printed '$'; used for usage annotations
-- (Type #) is printed as just #
| UsageKind -- Printed '$'; used for usage annotations
- | OpenKind -- Can be boxed or unboxed
+ | OpenKind -- Can be lifted or unlifted
-- Printed '?'
| kv -- A kind variable; *only* happens during kind checking
-- Printed '?'
| kv -- A kind variable; *only* happens during kind checking
-boxity :: BX = * -- Boxed
- | # -- Unboxed
+boxity :: BX = * -- Lifted
+ | # -- Unlifted
| bv -- A boxity variable; *only* happens during kind checking
There's a little subtyping at the kind level:
| bv -- A boxity variable; *only* happens during kind checking
There's a little subtyping at the kind level:
1. The universally quantified type variable(s) for special built-in
things like error :: forall (a::?). String -> a.
1. The universally quantified type variable(s) for special built-in
things like error :: forall (a::?). String -> a.
- Here, the 'a' can be instantiated to a boxed or unboxed type.
+ Here, the 'a' can be instantiated to a lifted or unlifted type.
2. Kind '?' is also used when the typechecker needs to create a fresh
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
2. Kind '?' is also used when the typechecker needs to create a fresh
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 boxed or unboxed types, so we give them kind '?'.
+ are b and c? They can be lifted or unlifted types, 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
When the type checker generalises over a bunch of type variables, it
makes any that still have kind '?' into kind '*'. So kind '?' is never
Define boxities: @*@ and @#@
\begin{code}
Define boxities: @*@ and @#@
\begin{code}
-boxedBoxity, unboxedBoxity :: Kind -- :: BX
-boxedBoxity = TyConApp (mkKindCon boxedConName superBoxity) []
+liftedBoxity, unliftedBoxity :: Kind -- :: BX
+liftedBoxity = TyConApp (mkKindCon liftedConName superBoxity) []
-unboxedBoxity = TyConApp (mkKindCon unboxedConName superBoxity) []
+unliftedBoxity = TyConApp (mkKindCon unliftedConName superBoxity) []
\end{code}
------------------------------------------
\end{code}
------------------------------------------
typeCon :: KindCon -- :: BX -> KX
typeCon = mkKindCon typeConName (superBoxity `FunTy` superKind)
typeCon :: KindCon -- :: BX -> KX
typeCon = mkKindCon typeConName (superBoxity `FunTy` superKind)
-boxedTypeKind, unboxedTypeKind, openTypeKind :: Kind -- Of superkind superKind
+liftedTypeKind, unliftedTypeKind, openTypeKind :: Kind -- Of superkind superKind
-boxedTypeKind = TyConApp typeCon [boxedBoxity]
-unboxedTypeKind = TyConApp typeCon [unboxedBoxity]
+liftedTypeKind = TyConApp typeCon [liftedBoxity]
+unliftedTypeKind = TyConApp typeCon [unliftedBoxity]
openKindCon = mkKindCon openKindConName superKind
openTypeKind = TyConApp openKindCon []
openKindCon = mkKindCon openKindConName superKind
openTypeKind = TyConApp openKindCon []
We define a few wired-in type constructors here to avoid module knots
\begin{code}
We define a few wired-in type constructors here to avoid module knots
\begin{code}
-funTyCon = mkFunTyCon funTyConName (mkArrowKinds [boxedTypeKind, boxedTypeKind] boxedTypeKind)
+funTyCon = mkFunTyCon funTyConName (mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind)
\end{code}
------------------------------------------
\end{code}
------------------------------------------