Hi,

if I try to supply a signatur for the local function "showsl" below, then ghc rejects a constraint (Show a) whereas hugs (and nhc98) needs this constraint.

What should be the correct notation? (apart from omitting any signature)

Cheers Christian

(BTW, I would appreciate if the (instantiated) signature of a class function could be given/repeated in an instance, but that's another matter.)


hugs error message for "showsl :: List a -> ShowS"
ERROR "MyList.hs":11 - Cannot justify constraints in explicitly typed binding
*** Expression : showsl
*** Type : List a -> ShowS
*** Given context : ()
*** Constraints : Show a


ghc error message for "showsl :: Show a => List a -> ShowS"
...../MyList.hs:10:
All of the type variables in the constraint `Show a' are already in scope
(at least one must be universally quantified here)
In the type: (Show a) => List a -> String -> String
While checking the type signature for `showsl'
In the definition of `showsPrec':
showsPrec _ l
= (showString "[") . ((showsl l) . (showString "]"))
where
showsl :: forall. (Show a) => List a -> ShowS
showsl (Cons x Nil) = shows x
showsl (Cons x xs) = (shows x) . ((showString ",") . (showsl xs))
In the definition for method `showsPrec'
Failed, modules loaded: none.



module MyList where


data List a = Nil | Cons a (List a)

instance Show a => Show (List a) where
    showsPrec _  Nil = showString "[]"
    showsPrec _ l =
        showString "[" . showsl l . showString "]"
            where -- showsl :: List a -> ShowS            -- for ghc
                  -- showsl :: Show a => List a -> ShowS  -- for hugs
                  showsl (Cons x Nil) = shows x
                  showsl (Cons x xs) =
                      shows x . showString "," . showsl xs
                  -- undefined for Nil
module MyList where

data List a = Nil | Cons a (List a)

instance Show a => Show (List a) where
    showsPrec _  Nil = showString "[]"
    showsPrec _ l = 
        showString "[" . showsl l . showString "]"
            where showsl :: List a -> ShowS            -- for ghc
                  -- showsl :: Show a => List a -> ShowS  -- for hugs, nhc98  
                  showsl (Cons x Nil) = shows x
                  showsl (Cons x xs) = 
                      shows x . showString "," . showsl xs
                  -- undefined for Nil

_______________________________________________
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell

Reply via email to