<div dir="ltr">Hi Joachim,<div><br></div><div>Here is a piece of code that produces the desired error:</div><div><br></div><div><div><font face="courier new, monospace">{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}</font></div>
<div><font face="courier new, monospace">{-# LANGUAGE DataKinds, KindSignatures #-}</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data P (x :: Bool) = P</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">class And a b c | a b -> c where</font></div><div><font face="courier new, monospace">  op :: P a -> P b -> P c</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">instance And False False False where</font></div><div><font face="courier new, monospace">  op _ _ = P</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">test = op (P :: P False) (P :: P False) :: P True</font></div></div><div><font face="courier new, monospace"><br></font></div><div><font face="arial, helvetica, sans-serif">The `DataKinds` and `KindSigantures` are only used to match your example closely.</font></div>
<div><font face="arial, helvetica, sans-serif">Here is a simpler version that causes essentially the same error:</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"><div>
<div>{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}</div><div><br></div><div>class C a b | a -> b where</div><div>  op :: a -> b</div><div><br></div><div>instance C Bool Char where</div><div>  op _ = 'a'</div>
<div><br></div><div>test = op True :: Float</div></div><div><br></div><div><br></div></font></div><div><font face="courier new, monospace"><br></font></div><div><font face="arial, helvetica, sans-serif">-Iavor</font></div>
<div><br></div></div><div class="gmail_extra"><br><br><div class="gmail_quote">On Tue, Dec 3, 2013 at 4:09 AM, Joachim Breitner <span dir="ltr"><<a href="mailto:mail@joachim-breitner.de" target="_blank">mail@joachim-breitner.de</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hi,<br>
<br>
I have an error message, and I’m looking for code that produces it (how<br>
is that for a change...)<br>
<br>
While fixing <a href="https://ghc.haskell.org/trac/ghc/ticket/8576" target="_blank">https://ghc.haskell.org/trac/ghc/ticket/8576</a> I’d like to<br>
clean up some error reporting in FunDeps.lhs, in particular code that is<br>
involved in producing errors like<br>
<br>
    Couldn't match type 'False with 'True<br>
    When using functional dependencies to combine<br>
      And 'False 'False 'False,<br>
        arising from the dependency `a b -> c'<br>
        in the instance declaration in `UnitTyped.Units'<br>
      And 'False 'False 'True,<br>
        arising from a use of `+' at <interactive>:14:7<br>
    In the expression: meter + second<br>
    In an equation for `it': it = meter + second<br>
<br>
but unfortunately, the test suite does _not_ contain any code that<br>
creates this error message. Also, the results obtained from googling for<br>
that error message yield either no code, or only unhelpful code<br>
fragments, or code that produces a different error message with current<br>
HEAD.<br>
<br>
Unfortunately, I cannot produce code that triggers it. Does anyone have<br>
code lying around that triggers that error message?<br>
<br>
Also: I found code that had this kind of error message in 7.6, e.g. the<br>
attached code’s error changed from<br>
<br>
        FunDepError.hs:86:27:<br>
            Couldn't match type `F a1' with `U'<br>
            When using functional dependencies to combine<br>
              UpdateR (xs :> s) (S n) t (xs' :> s),<br>
                arising from the dependency xs n t -> xs'<br>
                in the instance declaration at FunDepError.hs:54:10<br>
              UpdateR ((xs' :> F a0) :> F a1) (S O) U ((jj0 :> U) :> U),<br>
                arising from a use of `var' at FunDepError.hs:86:27-29<br>
            In the expression: var a<br>
            In the first argument of `lam', namely `(\ b -> var a)'<br>
<br>
(sorry for not finding something simpler) to<br>
<br>
        FunDepError.hs:86:5:<br>
            No instance for (Consume xs' jj) arising from a use of ‛lam’<br>
            Possible fix:<br>
              add (Consume xs' jj) to the context of<br>
                the inferred type of x :: LLC t xs' jj (a :-> (a1 :-> a))<br>
            In the expression: lam (\ a -> lam (\ b -> var a))<br>
            In an equation for ‛x’: x = lam (\ a -> lam (\ b -> var a))<br>
<br>
        FunDepError.hs:86:27:<br>
            No instance for (UpdateR<br>
                               ((xs' :> F a) :> F a1) (S O) U ((jj :> U) :> U))<br>
              arising from a use of ‛var’<br>
            In the expression: var a<br>
            In the first argument of ‛lam’, namely ‛(\ b -> var a)’<br>
            In the expression: lam (\ b -> var a)<br>
<br>
Is that desired or a regression?<br>
<br>
Greetings,<br>
Joachim<br>
<span class="HOEnZb"><font color="#888888"><br>
<br>
--<br>
Joachim “nomeata” Breitner<br>
  <a href="mailto:mail@joachim-breitner.de">mail@joachim-breitner.de</a> • <a href="http://www.joachim-breitner.de/" target="_blank">http://www.joachim-breitner.de/</a><br>
  Jabber: <a href="mailto:nomeata@joachim-breitner.de">nomeata@joachim-breitner.de</a>  • GPG-Key: 0x4743206C<br>
  Debian Developer: <a href="mailto:nomeata@debian.org">nomeata@debian.org</a><br>
</font></span><br>_______________________________________________<br>
ghc-devs mailing list<br>
<a href="mailto:ghc-devs@haskell.org">ghc-devs@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/ghc-devs" target="_blank">http://www.haskell.org/mailman/listinfo/ghc-devs</a><br>
<br></blockquote></div><br></div>