Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Fumiaki Kinoshita
GHC
Commits
0b00c6a0
Commit
0b00c6a0
authored
Jan 12, 2011
by
simonpj
Browse files
Massive bunch of changes to track my massive refactoring to the typechecker
parent
ca15920e
Changes
157
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/annotations/should_fail/annfail07.stderr
View file @
0b00c6a0
annfail07.hs:9:17:
Couldn't match expected type `[a]' with actual type `Bool'
Couldn't match expected type `[a
0
]' with actual type `Bool'
In the first argument of `head', namely `True'
In the expression: (head True)
In the annotation: {-# ANN f (head True) #-}
testsuite/tests/ghc-regress/annotations/should_fail/annfail08.stderr
View file @
0b00c6a0
annfail08.hs:9:1:
No instance for (Data.Data.Data (a -> a))
No instance for (Data.Data.Data (a
0
-> a
0
))
arising from an annotation
Possible fix:
add an instance declaration for (Data.Data.Data (a -> a))
add an instance declaration for (Data.Data.Data (a
0
-> a
0
))
In the expression: (id + 1)
In the annotation: {-# ANN f (id + 1) #-}
annfail08.hs:9:15:
No instance for (Num (a -> a))
arising from a use of `+'
Possible fix: add an instance declaration for (Num (a -> a))
annfail08.hs:9:17:
No instance for (Num (a0 -> a0))
arising from the literal `1'
Possible fix: add an instance declaration for (Num (a0 -> a0))
In the second argument of `(+)', namely `1'
In the expression: (id + 1)
In the annotation: {-# ANN f (id + 1) #-}
testsuite/tests/ghc-regress/annotations/should_fail/annfail10.stderr
View file @
0b00c6a0
annfail10.hs:9:1:
Ambiguous type variable `a' in the constraints:
(
Data.Data.Data
a) arising from
an annotation
a
t
ann
fail10.hs:9:1-15
(Num a) arising from the literal `1'
at annfail10.hs:9:1
1
annfail10.hs:9:1
1
:
Ambiguous type variable `a
0
' in the constraints:
(
Num
a
0
) arising from
the literal `1' at annfail10.hs:9:11
(Data.Data.Data a0) arising from
a
n
ann
otation
at annfail10.hs:9:1
-15
Probable fix: add a type signature that fixes these type variable(s)
In the expression: 1
In the annotation: {-# ANN f 1 #-}
testsuite/tests/ghc-regress/deriving/should_fail/T2851.stderr
View file @
0b00c6a0
...
...
@@ -2,7 +2,8 @@
T2851.hs:9:15:
No instance for (Show (F a))
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Show (F a))
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Show (F a))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Show (D a))
testsuite/tests/ghc-regress/deriving/should_fail/T3621.hs
View file @
0b00c6a0
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies
, FlexibleContexts, UndecidableInstances, StandaloneDeriving
#-}
module
T3621
where
-- This one is ok, even though the deriving clause mentions 'a'
...
...
@@ -18,6 +18,19 @@ instance Monad (State s) where {}
instance
MonadState
s
(
State
s
)
where
{}
newtype
WrappedState
s
a
=
WS
{
runWS
::
State
s
a
}
deriving
(
Monad
,
MonadState
state
)
deriving
(
Monad
,
MonadState
state
)
-- deriving (Monad)
deriving
instance
(
MonadState
state
(
State
s
))
=>
MonadState
state
(
WrappedState
s
)
-- ASSERT error
-- deriving instance (MonadState state (State s), Monad (WrappedState s))
-- => MonadState s (WrappedState s)
-- We try
-- instance MonadState state (State state a)
-- => MonadState state (WrappedState state a)
--
-- Superclass needs (Monad (WrappedState state a))
testsuite/tests/ghc-regress/deriving/should_fail/T3621.stderr
View file @
0b00c6a0
T3621.hs:21:22:
Couldn't match type `s' with `state'
`s' is a rigid type variable bound by
the instance declaration at T3621.hs:21:22
`state' is a rigid type variable bound by
the instance declaration at T3621.hs:21:22
arising from the 'deriving' clause of a data type declaration
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
T3621.hs:21:21:
No instance for (MonadState state (State s))
arising from the 'deriving' clause of a data type declaration
Possible fix:
add an instance declaration for (MonadState state (State s))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (MonadState state (WrappedState s))
testsuite/tests/ghc-regress/deriving/should_fail/drvfail-foldable-traversable1.stderr
View file @
0b00c6a0
...
...
@@ -2,17 +2,19 @@
drvfail-foldable-traversable1.hs:9:23:
No instance for (Functor Trivial1)
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Functor Trivial1)
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Functor Trivial1)
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Traversable Trivial1)
drvfail-foldable-traversable1.hs:13:22:
No instance for (Foldable Trivial2)
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Foldable Trivial2)
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Foldable Trivial2)
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Traversable Trivial2)
drvfail-foldable-traversable1.hs:17:22:
...
...
testsuite/tests/ghc-regress/deriving/should_fail/drvfail-functor2.stderr
View file @
0b00c6a0
...
...
@@ -22,7 +22,8 @@ drvfail-functor2.hs:20:14:
drvfail-functor2.hs:26:14:
No instance for (Functor NoFunctor)
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Functor NoFunctor)
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Functor NoFunctor)
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Functor UseNoFunctor)
testsuite/tests/ghc-regress/deriving/should_fail/drvfail001.stderr
View file @
0b00c6a0
...
...
@@ -2,7 +2,8 @@
drvfail001.hs:16:33:
No instance for (Show (f (f a)))
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Show (f (f a)))
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Show (f (f a)))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Show (SM f a))
testsuite/tests/ghc-regress/deriving/should_fail/drvfail003.stderr
View file @
0b00c6a0
...
...
@@ -2,7 +2,8 @@
drvfail003.hs:16:56:
No instance for (Show (v (v a)))
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Show (v (v a)))
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Show (v (v a)))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Show (Square_ v w a))
testsuite/tests/ghc-regress/deriving/should_fail/drvfail004.stderr
View file @
0b00c6a0
...
...
@@ -2,7 +2,8 @@
drvfail004.hs:8:12:
No instance for (Eq (Foo a b))
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Eq (Foo a b))
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Eq (Foo a b))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Ord (Foo a b))
testsuite/tests/ghc-regress/deriving/should_fail/drvfail007.stderr
View file @
0b00c6a0
...
...
@@ -2,7 +2,8 @@
drvfail007.hs:4:38:
No instance for (Eq (Int -> Int))
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Eq (Int -> Int))
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Eq (Int -> Int))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Eq Foo)
testsuite/tests/ghc-regress/deriving/should_fail/drvfail012.stderr
View file @
0b00c6a0
...
...
@@ -2,7 +2,8 @@
drvfail012.hs:5:33:
No instance for (Eq (Ego a))
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Eq (Ego a))
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Eq (Ego a))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Ord (Ego a))
testsuite/tests/ghc-regress/deriving/should_fail/drvfail013.stderr
View file @
0b00c6a0
...
...
@@ -2,15 +2,17 @@
drvfail013.hs:4:70:
No instance for (Eq (m (Maybe a)))
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Eq (m (Maybe a)))
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Eq (m (Maybe a)))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Eq (MaybeT m a))
drvfail013.hs:6:70:
No instance for (Eq (m (Maybe a)))
arising from the 'deriving' clause of a data type declaration
Possible fix: add an instance declaration for (Eq (m (Maybe a)))
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
Possible fix:
add an instance declaration for (Eq (m (Maybe a)))
or use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (Eq (MaybeT' m a))
testsuite/tests/ghc-regress/gadt/T3651.stderr
View file @
0b00c6a0
...
...
@@ -2,20 +2,20 @@
T3651.hs:11:11:
Couldn't match type `()' with `Bool'
Inaccessible code in
a pattern with constructor
`U'
, in an equation for `unsafe1'
a pattern with constructor
U :: Z ()
, in an equation for `unsafe1'
In the pattern: U
In an equation for `unsafe1': unsafe1 B U = ()
T3651.hs:14:11:
Couldn't match type `()' with `Bool'
Inaccessible code in
a pattern with constructor
`U'
, in an equation for `unsafe2'
a pattern with constructor
U :: Z ()
, in an equation for `unsafe2'
In the pattern: U
In an equation for `unsafe2': unsafe2 B U = ()
T3651.hs:17:11:
Couldn't match type `()' with `Bool'
Inaccessible code in
a pattern with constructor
`U'
, in an equation for `unsafe3'
a pattern with constructor
U :: Z ()
, in an equation for `unsafe3'
In the pattern: U
In an equation for `unsafe3': unsafe3 B U = True
testsuite/tests/ghc-regress/gadt/gadt10.stderr
View file @
0b00c6a0
gadt10.hs:6:24:
`RInt' is not applied to enough type arguments
Expected kind `?', but `RInt' has kind `k -> *'
Expected kind `?', but `RInt' has kind `k
0
-> *'
In the type `RInt'
In the definition of data constructor `R'
In the data type declaration for `RInt'
testsuite/tests/ghc-regress/gadt/gadt21.stderr
View file @
0b00c6a0
gadt21.hs:21:60:
Could not deduce (Ord a1) from the context (a ~ Set a1)
arising from a use of `f'
Could not deduce (Ord a1) arising from a use of `f'
from the context (a ~ Set a1)
bound by a pattern with constructor
TypeSet :: forall a. Type a -> Type (Set a),
in an equation for `withOrdDynExpr'
at gadt21.hs:21:35-43
Possible fix:
add (Ord a1) to the context of
the data constructor `TypeSet'
or the data constructor `DynExpr'
or the type signature for `withOrdDynExpr'
or the type signature for
withOrdDynExpr :: DynExpr
-> (forall a. Ord a => Expr a -> b)
-> Maybe b
In the first argument of `Just', namely `(f e)'
In the expression: Just (f e)
In an equation for `withOrdDynExpr':
...
...
testsuite/tests/ghc-regress/gadt/rw.stderr
View file @
0b00c6a0
...
...
@@ -2,7 +2,8 @@
rw.hs:14:47:
Couldn't match type `a' with `Int'
`a' is a rigid type variable bound by
the type signature for `writeInt' at rw.hs:12:14
the type signature for writeInt :: T a -> IORef a -> IO ()
at rw.hs:13:1
In the second argument of `writeIORef', namely `(1 :: Int)'
In the expression: writeIORef ref (1 :: Int)
In a case alternative: ~(Li x) -> writeIORef ref (1 :: Int)
...
...
@@ -10,7 +11,9 @@ rw.hs:14:47:
rw.hs:19:51:
Couldn't match type `a' with `Bool'
`a' is a rigid type variable bound by
the type signature for `readBool' at rw.hs:16:14
the type signature for readBool :: T a -> IORef a -> IO ()
at rw.hs:17:1
Expected type: a -> Bool
Actual type: Bool -> Bool
In the second argument of `(.)', namely `not'
In the second argument of `(>>=)', namely `(print . not)'
In the expression: readIORef ref >>= (print . not)
testsuite/tests/ghc-regress/ghci.debugger/scripts/break012.stdout
View file @
0b00c6a0
Stopped at break012.hs:(1,1)-(5,18)
_result :: (
a1
, a
2
-> a
2
, (), a -> a -> a) = _
_result :: (
t
, a
1
-> a
1
, (), a -> a -> a) = _
Stopped at break012.hs:5:10-18
_result :: (
a1
, a
2
-> a
2
, (), a -> a -> a) = _
a ::
a1
= _
b :: a
3
-> a
3
= _
_result :: (
t
, a
1
-> a
1
, (), a -> a -> a) = _
a ::
t
= _
b :: a
2
-> a
2
= _
c :: () = _
d :: a -> a -> a = _
a ::
a1
b :: a
3
-> a
3
a ::
t
b :: a
2
-> a
2
c :: ()
d :: a -> a -> a
a = (_t1::
a1
)
b = (_t2::forall a
3
. a
3
-> a
3
)
a = (_t1::
t
)
b = (_t2::forall a
2
. a
2
-> a
2
)
c = (_t3::())
d = (_t4::a -> a -> a)
testsuite/tests/ghc-regress/ghci.debugger/scripts/print006.stdout
View file @
0b00c6a0
...
...
@@ -2,7 +2,7 @@ t = O (_t1::t)
()
t = O ((_t2::a1) : (_t3::[a1]))
()
t = O ((_t4::a
11
) : (_t5::a
11
) : (_t6::[a
11
]))
t = O ((_t4::a
2
) : (_t5::a
2
) : (_t6::[a
2
]))
()
t = O ((_t7::Maybe [a1]) : Just [(_t8::a1),(_t9::a1)] :
(_t10::[Maybe [a1]]))
...
...
Prev
1
2
3
4
5
…
8
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