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
8cc398ff
Commit
8cc398ff
authored
Feb 09, 2014
by
eir@cis.upenn.edu
Browse files
Fix #8758 by assuming RankNTypes when checking GND code.
parent
02c7135d
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/typecheck/TcDeriv.lhs
View file @
8cc398ff
...
...
@@ -1969,7 +1969,8 @@ genInst standalone_deriv oflag comauxs
, iBinds = InstBindings
{ ib_binds = gen_Newtype_binds loc clas tvs tys rhs_ty
, ib_pragmas = []
, ib_extensions = [Opt_ImpredicativeTypes]
, ib_extensions = [ Opt_ImpredicativeTypes
, Opt_RankNTypes ]
, ib_standalone_deriving = standalone_deriv } }
, emptyBag
, Just $ getName $ head $ tyConDataCons rep_tycon ) }
...
...
testsuite/tests/deriving/should_compile/T8758.hs
0 → 100644
View file @
8cc398ff
{-# LANGUAGE RankNTypes #-}
module
T8758
where
class
C
m
where
foo
::
(
forall
b
.
b
->
m
b
)
->
c
->
m
c
instance
C
[]
where
foo
f
c
=
f
c
\ No newline at end of file
testsuite/tests/deriving/should_compile/T8758a.hs
0 → 100644
View file @
8cc398ff
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module
T8758a
where
import
T8758
newtype
MyList
a
=
Mk
[
a
]
deriving
C
\ No newline at end of file
testsuite/tests/deriving/should_compile/all.T
View file @
8cc398ff
...
...
@@ -42,4 +42,5 @@ test('T7710', normal, compile, [''])
test
('
AutoDeriveTypeable
',
normal
,
compile
,
[''])
test
('
T8138
',
reqlib
('
primitive
'),
compile
,
['
-O2
'])
test
('
T8631
',
normal
,
compile
,
[''])
\ No newline at end of file
test
('
T8631
',
normal
,
compile
,
[''])
test
('
T8758
',
extra_clean
(['
T8758a.o
',
'
T8758a.hi
']),
multimod_compile
,
['
T8758a
',
'
-v0
'])
\ 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