Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Francesco Gazzetta
Glasgow Haskell Compiler
Commits
13fdca3d
Commit
13fdca3d
authored
Oct 11, 2017
by
Simon Peyton Jones
Browse files
Add a missing zonk in TcDerivInfer.simplifyDeriv
I'm astonished that anything worked without this! Fixes Trac
#14339
parent
4bb54a45
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/typecheck/TcDerivInfer.hs
View file @
13fdca3d
...
...
@@ -676,6 +676,8 @@ simplifyDeriv pred tvs thetas
-- Simplify the constraints
;
solved_implics
<-
runTcSDeriveds
$
solveWantedsAndDrop
$
unionsWC
wanteds
-- It's not yet zonked! Obviously zonk it before peering at it
;
solved_implics
<-
zonkWC
solved_implics
-- See [STEP DAC HOIST]
-- Split the resulting constraints into bad and good constraints,
...
...
testsuite/tests/deriving/should_compile/T14339.hs
0 → 100644
View file @
13fdca3d
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module
Bug
where
import
GHC.TypeLits
newtype
Baz
=
Baz
Foo
deriving
Bar
newtype
Foo
=
Foo
Int
class
Bar
a
where
bar
::
a
instance
(
TypeError
(
Text
"Boo"
))
=>
Bar
Foo
where
bar
=
undefined
testsuite/tests/deriving/should_compile/all.T
View file @
13fdca3d
...
...
@@ -96,3 +96,4 @@ test('T13919', normal, compile, [''])
test
('
T13998
',
normal
,
compile
,
[''])
test
('
T14045b
',
normal
,
compile
,
[''])
test
('
T14094
',
normal
,
compile
,
[''])
test
('
T14339
',
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