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
09cdd12b
Commit
09cdd12b
authored
Oct 19, 2012
by
Simon Peyton Jones
Browse files
Replace Rank2Types and PolymorphicComponents by RankNTypes
parent
c6734223
Changes
78
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/deSugar/should_compile/ds050.hs
View file @
09cdd12b
{-# LANGUAGE Rank
2
Types #-}
{-# LANGUAGE Rank
N
Types #-}
module
ShouldCompile
where
...
...
testsuite/tests/gadt/doaitse.hs
View file @
09cdd12b
{-# LANGUAGE GADTs, ExistentialQuantification, ScopedTypeVariables,
Rank
2
Types #-}
Rank
N
Types #-}
-- Here's an example from Doaitse Swiestra (Sept 06)
-- which requires use of scoped type variables
...
...
testsuite/tests/gadt/gadt1.hs
View file @
09cdd12b
{-# LANGUAGE GADTs, Rank
2
Types #-}
{-# LANGUAGE GADTs, Rank
N
Types #-}
module
ShouldCompile
where
...
...
testsuite/tests/gadt/gadt21.hs
View file @
09cdd12b
{-# LANGUAGE GADTs, ExistentialQuantification, KindSignatures, Rank
2
Types #-}
{-# LANGUAGE GADTs, ExistentialQuantification, KindSignatures, Rank
N
Types #-}
-- Fails (needs the (Ord a) in TypeSet
-- c.f. gadt22.hs
...
...
testsuite/tests/gadt/gadt22.hs
View file @
09cdd12b
{-# LANGUAGE GADTs, ExistentialQuantification, KindSignatures, Rank
2
Types #-}
{-# LANGUAGE GADTs, ExistentialQuantification, KindSignatures, Rank
N
Types #-}
-- Succeeds (needs the (Ord a) in TypeSet
-- c.f. gadt21.hs
...
...
testsuite/tests/gadt/nbe.hs
View file @
09cdd12b
{-# LANGUAGE GADTs, Rank
2
Types #-}
{-# LANGUAGE GADTs, Rank
N
Types #-}
module
Main
where
...
...
testsuite/tests/gadt/termination.hs
View file @
09cdd12b
{-# LANGUAGE GADTs, Rank
2
Types #-}
{-# LANGUAGE GADTs, Rank
N
Types #-}
module
Termination
where
...
...
testsuite/tests/ghci.debugger/scripts/print012.script
View file @
09cdd12b
:set -XGADTs -XRank
2
Types -XExistentialQuantification -XDeriveDataTypeable -XGeneralizedNewtypeDeriving
:set -XGADTs -XRank
N
Types -XExistentialQuantification -XDeriveDataTypeable -XGeneralizedNewtypeDeriving
:l ../GADT
:a ../Test
:m +Main
...
...
testsuite/tests/ghci.debugger/scripts/print013.script
View file @
09cdd12b
-- Test handling of extra fields in the representation due to dictionaries
:set -XGADTs -XRank
2
Types
:set -XGADTs -XRank
N
Types
:l ../GADT
let d = DictN (1 :: Integer)
...
...
testsuite/tests/ghci.debugger/scripts/print014.script
View file @
09cdd12b
-- Test handling of extra fields in the representation due to existentials.
:set -XGADTs -XRank
2
Types
:set -XGADTs -XRank
N
Types
:l ../GADT
let e = Exist 1
...
...
testsuite/tests/ghci.debugger/scripts/print034.script
View file @
09cdd12b
-- More GADT goodness
:set -XGADTs -XRank
2
Types -XDeriveDataTypeable -XGeneralizedNewtypeDeriving
:set -XGADTs -XRank
N
Types -XDeriveDataTypeable -XGeneralizedNewtypeDeriving
:l ../GADT
:a ../Test
:m +Main
...
...
testsuite/tests/ghci/prog008/A.hs
View file @
09cdd12b
{-# LANGUAGE Rank
2
Types, MultiParamTypeClasses #-}
{-# LANGUAGE Rank
N
Types, MultiParamTypeClasses #-}
-- Tests a bug spotted by Claus in which the type
-- of c3 was wrongly displayed in GHCi as
...
...
testsuite/tests/ghci/scripts/ghci025.hs
View file @
09cdd12b
{-# LANGUAGE Rank
2
Types, MultiParamTypeClasses #-}
{-# LANGUAGE Rank
N
Types, MultiParamTypeClasses #-}
module
T
where
...
...
testsuite/tests/haddock/haddock_examples/test.T
View file @
09cdd12b
...
...
@@ -3,4 +3,4 @@ test('haddock.Test',
extra_clean
(['
Test.hi
',
'
Test.o
',
'
Hidden.hi
',
'
Hidden.o
',
'
Visible.hi
',
'
Visible.o
'])],
multimod_compile
,
['
Test Hidden Visible
',
'
-XRank
2
Types -XExistentialQuantification -haddock -ddump-parsed
'])
['
Test Hidden Visible
',
'
-XRank
N
Types -XExistentialQuantification -haddock -ddump-parsed
'])
testsuite/tests/haddock/should_compile_flag_haddock/all.T
View file @
09cdd12b
...
...
@@ -23,8 +23,8 @@ test('haddockA022', normal, compile, ['-haddock -ddump-parsed'])
test
('
haddockA023
',
normal
,
compile
,
['
-haddock -ddump-parsed
'])
test
('
haddockA024
',
normal
,
compile
,
['
-haddock -ddump-parsed
'])
test
('
haddockA025
',
normal
,
compile
,
['
-haddock -ddump-parsed
'])
test
('
haddockA026
',
normal
,
compile
,
['
-haddock -ddump-parsed -XRank
2
Types
'])
test
('
haddockA027
',
normal
,
compile
,
['
-haddock -ddump-parsed -XRank
2
Types
'])
test
('
haddockA026
',
normal
,
compile
,
['
-haddock -ddump-parsed -XRank
N
Types
'])
test
('
haddockA027
',
normal
,
compile
,
['
-haddock -ddump-parsed -XRank
N
Types
'])
test
('
haddockA028
',
normal
,
compile
,
['
-haddock -ddump-parsed -XTypeOperators
'])
test
('
haddockA029
',
normal
,
compile
,
['
-haddock -ddump-parsed
'])
test
('
haddockA030
',
normal
,
compile
,
['
-haddock -ddump-parsed
'])
...
...
testsuite/tests/haddock/should_compile_noflag_haddock/all.T
View file @
09cdd12b
...
...
@@ -23,8 +23,8 @@ test('haddockC022', normal, compile, [''])
test
('
haddockC023
',
normal
,
compile
,
[''])
test
('
haddockC024
',
normal
,
compile
,
[''])
test
('
haddockC025
',
normal
,
compile
,
[''])
test
('
haddockC026
',
normal
,
compile
,
['
-XRank
2
Types
'])
test
('
haddockC027
',
normal
,
compile
,
['
-XRank
2
Types
'])
test
('
haddockC026
',
normal
,
compile
,
['
-XRank
N
Types
'])
test
('
haddockC027
',
normal
,
compile
,
['
-XRank
N
Types
'])
test
('
haddockC028
',
normal
,
compile
,
['
-XTypeOperators
'])
test
('
haddockC029
',
normal
,
compile
,
[''])
test
('
haddockC030
',
normal
,
compile
,
[''])
...
...
testsuite/tests/indexed-types/should_compile/Roman1.hs
View file @
09cdd12b
{-# LANGUAGE TypeFamilies, Rank
2
Types #-}
{-# LANGUAGE TypeFamilies, Rank
N
Types #-}
-- This test made the type checker produce an
-- ill-kinded coercion term.
...
...
testsuite/tests/indexed-types/should_compile/T3787.hs
View file @
09cdd12b
...
...
@@ -16,7 +16,7 @@
-- | Module "Trampoline" defines the trampoline computations and their basic building blocks.
{-# LANGUAGE ScopedTypeVariables, Rank
2
Types, MultiParamTypeClasses, TypeFamilies, KindSignatures,
{-# LANGUAGE ScopedTypeVariables, Rank
N
Types, MultiParamTypeClasses, TypeFamilies, KindSignatures,
FlexibleContexts, FlexibleInstances, OverlappingInstances, UndecidableInstances
#-}
...
...
testsuite/tests/indexed-types/should_compile/T4120.hs
View file @
09cdd12b
{-# LANGUAGE Rank
2
Types, TypeFamilies #-}
{-# LANGUAGE Rank
N
Types, TypeFamilies #-}
-- Unification yielding a coercion under a forall
...
...
testsuite/tests/indexed-types/should_compile/T4178.hs
View file @
09cdd12b
{-# LANGUAGE
FlexibleContexts,
Rank
2
Types,
Rank
N
Types,
TypeFamilies,
MultiParamTypeClasses,
FlexibleInstances #-}
...
...
Prev
1
2
3
4
Next
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