Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
obsidiansystems
GHC
Commits
324f9952
Commit
324f9952
authored
Oct 22, 2013
by
eir@cis.upenn.edu
Browse files
Wibbles to output regarding role annotations.
parent
99cd277c
Changes
9
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghci/scripts/T4175.stdout
View file @
324f9952
type role A nominal nominal
type family A a b :: *
-- Defined at T4175.hs:4:1
type family A a b :: * -- Defined at T4175.hs:4:1
type instance A (Maybe a) a -- Defined at T4175.hs:6:1
type instance A Int Int -- Defined at T4175.hs:5:1
type role B nominal
data family B a
-- Defined at T4175.hs:8:1
data instance B () -- Defined at T4175.hs:9:15
type role C nominal
class C a where
type role D nominal nominal
type family D a b :: *
-- Defined at T4175.hs:12:5
type D () () -- Defined at T4175.hs:18:5
type D Int () -- Defined at T4175.hs:15:5
type role E nominal
type family E a :: * where
E () = Bool
E Int = String
...
...
testsuite/tests/ghci/scripts/T5417.stdout
View file @
324f9952
...
...
@@ -3,7 +3,6 @@ type role T5417.R:FB1 nominal
data instance C.F (B1 a) = B2 a
type role D nominal
data family D a
type role C.C1 nominal
class C.C1 a where
type role C.F nominal
data family C.F a
...
...
testsuite/tests/ghci/scripts/T7939.stdout
View file @
324f9952
type role Foo nominal
class Foo (a :: k) where
type role Bar nominal nominal
type family Bar (a :: k) b :: *
-- Defined at T7939.hs:6:4
Bar :: k -> * -> *
type role F nominal
type family F a :: *
-- Defined at T7939.hs:8:1
type family F a :: * -- Defined at T7939.hs:8:1
type instance F Int -- Defined at T7939.hs:9:1
F :: * -> *
type role G nominal
type family G a :: * where
G Int = Bool
type family G a :: * where G Int = Bool
-- Defined at T7939.hs:11:1
G :: * -> *
type role H nominal
type family H (a :: Bool) :: Bool where
H 'False = 'True
type family H (a :: Bool) :: Bool where H 'False = 'True
-- Defined at T7939.hs:14:1
H :: Bool -> Bool
type role J nominal
type family J (a :: [k]) :: Bool where
J '[] = 'False
J (h : t) = 'True
-- Defined at T7939.hs:17:1
J :: [k] -> Bool
type role K nominal
type family K (a :: [k]) :: Maybe k where
K '[] = 'Nothing
K (h : t) = 'Just h
...
...
testsuite/tests/ghci/scripts/ghci025.stdout
View file @
324f9952
...
...
@@ -2,9 +2,7 @@
:browse! *T
-- defined locally
T.length :: T.Integer
type role N phantom
class N a
type role S phantom
class S a
class C a b where
c1 :: N b => a -> b
...
...
@@ -62,9 +60,7 @@ T.length :: Data.ByteString.Internal.ByteString -> GHC.Types.Int
:browse! T
-- defined locally
T.length :: T.Integer
type role N phantom
class N a
type role S phantom
class S a
class C a b where
c1 :: N b => a -> b
...
...
@@ -78,9 +74,7 @@ c4 :: C a b => forall a1. a1 -> b
:browse! T -- with -fprint-explicit-foralls
-- defined locally
T.length :: T.Integer
type role N phantom
class N a
type role S phantom
class S a
class C a b where
c1 :: N b => a -> b
...
...
testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
View file @
324f9952
...
...
@@ -2,32 +2,23 @@
ClosedFam3.hs-boot:5:1:
Type constructor ‛Foo’ has conflicting definitions in the module
and its hs-boot file
Main module: type role Foo nominal
type family Foo a :: * where
Main module: type family Foo a :: * where
Foo Int = Bool
Foo Double = Char
Boot file: type role Foo nominal
type family Foo a :: * where
Foo Int = Bool
Boot file: type family Foo a :: * where Foo Int = Bool
ClosedFam3.hs-boot:8:1:
Type constructor ‛Bar’ has conflicting definitions in the module
and its hs-boot file
Main module: type role Bar nominal
type family Bar a :: * where
Main module: type family Bar a :: * where
Bar Int = Bool
Bar Double = Double
Boot file: type role Bar nominal
type family Bar a :: * where
Boot file: type family Bar a :: * where
Bar Int = Bool
Bar Double = Char
ClosedFam3.hs-boot:12:1:
Type constructor ‛Baz’ has conflicting definitions in the module
and its hs-boot file
Main module: type role Baz nominal
type family Baz a :: * where
Baz Int = Bool
Boot file: type role Baz nominal
type family Baz (a :: k) :: * where
Baz Int = Bool
Main module: type family Baz a :: * where Baz Int = Bool
Boot file: type family Baz (a :: k) :: * where Baz Int = Bool
testsuite/tests/polykinds/T7272.hs-boot
View file @
324f9952
...
...
@@ -2,5 +2,4 @@
module
T7272
where
type
role
C
phantom
class
C
(
a
::
k
)
testsuite/tests/roles/should_compile/Roles3.stderr
View file @
324f9952
...
...
@@ -2,7 +2,7 @@ TYPE SIGNATURES
TYPE CONSTRUCTORS
C1 :: * -> Constraint
class C1 a
Roles: [
representatio
nal]
Roles: [
nomi
nal]
RecFlag NonRecursive
meth1 :: a -> a
C2 :: * -> * -> Constraint
...
...
@@ -12,13 +12,13 @@ TYPE CONSTRUCTORS
meth2 :: (~) * a b -> a -> b
C3 :: * -> * -> Constraint
class C3 a b
Roles: [
representatio
nal, nominal]
Roles: [
nomi
nal, nominal]
RecFlag NonRecursive
type family F3 b :: * (open)
meth3 :: a -> F3 b -> F3 b
C4 :: * -> * -> Constraint
class C4 a b
Roles: [
representatio
nal, nominal]
Roles: [
nomi
nal, nominal]
RecFlag NonRecursive
meth4 :: a -> F4 b -> F4 b
F4 :: * -> *
...
...
testsuite/tests/roles/should_compile/Roles4.stderr
View file @
324f9952
...
...
@@ -2,19 +2,19 @@ TYPE SIGNATURES
TYPE CONSTRUCTORS
C1 :: * -> Constraint
class C1 a
Roles: [nominal]
RecFlag NonRecursive
meth1 :: a -> a
Roles: [nominal]
RecFlag NonRecursive
meth1 :: a -> a
C2 :: * -> Constraint
class C2 a
Roles: [representational]
RecFlag NonRecursive
meth2 :: a -> a
Roles: [representational]
RecFlag NonRecursive
meth2 :: a -> a
C3 :: * -> Constraint
class C3 a
Roles: [
representatio
nal]
RecFlag NonRecursive
meth3 :: a -> Syn1 a
Roles: [
nomi
nal]
RecFlag NonRecursive
meth3 :: a -> Syn1 a
Syn1 :: * -> *
type Syn1 a = [a]
COERCION AXIOMS
...
...
testsuite/tests/typecheck/should_compile/tc231.stderr
View file @
324f9952
...
...
@@ -7,24 +7,24 @@ TYPE SIGNATURES
TYPE CONSTRUCTORS
Q :: * -> * -> * -> *
data Q s a chain
No C type associated
Roles: [representational, representational, representational]
RecFlag NonRecursive, Promotable
= Node :: forall s a chain. s -> a -> chain -> Q s a chain
Stricts: _ _ _
FamilyInstance: none
No C type associated
Roles: [representational, representational, representational]
RecFlag NonRecursive, Promotable
= Node :: forall s a chain. s -> a -> chain -> Q s a chain
Stricts: _ _ _
FamilyInstance: none
Z :: * -> *
data Z a
No C type associated
Roles: [representational]
RecFlag NonRecursive, Promotable
= Z :: forall a. a -> Z a Stricts: _
FamilyInstance: none
No C type associated
Roles: [representational]
RecFlag NonRecursive, Promotable
= Z :: forall a. a -> Z a Stricts: _
FamilyInstance: none
Zork :: * -> * -> * -> Constraint
class Zork s a b | a -> b
Roles: [nominal,
representational, phantom
]
RecFlag NonRecursive
huh :: forall chain. Q s a chain -> ST s ()
Roles: [nominal,
nominal, nominal
]
RecFlag NonRecursive
huh :: forall chain. Q s a chain -> ST s ()
COERCION AXIOMS
axiom ShouldCompile.NTCo:Zork ::
Zork s a b = forall chain. Q s a chain -> ST s ()
...
...
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