"Could not unambiguously deduce"..

C.Reinke C.Reinke@ukc.ac.uk
Wed, 06 Nov 2002 16:15:47 +0000


I'm not actually sure whether this is a bug, but if it isn't, 
could someone please enlighten me about what is going on?-)

[the following is a simplified version of a problem with instances
 generated by Drift, for Strafunksi, where T would be the Drift
 target, C would be Term, and expl(ode) would return TermRep] 

------------

{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances -fallow-undecidable-instances #-}

module Main where

data T a = D [a]

class C t where
   expl :: t -> String
   expl x = "default"

instance        C String where expl s = "String"
instance C a => C [a]    where expl l = "[a]"

instance (C a {- ,C [a] -} ) => C (T a) where
    expl (D xs) = expl xs

main = putStrLn $ expl "hi"

------------

As is, both ghc and hugs reject the program, whereas
both accept it with the extra constraint in the C (T a)
instance.. Now, I think I can see how the right-hand-side
expl could come either from the C String or from the C [a]
instance - hence ghc's message:

  $ ghc --make Tst.hs
  c:\ghc\ghc-5.04\bin\ghc.exe: chasing modules from: Tst.hs
  Compiling Main             ( Tst.hs, ./Tst.o )

  Tst.hs:15:
      Could not unambiguously deduce (C [a])
          from the context (C (T a), C a)
      The choice of (overlapping) instance declaration
          depends on the instantiation of `a'
      Probable fix:
          Add (C [a]) to the class or instance method `expl'
          Or add an instance declaration for (C [a])
      arising from use of `expl' at Tst.hs:15
      In the definition of `expl': expl xs

What I don't understand, however, is why adding that extra
constraint helps in any way? Shouldn't the addition of new 
things in the context only make more options available? Why
does it make some of the existing, amgibuous options go away?

Confused,
Claus

PS. Perhaps related, but why does Hugs seem to ignore the 
    C a constraint in the context of the original version?

    $ hugs -98 Tst.hs
    __   __ __  __  ____   ___
    _________________________________________
    ||   || ||  || ||  || ||__      Hugs 98: Based on the Haskell 98
    standard
    ||___|| ||__|| ||__||  __||     Copyright (c) 1994-2001
    ||---||         ___||           World Wide Web:
    http://haskell.org/hugs
    ||   ||                         Report bugs to:
    hugs-bugs@haskell.org
    ||   || Version: December 2001
    _________________________________________

    Hugs mode: Restart with command line option +98 for Haskell 98 mode

    Reading file "c:\Program Files\Hugs98\\lib\Prelude.hs":
    Reading file "Tst.hs":
    Type checking
    ERROR "Tst.hs":15 - Cannot justify constraints in instance member
    binding
    *** Expression    : expl
    *** Type          : C (T a) => T a -> String
    *** Given context : C (T a)
    *** Constraints   : C [a]

    Prelude>