Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
ee2dd59c
Commit
ee2dd59c
authored
Jun 23, 2006
by
Simon Marlow
Browse files
the unlifted kind
parent
24ce1351
Changes
8
Hide whitespace changes
Inline
Side-by-side
compiler/coreSyn/ExternalCore.lhs
View file @
ee2dd59c
...
...
@@ -57,6 +57,7 @@ data Ty
data Kind
= Klifted
| Kunlifted
| Kunboxed
| Kopen
| Karrow Kind Kind
...
...
compiler/coreSyn/MkExternalCore.lhs
View file @
ee2dd59c
...
...
@@ -174,6 +174,7 @@ make_ty (NoteTy _ t) = make_ty t
make_kind :: Kind -> C.Kind
make_kind (FunKind k1 k2) = C.Karrow (make_kind k1) (make_kind k2)
make_kind LiftedTypeKind = C.Klifted
make_kind UnboxedTypeKind = C.Kunboxed
make_kind UnliftedTypeKind = C.Kunlifted
make_kind OpenTypeKind = C.Kopen
make_kind _ = error "MkExternalCore died: make_kind"
...
...
compiler/iface/BinIface.hs
View file @
ee2dd59c
...
...
@@ -562,11 +562,12 @@ instance Binary IfaceBndr where
instance
Binary
Kind
where
put_
bh
LiftedTypeKind
=
putByte
bh
0
put_
bh
UnliftedTypeKind
=
putByte
bh
1
put_
bh
OpenTypeKind
=
putByte
bh
2
put_
bh
ArgTypeKind
=
putByte
bh
3
put_
bh
UbxTupleKind
=
putByte
bh
4
put_
bh
UnboxedTypeKind
=
putByte
bh
2
put_
bh
OpenTypeKind
=
putByte
bh
3
put_
bh
ArgTypeKind
=
putByte
bh
4
put_
bh
UbxTupleKind
=
putByte
bh
5
put_
bh
(
FunKind
k1
k2
)
=
do
putByte
bh
5
putByte
bh
6
put_
bh
k1
put_
bh
k2
put_
bh
(
KindVar
kv
)
=
pprPanic
"BinIface.put_: kind var"
(
ppr
kv
)
...
...
@@ -576,9 +577,10 @@ instance Binary Kind where
case
h
of
0
->
return
LiftedTypeKind
1
->
return
UnliftedTypeKind
2
->
return
OpenTypeKind
3
->
return
ArgTypeKind
4
->
return
UbxTupleKind
2
->
return
UnboxedTypeKind
3
->
return
OpenTypeKind
4
->
return
ArgTypeKind
5
->
return
UbxTupleKind
_
->
do
k1
<-
get
bh
k2
<-
get
bh
return
(
FunKind
k1
k2
)
...
...
compiler/parser/Parser.y.pp
View file @
ee2dd59c
...
...
@@ -32,7 +32,7 @@ import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
mkSrcLoc, mkSrcSpan )
import Module
import StaticFlags ( opt_SccProfilingOn )
import Type ( Kind, mkArrowKind, liftedTypeKind )
import Type ( Kind, mkArrowKind, liftedTypeKind
, unliftedTypeKind
)
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
Activation(..), defaultInlineSpec )
import OrdList
...
...
@@ -850,6 +850,7 @@ kind :: { Kind }
akind
::
{ Kind }
:
'*'
{ liftedTypeKind }
|
'!'
{ unliftedTypeKind }
|
'('
kind
')'
{ $2 }
...
...
compiler/prelude/TysPrim.lhs
View file @
ee2dd59c
...
...
@@ -50,7 +50,8 @@ import OccName ( mkOccNameFS, tcName, mkTyVarOcc )
import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon,
PrimRep(..) )
import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
unliftedTypeKind, liftedTypeKind, openTypeKind,
unliftedTypeKind, unboxedTypeKind,
liftedTypeKind, openTypeKind,
Kind, mkArrowKinds,
TyThing(..)
)
...
...
@@ -196,13 +197,17 @@ pcPrimTyCon name arg_vrcs rep
where
arity = length arg_vrcs
kind = mkArrowKinds (replicate arity liftedTypeKind) result_kind
result_kind = unliftedTypeKind -- all primitive types are unlifted
result_kind = case rep of
PtrRep -> unliftedTypeKind
_other -> unboxedTypeKind
pcPrimTyCon0 :: Name -> PrimRep -> TyCon
pcPrimTyCon0 name rep
= mkPrimTyCon name result_kind 0 [] rep
where
result_kind = unliftedTypeKind -- all primitive types are unlifted
result_kind = case rep of
PtrRep -> unliftedTypeKind
_other -> unboxedTypeKind
charPrimTy = mkTyConTy charPrimTyCon
charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep
...
...
compiler/typecheck/TcType.lhs
View file @
ee2dd59c
...
...
@@ -88,7 +88,8 @@ module TcType (
--------------------------------
-- Rexported from Type
Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
unliftedTypeKind, liftedTypeKind, unboxedTypeKind,
openTypeKind, mkArrowKind, mkArrowKinds,
isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
isArgTypeKind, isSubKind, defaultKind,
...
...
@@ -131,7 +132,7 @@ import TypeRep ( Type(..), funTyCon ) -- friend
import Type ( -- Re-exports
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
tyVarsOfTheta, Kind, PredType(..),
ThetaType, unliftedTypeKind,
ThetaType, unliftedTypeKind,
unboxedTypeKind,
liftedTypeKind, openTypeKind, mkArrowKind,
isLiftedTypeKind, isUnliftedTypeKind,
mkArrowKinds, mkForAllTy, mkForAllTys,
...
...
compiler/typecheck/TcUnify.lhs
View file @
ee2dd59c
...
...
@@ -53,7 +53,8 @@ import TcType ( TcKind, TcType, TcTyVar, BoxyTyVar, TcTauType,
TvSubst, mkTvSubst, zipTyEnv, substTy, emptyTvSubst,
lookupTyVar, extendTvSubst )
import Kind ( Kind(..), SimpleKind, KindVar, isArgTypeKind,
openTypeKind, liftedTypeKind, mkArrowKind, defaultKind,
openTypeKind, liftedTypeKind, unliftedTypeKind,
mkArrowKind, defaultKind,
isOpenTypeKind, argTypeKind, isLiftedTypeKind, isUnliftedTypeKind,
isSubKind, pprKind, splitKindFunTys )
import TysPrim ( alphaTy, betaTy )
...
...
@@ -1504,6 +1505,7 @@ kindSimpleKind orig_swapped orig_kind
go True OpenTypeKind = return liftedTypeKind
go True ArgTypeKind = return liftedTypeKind
go sw LiftedTypeKind = return liftedTypeKind
go sw UnliftedTypeKind = return unliftedTypeKind
go sw k@(KindVar _) = return k -- KindVars are always simple
go swapped kind = failWithTc (ptext SLIT("Unexpected kind unification failure:")
<+> ppr orig_swapped <+> ppr orig_kind)
...
...
compiler/types/Kind.lhs
View file @
ee2dd59c
...
...
@@ -5,10 +5,10 @@
\begin{code}
module Kind (
Kind(..), SimpleKind,
openTypeKind, liftedTypeKind, unliftedTypeKind,
openTypeKind, liftedTypeKind, unliftedTypeKind,
unboxedTypeKind,
argTypeKind, ubxTupleKind,
isLiftedTypeKind, isUnliftedTypeKind,
isLiftedTypeKind, isUnliftedTypeKind,
isUnliftedBoxedTypeKind,
isArgTypeKind, isOpenTypeKind,
mkArrowKind, mkArrowKinds,
...
...
@@ -37,11 +37,11 @@ There's a little subtyping at the kind level:
/ \
/ \
?? (#)
/ \
* #
/
|
\
*
!
#
where * [LiftedTypeKind] means boxed type
# [Un
lift
edTypeKind] means unboxed type
# [Un
box
edTypeKind]
means unboxed type
(#) [UbxTupleKind] means unboxed tuple
?? [ArgTypeKind] is the lub of *,#
? [OpenTypeKind] means any type at all
...
...
@@ -55,11 +55,12 @@ In particular:
\begin{code}
data Kind
= LiftedTypeKind -- *
| OpenTypeKind -- ?
| UnliftedTypeKind -- #
| UbxTupleKind -- (##)
| ArgTypeKind -- ??
| FunKind Kind Kind -- k1 -> k2
| OpenTypeKind -- ?
| UnboxedTypeKind -- #
| UnliftedTypeKind -- !
| UbxTupleKind -- (##)
| ArgTypeKind -- ??
| FunKind Kind Kind -- k1 -> k2
| KindVar KindVar
deriving( Eq )
...
...
@@ -120,6 +121,7 @@ less-informative one to the more informative one. Neat, eh?
\begin{code}
liftedTypeKind = LiftedTypeKind
unboxedTypeKind = UnboxedTypeKind
unliftedTypeKind = UnliftedTypeKind
openTypeKind = OpenTypeKind
argTypeKind = ArgTypeKind
...
...
@@ -152,13 +154,18 @@ 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
...
...
@@ -174,6 +181,7 @@ 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
...
...
@@ -219,7 +227,8 @@ pprParendKind k = pprKind k
pprKind (KindVar v) = ppr v
pprKind LiftedTypeKind = ptext SLIT("*")
pprKind UnliftedTypeKind = ptext SLIT("#")
pprKind UnliftedTypeKind = ptext SLIT("!")
pprKind UnboxedTypeKind = ptext SLIT("#")
pprKind OpenTypeKind = ptext SLIT("?")
pprKind ArgTypeKind = ptext SLIT("??")
pprKind UbxTupleKind = ptext SLIT("(#)")
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment