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
1a411cbc
Commit
1a411cbc
authored
Oct 17, 2007
by
simonpj
Browse files
Add exotic functional-dependency test
parent
54f5a940
Changes
2
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/indexed-types/should_compile/Gentle.hs
0 → 100644
View file @
1a411cbc
{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances -fallow-undecidable-instances #-}
-- Rather exotic example posted to Haskell mailing list 17 Oct 07
-- It concerns context reduction and functional dependencies
module
FooModule
where
class
Concrete
a
b
|
a
->
b
where
bar
::
a
->
String
instance
(
Show
a
)
=>
Concrete
a
b
where
bar
=
error
"urk"
wib
::
Concrete
a
b
=>
a
->
String
wib
x
=
bar
x
-- Uncommenting this solves the problem:
-- instance Concrete Bool Bool
{- This is a nice example of the trickiness of functional dependencies.
Here's what is happening. First a very cut-down version of your
example:
Now consider type inference for 'wib'. GHC 6.6 figures out that the call
of 'bar' gives rise to the constraint (Concrete p q), where x has type
'p'. Ah, but x must have type 'a', so the constraint is (Concrete a
q).
Now GHC tries to satisfy (Concrete a q) from (Concrete a b). If it
applied improvement right away it'd succeed, but sadly it first looks
at instances declarations. Success: we can get (Concrete a q) from
(Show a). So it uses the instance decl and now we can't get (Show a)
from (Concrete a b).
OK, found that in GHC 6.6, adding
instance Concrete Bool Bool
fixed the problem. That's weird isn't it? The reason is this. When GHC looks
at the instance decls, it now sees *two* instance decls matching
(Concrete a q), and so it declines for now to use either of them
(since it's not clear which would be the right one). Once it has
finished with instance decls it tries improvement. And, yes, it now
sees that q=b, so all is well.
You might say that GHC should use improvement more vigorously, and
perhaps you'd be right. And indeed the upcoming GHC 6.8 does exactly
that.
-}
testsuite/tests/ghc-regress/indexed-types/should_compile/all.T
View file @
1a411cbc
...
...
@@ -96,3 +96,5 @@ test('GivenCheck', normal, compile, [''])
test
('
GivenCheckSwap
',
normal
,
compile
,
[''])
test
('
GivenCheckDecomp
',
normal
,
compile
,
[''])
test
('
GivenCheckTop
',
normal
,
compile
,
[''])
test
('
Gentle
',
normal
,
compile
,
[''])
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