okasaki

Okasaki's Purely Functional Data Structures
git clone git://git.jtobin.io/okasaki.git
Log | Files | Refs | LICENSE

FiniteMap.hs (1045B)

      1 {-# OPTIONS_GHC -Wall #-}
      2 
      3 module FiniteMap where
      4 
      5 import Tree
      6 
      7 -- exercise 2.6 (finite map using tree)
      8 newtype Bin k v = Bin (k, v) deriving Show
      9 
     10 instance Eq k => Eq (Bin k v) where
     11   Bin (k0, _) == Bin (k1, _) = k0 == k1
     12 
     13 instance Ord k => Ord (Bin k v) where
     14   compare (Bin (k0, _)) (Bin (k1, _)) = compare k0 k1
     15 
     16 newtype FiniteMap k v = FiniteMap (Tree (Bin k v)) deriving (Eq, Show)
     17 
     18 emptyMap :: FiniteMap k v
     19 emptyMap = FiniteMap Leaf
     20 
     21 bind :: Ord k => k -> v -> FiniteMap k v -> FiniteMap k v
     22 bind k v (FiniteMap m) = FiniteMap (insert' (Bin (k, v)) m) where
     23   insert' x Leaf = Node Leaf x Leaf
     24   insert' x (Node l e r) = case compare x e of
     25     EQ -> Node l x r
     26     LT -> Node (insert' x l) e r
     27     GT -> Node l e (insert' x r)
     28 
     29 lookup :: Ord k => k -> FiniteMap k v -> Maybe v
     30 lookup k (FiniteMap m) = lookup' m where
     31   lookup' Leaf = Nothing
     32   lookup' (Node l (Bin (key, v)) r) = case compare k key of
     33     EQ -> Just v
     34     LT -> lookup' l
     35     GT -> lookup' r
     36 
     37 testMap :: FiniteMap Char Int
     38 testMap = bind 'b' 2 (bind 'a' 1 emptyMap)
     39