Difference between revisions of "The Monad.Reader/Discuss Issue11/FingerTreeIMap"

From HaskellWiki
Jump to: navigation, search
m
(Deleting page that hasn't been updated for over 10 years)
Line 1: Line 1:
--[[User:Dfplace|Dfplace]] 16:19, 12 September 2008 (UTC)
 
  
<haskell>
 
{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
 
module IMap where
 
import Data.FingerTree
 
import Data.List hiding (insert,delete,lookup)
 
import Prelude hiding (lookup)
 
import Data.Monoid
 
 
data Elem a b = Elem a b
 
 
data Key k v = NoKey | Key k v
 
 
instance Eq k => Eq (Key k v) where
 
    (Key j _) == (Key k _) = j == k
 
    NoKey == NoKey        = True
 
    NoKey == (Key _ _)    = False
 
    (Key _ _) == NoKey    = False
 
 
instance Ord k => Ord (Key k v) where
 
    compare (Key j _) (Key k _) = compare j k
 
    compare NoKey NoKey        = EQ
 
    compare (Key _ _) NoKey    = GT
 
    compare NoKey (Key _ _ )    = LT
 
 
instance Monoid v => Monoid (Key a v) where
 
    mempty                        = NoKey
 
    k `mappend` NoKey            = k
 
    NoKey `mappend` k            = k
 
    (Key _ x) `mappend` (Key k y) = Key k (x `mappend` y)
 
 
data IMap a b = IMap (FingerTree (Key a b) (Elem a b))
 
 
instance (Monoid b) => Measured (Key a b) (Elem a b) where
 
    measure (Elem x y) = Key x y
 
 
insert :: (Ord k, Monoid v) => k -> v -> IMap k v -> IMap k v
 
insert k v (IMap xs) = insert' $ viewl r
 
    where
 
      (l,r) = split (>= Key k undefined) xs
 
      new = IMap ( l >< (Elem k v <| r))
 
      insert' ((Elem y _) :< r')
 
          | k == y    = IMap ( l >< (Elem k v <| r'))
 
          | otherwise = new
 
      insert' EmptyL  = new
 
 
delete :: (Ord k, Monoid v) => k -> IMap k v -> IMap k v
 
delete x (IMap xs) = IMap (l >< r')
 
    where     
 
      (l,r)  = split (>= Key x undefined) xs
 
      (_,r') = split (> Key x undefined) r
 
 
lookup :: (Monad m, Ord t, Monoid v) => t -> IMap t v -> m v
 
lookup x (IMap xs) = lookup' $
 
                    viewl . snd $
 
                    split (>= Key x undefined) xs
 
    where
 
      lookup' ((Elem y v) :< _)
 
          | y == x    = return v
 
          | otherwise = fail "IMap.lookup failed"
 
      lookup' EmptyL  = fail "IMap.lookup failed"
 
 
getValue :: (Monoid v) => IMap k v -> v
 
getValue (IMap xs) = let (Key _ v) = measure xs in v
 
</haskell>
 

Revision as of 14:34, 6 February 2021