Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
62e48fbc
Commit
62e48fbc
authored
Jun 26, 2013
by
eir@cis.upenn.edu
Browse files
Test kind inference for closed type families/T7939.
parent
fe2397fe
Changes
8
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghci/scripts/T7939.hs
View file @
62e48fbc
{-# LANGUAGE TypeFamilies, PolyKinds #-}
{-# LANGUAGE TypeFamilies, PolyKinds
, DataKinds, TypeOperators
#-}
module
T7939
where
class
Foo
a
where
type
Bar
a
type
Bar
a
b
type
family
F
a
type
instance
F
Int
=
Bool
type
family
G
a
where
G
Int
=
Bool
type
family
H
a
where
H
False
=
True
type
family
J
a
where
J
'
[]
=
False
J
(
h
'
:
t
)
=
True
type
family
K
a
where
K
'
[]
=
Nothing
K
(
h
'
:
t
)
=
Just
h
type
family
L
(
a
::
k
)
b
::
k
where
L
Int
Int
=
Bool
L
Maybe
Bool
=
IO
\ No newline at end of file
testsuite/tests/ghci/scripts/T7939.script
View file @
62e48fbc
:l T7939
:i Bar
:k Bar
:i F
:k F
:i G
:k G
:i H
:k H
:i J
:k J
:i K
:k K
\ No newline at end of file
testsuite/tests/ghci/scripts/T7939.stdout
View file @
62e48fbc
class Foo (k :: BOX) (a :: k) where
type family Bar (k :: BOX)
(k :: BOX)
(a :: k) ::
k
type family Bar (k :: BOX) (a :: k)
b
::
*
-- Defined at T7939.hs:6:9
Bar :: k1 -> k
Bar :: k -> * -> *
type family F a :: * -- Defined at T7939.hs:8:13
type instance F Int -- Defined at T7939.hs:9:1
F :: * -> *
type family G a :: * where G Int = Bool
-- Defined at T7939.hs:11:13
G :: * -> *
type family H (a :: Bool) :: Bool where H 'False = 'True
-- Defined at T7939.hs:14:13
H :: Bool -> Bool
type family J (k :: BOX) (a :: [k]) :: Bool where
J k ('[] k) = 'False
J k ((':) k h t) = 'True
-- Defined at T7939.hs:17:13
J :: [k] -> Bool
type family K (k :: BOX) (a :: [k]) :: Maybe k where
K k ('[] k) = 'Nothing k
K k ((':) k h t) = 'Just k h
-- Defined at T7939.hs:21:13
K :: [k] -> Maybe k
testsuite/tests/indexed-types/should_compile/T7585.hs
View file @
62e48fbc
...
...
@@ -11,7 +11,7 @@ data SList :: [Bool] -> * where
SNil
::
SList
'
[]
SCons
::
SBool
h
->
SList
t
->
SList
(
h
'
:
t
)
type
family
(
a
::
k
)
:==:
(
b
::
k
)
::
Bool
where
type
family
(
a
::
[
k
]
)
:==:
(
b
::
[
k
]
)
::
Bool
where
'
[]
:==:
'
[]
=
True
(
h1
'
:
t1
)
:==:
(
h2
'
:
t2
)
=
True
a
:==:
b
=
False
...
...
testsuite/tests/polykinds/T7020.hs
View file @
62e48fbc
...
...
@@ -10,7 +10,7 @@ data family Sing (a :: k)
class
SingKind
(
Any
::
k
)
=>
SingI
(
s
::
k
)
where
sing
::
Sing
s
data
SingInstance
::
k
->
*
where
data
SingInstance
(
a
::
k
)
where
SingInstance
::
SingI
a
=>
SingInstance
a
class
(
b
~
Any
)
=>
SingKind
(
b
::
k
)
where
...
...
testsuite/tests/polykinds/T7939a.hs
0 → 100644
View file @
62e48fbc
{-# LANGUAGE TypeFamilies, PolyKinds #-}
module
T7939a
where
type
family
F
a
where
F
Int
=
Bool
F
Maybe
=
Char
testsuite/tests/polykinds/T7939a.stderr
0 → 100644
View file @
62e48fbc
T7939a.hs:7:5:
Expecting one more argument to ‛Maybe’
The first argument of ‛F’ should have kind ‛*’,
but ‛Maybe’ has kind ‛* -> *’
In the type ‛Maybe’
In the family declaration for ‛F’
testsuite/tests/polykinds/all.T
View file @
62e48fbc
...
...
@@ -88,3 +88,4 @@ test('T7601', normal, compile,[''])
test
('
T7805
',
normal
,
compile_fail
,[''])
test
('
T7916
',
normal
,
compile
,[''])
test
('
T7973
',
normal
,
compile
,['
-O
'])
test
('
T7939a
',
normal
,
compile_fail
,
[''])
\ No newline at end of file
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