
Am Donnerstag, 7. Februar 2008 08:58 schrieb Leandro Demarco Vedelago:
but when I try to load it in WinHugs I get the following error message:
- Instance is more general than a dependency allows *** Instance : Container Abb a b *** For class : Container a b c *** Under dependency : a -> b
and as I have stated above my knowledge about dependencies is almost null, not to say null, so I don“t even have an idea where the error is.
Maybe ghci's error message is more helpful: dafis@linux:~/Documents/haskell/move> ghci Leandro GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help Loading package base ... linking ... done. [1 of 1] Compiling Leandro ( Leandro.hs, interpreted ) Leandro.hs:16:19: `Abb' is not applied to enough type arguments Expected kind `*', but `Abb' has kind `* -> * -> *' In the instance declaration for `Container Abb a b' Failed, modules loaded: none. There are a couple of other things, mainly that you have the wrong type for 'add' and you need an Ord constraint for 'search'. This works: {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {- # LANGUAGE FlexibleInstances # -} module Leandro where data Abb a b = Branch a b (Abb a b) (Abb a b) | Leaf data ListAssoc a b = Node a b (ListAssoc a b) | Empty class Container c a b |c -> a, c -> b where empty :: c add :: c -> a -> b -> c search :: c -> a -> Maybe b del :: c -> a -> c toListPair :: c -> [(a,b)] instance (Ord a) => Container (Abb a b) a b where empty = Leaf add Leaf x y = Branch x y Leaf Leaf add arb@(Branch ni nd ri rd) x y |x == ni = arb |x > ni = Branch ni nd ri (add rd x y) |otherwise = Branch ni nd (add ri x y) rd search Leaf x = Nothing search (Branch ni nd ri rd) x |x == ni = Just nd |x > ni = search rd x |x < ni = search ri x Note: The FlexibleInstances Language pragma is required by GHC 6.8.1 and 6.8.2, but not by GHC 6.6.1 or hugs, I think that's a bug in 6.8.*
A suggestion that I've received was to change the type of Abb for
data Abb (a,b) = Branch a b (Abb (a,b)) (Abb (a,b)) | Leaf
and declare container class with just two parameters like I found in all pages I visited. I have not tried this yet, as I still have hope that what I intend to do is possible.
Well if you have any suggestions I'd appreciate you send it to me and sorry for bothering you and my english, but i'm "spanish-speaker".
Cheers, Daniel