Inconsistent compilation when type context is involved

Hi, The following program: ============= module Main where import Data.Maybe fun :: Show a => String -> Maybe a -> IO () fun s mb = do putStrLn s case mb of Nothing -> return () Just a -> do putStrLn (show a) return () main = do fun "bla" Nothing fun "foo" (Just "bar") ============= compiles with Yhc and runs fine (even with only the first line of main, so there is no mentioning that a String is wrapped in Maybe). However another example (shortened mainly to type signatures): ================ putLine :: CNode a => String -> Maybe a -> CPS b () putLine s mbb k = getHTMLDocument $ \doc -> ... let iac = case mbb of Nothing -> addChild dv -- dv is also some instance of TNode, basically Just b -> insertChild b dv -- almost anything in DOM is a node. in .... ... main = putLine "bla" (Nothing {-- :: Maybe TNode --}) $ id .... addChild :: (CNode newChild, CNode zz) => newChild -> zz -> CPS b zz insertChild :: (CNode refChild, CNode newChild, CNode parent) => refChild -> newChild -> parent -> CPS b parent ================ results in error: -- during after type inference/checking Error: No default for DOM.Level1.Dom.CNode at 23:1-23:91.(Id 348,[(Id 1,Id 350)]) If I uncomment ::Maybe TNode then compilation succeeds. The class CNode is defined without any methods: class CNode a data TNode = TNode instance CNode TNode Is there any difference between these two examples, or is it a bug? Or too much context is involved in addChild and insertChild? Thanks. PS I haven't tried to compile the above code with Ghc, and I am specifically interested in compilation by Yhc: this is a part of the DOM/Javascript stuff. -- Dimitry Golubovsky Anywhere on the Web

Dimitry Golubovsky wrote:
=============
module Main where
import Data.Maybe
fun :: Show a => String -> Maybe a -> IO () fun s mb = do putStrLn s case mb of Nothing -> return () Just a -> do putStrLn (show a) return ()
main = fun "bla" Nothing
=============
compiles with Yhc and runs fine (even with only the first line of main, so there is no mentioning that a String is wrapped in Maybe).
This program shouldn't compile, it doesn't compile in either ghc or hugs and is definitely ambiguous. Looking at the core that Yhc generates: Main.main = let v234 = Prelude.Prelude.Show.Prelude.Integer in Main.fun v234 Main._LAMBDA243 Prelude.Nothing Main._LAMBDA243 = "bla" It's arbitrarily chosen to give the Show dictionary for 'Integer' (which is 'Prelude.Prelude.Show.Prelude.Integer'). Given that Yhc's type system is unmodified since nhc98 it's likely that this is a 'carry over' bug from nhc98. Thanks Tom

Thanks, now I see where I'm wrong.
On 3/22/07, Thomas Shackell
compiles with Yhc and runs fine (even with only the first line of main, so there is no mentioning that a String is wrapped in Maybe).
This program shouldn't compile, it doesn't compile in either ghc or hugs and is definitely ambiguous. Looking at the core that Yhc generates:
-- Dimitry Golubovsky Anywhere on the Web
participants (2)
-
Dimitry Golubovsky
-
Thomas Shackell