Hi,

I refactored it as such:

apply_listd []        d x = d x
apply_listd ((a,b):t) d x =
  case compare x a of
    EQ -> a
    GT -> b
    _  -> d x

applyd f d x = look f
  where
    k = 5

    look (Leaf h l)
      | h == k = apply_listd l d x
    look (Branch p b l r)
      | (k `xor` p) .&. (b - 1) == 0 = look (if k .&. b == 0 then l else r)
    look _ = d x

...and it compiled so i'm not sure what happened there. Simpler though: adding the type signature

applyd :: Ord a => Func a b -> (a -> b) -> a -> b

also made it compile. I'm not sure why ghc thinks there's multiple instances to choose from (somebody please explain), but in any case adding type signatures will give you better error messages/help ghc.

Hope that helps a bit.

On Sun, Jan 29, 2017 at 4:00 AM, <beginners-request@haskell.org> wrote:
Send Beginners mailing list submissions to
        beginners@haskell.org

To subscribe or unsubscribe via the World Wide Web, visit
        http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
or, via email, send a message with subject or body 'help' to
        beginners-request@haskell.org

You can reach the person managing the list at
        beginners-owner@haskell.org

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1.  Ambiguous type variable prevents the constraint  `(Ord t0)'
      from being solved. (Ivan Kush)


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

Message: 1
Date: Sat, 28 Jan 2017 23:09:09 +0300
From: Ivan Kush <ivan.v.kush@yandex.ru>
To: beginners@haskell.org
Subject: [Haskell-beginners] Ambiguous type variable prevents the
        constraint      `(Ord t0)' from being solved.
Message-ID: <5152611485634149@web34j.yandex.ru>
Content-Type: text/plain; charset=utf-8

I get this error (full message at the end of the mail). How could I correct my code?


===================
Code:
===================

module Intro where

import Data.Bits --  for xor, .&.

data Func a b
    = Empty
    | Leaf Int [(a, b)]
    | Branch Int Int (Func a b) (Func a b)

applyd =
    let apply_listd l d x =
                    case l of
                        [] -> d x
                        (a, b) : t ->
                            let c = compare x a
                            in if c == EQ then b
                                else if c == GT then apply_listd t d x
                                else d x

     in  \f d x ->
        let k =  5 -- hash x - todo
        in let look t =
                case t of
                    Leaf h l | h == k ->
                        apply_listd l d x
                    Branch p b l r | (k `xor` p) .&. (b - 1) == 0 -> --  (Branch p b l r) | ((k xor p) .&. (b - 1)) == 0 ->
                        look (if k .&. b == 0 then l else r)
                    _ -> d x
           in look f



===================
Error:
===================

Intro.hs:37:25: error:
    * Ambiguous type variable `t0' arising from a use of `apply_listd'
      prevents the constraint `(Ord t0)' from being solved.
      Relevant bindings include
        l :: [(t0, t)] (bound at Intro.hs:36:28)
        t :: Func t0 t (bound at Intro.hs:34:21)
        look :: Func t0 t -> t (bound at Intro.hs:34:16)
        x :: t0 (bound at Intro.hs:32:15)
        d :: t0 -> t (bound at Intro.hs:32:13)
        f :: Func t0 t (bound at Intro.hs:32:11)
        (Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max-relevant-binds)
      Probable fix: use a type annotation to specify what `t0' should be.
      These potential instances exist:
        instance Ord Ordering -- Defined in `GHC.Classes'
        instance Ord Integer
          -- Defined in `integer-gmp-1.0.0.1:GHC.Integer.Type'
        instance Ord a => Ord (Maybe a) -- Defined in `GHC.Base'
        ...plus 22 others
        ...plus five instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    * In the expression: apply_listd l d x
      In a case alternative: Leaf h l | h == k -> apply_listd l d x
      In the expression:
        case t of {
          Leaf h l | h == k -> apply_listd l d x
          Branch p b l r
            | (k `xor` p) .&. (b - 1) == 0
            -> look (if k .&. b == 0 then l else r)
          _ -> d x }


-- 
Best wishes,
Ivan Kush


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

Subject: Digest Footer

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


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

End of Beginners Digest, Vol 103, Issue 25
******************************************