Skip to content
GitLab
Menu
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
436f8968
Commit
436f8968
authored
Jun 10, 2013
by
Simon Peyton Jones
Browse files
Test Trac #7973
parent
cb5a00c7
Changes
2
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/polykinds/T7973.hs
0 → 100644
View file @
436f8968
{-# LANGUAGE DataKinds, PolyKinds, KindSignatures #-}
{-# LANGUAGE ExistentialQuantification, UndecidableInstances, TypeFamilies #-}
module
Test
where
-- Kind-level proxies.
data
{-kind-}
K
(
a
::
*
)
=
KP
-- A type with 1 kind-polymorphic type argument.
data
T
(
n
::
k
)
-- A type with 1 kind argument.
data
F
(
kp
::
K
k
)
-- A class with 1 kind argument.
class
(
kp
~
KP
)
=>
C
(
kp
::
K
k
)
where
f
::
T
(
a
::
k
)
->
F
kp
-- A type with 1 kind argument.
-- Contains an existentially quantified type-variable of this kind.
data
SomeT
(
kp
::
K
k
)
=
forall
(
n
::
k
)
.
Mk
(
T
n
)
-- Show `SomeT` by converting it to `F`, using `C`.
instance
(
C
kp
,
Show
(
F
kp
))
=>
Show
(
SomeT
kp
)
where
show
(
Mk
x
)
=
show
(
f
x
)
testsuite/tests/polykinds/all.T
View file @
436f8968
...
...
@@ -87,3 +87,4 @@ test('T7524', normal, compile_fail,[''])
test
('
T7601
',
normal
,
compile
,[''])
test
('
T7805
',
normal
,
compile_fail
,[''])
test
('
T7916
',
normal
,
compile
,[''])
test
('
T7973
',
normal
,
compile
,['
-O
'])
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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