1 module FiniteMap
    2       (FM, emptyFM, unitFM, extendFM, makeFM, unmakeFM, thenFM, plusFM,
    3        lookupFM, lookupElseFM, mapFM, domFM, ranFM, disjointFM) where
    4 
    5 data  FM a b  =  MkFM [(a,b)]
    6 emptyFM                               ::  FM a b
    7 emptyFM                               =   MkFM []
    8 unitFM                                ::  a -> b -> FM a b
    9 unitFM a b                            =   MkFM [(a,b)]
   10 extendFM                              ::  FM a b -> a -> b -> FM a b
   11 extendFM (MkFM abs) a b               =   MkFM ((a,b) : abs)
   12 makeFM                                ::  [(a,b)] -> FM a b
   13 makeFM abs                            =   MkFM abs
   14 unmakeFM                              ::  FM a b -> [(a,b)]
   15 unmakeFM (MkFM abs)                   =   abs
   16 thenFM                                ::  FM a b -> FM a b -> FM a b
   17 (MkFM abs1) `thenFM` (MkFM abs2)      =   MkFM (abs2 ++ abs1)
   18 plusFM                                ::  (Eq a) => FM a b -> FM a b -> FM a b
   19 f `plusFM` g  |  f `disjointFM` g     =   f `thenFM` g
   20 lookupFM                              ::  (Eq a) => FM a b -> a -> b
   21 lookupFM f a                          =   lookupElseFM (error "lookup") f a
   22 lookupElseFM                          ::  (Eq a) => b -> FM a b -> a -> b
   23 lookupElseFM b (MkFM abs) a           =   head (  [ b' | (a',b') <- abs, a==a' ]
   24                                                ++ [ b ] )
   25 mapFM                                 ::  (b -> c) -> FM a b -> FM a c
   26 mapFM h (MkFM abs)                    =   MkFM [ (a, h b) | (a,b) <- abs ]
   27 domFM                                 ::  FM a b -> [a]
   28 domFM (MkFM abs)                      =   [ a | (a,b) <- abs ]
   29 ranFM                                 ::  FM a b -> [b]
   30 ranFM (MkFM abs)                      =   [ b | (a,b) <- abs ]
   31 disjointFM                            ::  (Eq a) => FM a b -> FM a b -> Bool
   32 f `disjointFM` g                      =   domFM f `disjoint` domFM g
   33 disjoint                              ::  (Eq a) => [a] -> [a] -> Bool
   34 xs `disjoint` ys                      =   and [ not (x `elem` ys) | x <- xs ]