Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
57fca849
Commit
57fca849
authored
Mar 19, 2009
by
chak@cse.unsw.edu.au.
Browse files
Template Haskell: two tests for type families
parent
83d56696
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/th/TH_tf1.hs
0 → 100644
View file @
57fca849
{-# OPTIONS -fglasgow-exts #-}
module
TH_tf1
where
$
(
[
d
|
data family T a
|]
)
$
(
[
d
|
data instance T Int = TInt Bool
|]
)
foo
::
Bool
->
T
Int
foo
b
=
TInt
(
b
&&
b
)
$
(
[
d
|
type family S a
|]
)
$
(
[
d
|
type instance S Int = Bool
|]
)
bar
::
S
Int
->
Int
bar
c
=
if
c
then
1
else
2
testsuite/tests/ghc-regress/th/TH_tf2.hs
0 → 100644
View file @
57fca849
{-# OPTIONS -fglasgow-exts #-}
module
TH_tf2
where
import
Language.Haskell.TH
$
(
[
d
|
class C a where
data T a
foo :: Bool -> T a
|]
)
$
(
[
d
|
instance C Int where
data T Int = TInt Bool
foo b = TInt (b && b)
|]
)
$
(
[
d
|
instance C Float where
data T Float = TFloat {flag :: Bool}
foo b = TFloat {flag = b && b}
|]
)
$
(
[
d
|
class D a where
type S a
bar :: S a -> Int
|]
)
$
(
[
d
|
instance D Int where
type S Int = Bool
bar c = if c then 1 else 2
|]
)
testsuite/tests/ghc-regress/th/all.T
View file @
57fca849
...
...
@@ -133,3 +133,5 @@ test('T2685', extra_clean(['T2685a.hi','T2685a.o']),
test
('
TH_sections
',
normal
,
compile
,
['
-v0
'])
test
('
TH_tf1
',
normal
,
compile
,
['
-v0
'])
test
('
TH_tf2
',
normal
,
compile
,
['
-v0
'])
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