Hello cafe, I'm now studying Trie in Okasaki's "Purely Functional Data Structure". Attached is the program in its appendix. I cannot understand how to use "empty", "look" and "bind". For instance, if I type 'look "" empty', I got an error:
> look "" empty <interactive>:2:1: No instance for (FiniteMap m0 [Char]) arising from a use of `look' Possible fix: add an instance declaration for (FiniteMap m0 [Char]) In the expression: look "" empty In an equation for `it': it = look "" empty I have no idea how to determine the parameter 'm'. Suggestions would be appreciated. --Kazu {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} class FiniteMap m k where empty :: m k v look :: k -> m k v -> Maybe v bind :: k -> v -> m k v -> m k v data Trie m ks v = Trie (Maybe v) (m (Trie m ks v)) instance FiniteMap m k => FiniteMap (Trie (m k)) [k] where empty = Trie Nothing empty look [] (Trie b _) = b look (k:ks) (Trie _ m) = look k m >>= look ks bind [] x (Trie _ m) = Trie (Just x) m bind (k:ks) x (Trie b m) = Trie b (bind k t' m) where t = case look k m of Just a -> a Nothing -> empty t' = bind ks x t _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe