arising from the dependency ... in the instance declaration
Iavor Diatchki
iavor.diatchki at gmail.com
Tue Dec 3 19:08:01 UTC 2013
Hi Joachim,
Here is a piece of code that produces the desired error:
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE DataKinds, KindSignatures #-}
data P (x :: Bool) = P
class And a b c | a b -> c where
op :: P a -> P b -> P c
instance And False False False where
op _ _ = P
test = op (P :: P False) (P :: P False) :: P True
The `DataKinds` and `KindSigantures` are only used to match your example
closely.
Here is a simpler version that causes essentially the same error:
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
class C a b | a -> b where
op :: a -> b
instance C Bool Char where
op _ = 'a'
test = op True :: Float
-Iavor
On Tue, Dec 3, 2013 at 4:09 AM, Joachim Breitner
<mail at joachim-breitner.de>wrote:
> Hi,
>
> I have an error message, and I’m looking for code that produces it (how
> is that for a change...)
>
> While fixing https://ghc.haskell.org/trac/ghc/ticket/8576 I’d like to
> clean up some error reporting in FunDeps.lhs, in particular code that is
> involved in producing errors like
>
> Couldn't match type 'False with 'True
> When using functional dependencies to combine
> And 'False 'False 'False,
> arising from the dependency `a b -> c'
> in the instance declaration in `UnitTyped.Units'
> And 'False 'False 'True,
> arising from a use of `+' at <interactive>:14:7
> In the expression: meter + second
> In an equation for `it': it = meter + second
>
> but unfortunately, the test suite does _not_ contain any code that
> creates this error message. Also, the results obtained from googling for
> that error message yield either no code, or only unhelpful code
> fragments, or code that produces a different error message with current
> HEAD.
>
> Unfortunately, I cannot produce code that triggers it. Does anyone have
> code lying around that triggers that error message?
>
> Also: I found code that had this kind of error message in 7.6, e.g. the
> attached code’s error changed from
>
> FunDepError.hs:86:27:
> Couldn't match type `F a1' with `U'
> When using functional dependencies to combine
> UpdateR (xs :> s) (S n) t (xs' :> s),
> arising from the dependency xs n t -> xs'
> in the instance declaration at FunDepError.hs:54:10
> UpdateR ((xs' :> F a0) :> F a1) (S O) U ((jj0 :> U) :> U),
> arising from a use of `var' at FunDepError.hs:86:27-29
> In the expression: var a
> In the first argument of `lam', namely `(\ b -> var a)'
>
> (sorry for not finding something simpler) to
>
> FunDepError.hs:86:5:
> No instance for (Consume xs' jj) arising from a use of ‛lam’
> Possible fix:
> add (Consume xs' jj) to the context of
> the inferred type of x :: LLC t xs' jj (a :-> (a1 :-> a))
> In the expression: lam (\ a -> lam (\ b -> var a))
> In an equation for ‛x’: x = lam (\ a -> lam (\ b -> var a))
>
> FunDepError.hs:86:27:
> No instance for (UpdateR
> ((xs' :> F a) :> F a1) (S O) U ((jj :> U)
> :> U))
> arising from a use of ‛var’
> In the expression: var a
> In the first argument of ‛lam’, namely ‛(\ b -> var a)’
> In the expression: lam (\ b -> var a)
>
> Is that desired or a regression?
>
> Greetings,
> Joachim
>
>
> --
> Joachim “nomeata” Breitner
> mail at joachim-breitner.de • http://www.joachim-breitner.de/
> Jabber: nomeata at joachim-breitner.de • GPG-Key: 0x4743206C
> Debian Developer: nomeata at debian.org
>
> _______________________________________________
> ghc-devs mailing list
> ghc-devs at haskell.org
> http://www.haskell.org/mailman/listinfo/ghc-devs
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/ghc-devs/attachments/20131203/6c813f1b/attachment.html>
More information about the ghc-devs
mailing list