Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
182e34b4
Commit
182e34b4
authored
May 30, 2013
by
Simon Peyton Jones
Browse files
Test Trac
#4185
parent
0a5065a8
Changes
2
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/indexed-types/should_compile/T4185.hs
0 → 100644
View file @
182e34b4
{-# LANGUAGE DeriveFunctor, StandaloneDeriving, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}
module
T4185
where
data
family
Foo
k
::
*
->
*
------------- Generalised newtype deriving of user class -----------
class
Bar
f
where
bar
::
f
a
->
Int
woo
::
f
a
->
f
a
instance
Bar
Maybe
where
bar
Nothing
=
0
bar
Just
{}
=
1
woo
x
=
x
-- Deriving clause
newtype
instance
Foo
Int
a
=
FooInt
(
Maybe
a
)
deriving
(
Bar
)
-- Standalone deriving
newtype
instance
Foo
Char
a
=
FooChar
(
Maybe
a
)
deriving
instance
Bar
(
Foo
Char
)
{-
dBarMaybe :: Bar Maybe
newtype FooInt a = FooInt (Maybe a)
axiom ax7 a : Foo Int a ~ FooInt a -- Family axiom
axiom ax7 : FooInt ~ Maybe -- Newtype axiom
dBarFooInt :: Bar (Foo Int)
dBarFooInt = dBarMaybe |> Bar ax7
-}
------------- Deriving on data types for Functor -----------
-- Deriving clause
data
instance
Foo
Bool
a
=
FB1
a
|
FB2
a
deriving
(
Functor
)
-- Standalone deriving
data
instance
Foo
Float
a
=
FB3
a
deriving
instance
Functor
(
Foo
Float
)
--instance Functor (Foo Bool) where
-- fmap f (FB1 x) = FB1 (f x)
-- fmap f (FB2 y) = FB2 (f y)
\ No newline at end of file
testsuite/tests/indexed-types/should_compile/all.T
View file @
182e34b4
...
...
@@ -210,4 +210,5 @@ test('T7585', normal, compile, [''])
test
('
T7282
',
normal
,
compile
,
[''])
test
('
T7804
',
normal
,
compile
,
[''])
test
('
T7837
',
normal
,
compile
,
['
-O -ddump-rule-firings
'])
test
('
T4185
',
normal
,
compile
,
[''])
Write
Preview
Markdown
is supported
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