> update :: (Typable b) => FM k -> Key k a -> b -> (FM ...)
I didn't know constraints on values are allowed... Given below is the
implementation of the required interface, in Haskell98
module TypedFM where
data FM k -- Abstract; finite map indexed bykeys of type k
data Key k a -- Abstract; a key of type k, indexing a value of type a
empty :: FM k
insert :: Ord k => FM k -> k -> a -> (FM k, Key k a)
lookup :: Ord k => FM k -> Key k a -> Maybe a
update :: Ord k => FM k -> Key k a -> a -> FM k
Implementation:
import Monad
data U = LBool Bool
| LChar Char
| LInt Int
| LL [U] -- Lists of any kind
| LA (U->U) -- monomorophic functions of any kind
class UNIV a where
inj:: a -> U
prj:: U -> Maybe a
instance UNIV Bool where
inj = LBool
prj (LBool a) = Just a
prj _ = Nothing
instance UNIV Char where
inj = LChar
prj (LChar a) = Just a
prj _ = Nothing
instance UNIV Int where
inj = LInt
prj (LInt a) = Just a
prj _ = Nothing
instance (UNIV a) => UNIV [a] where
inj = LL . map inj
prj (LL as) = foldr f (Just []) as
where f e (Just s) = case prj e of
Just x -> Just $ x:s
_ -> Nothing
f _ _ = Nothing
prj _ = Nothing
instance (UNIV a,UNIV b) => UNIV (a->b) where
inj f = LA $ \ua -> let (Just x) = prj ua in inj $ f x
prj (LA f) = Just $ \x -> let Just y = prj$f$inj x in y
prj _ = Nothing
data FM k = FM [U]
data Key k a = Key Int a
empty = FM []
insert (FM l) _ a = (FM $(inj a):l, Key (length l) a)
lookp:: (UNIV a) => FM k -> Key k a -> Maybe a
lookp (FM l) (Key i a) = prj $ (reverse l)!!i
update:: (UNIV a) => FM k -> Key k a -> a -> FM k
update (FM l) (Key i _) a = FM $ reverse (lb ++ ((inj a):(tail lafter)))
where (lb,lafter) = splitAt i (reverse l)
test1 = do
let heap = empty
let (heap1,xref) = insert heap () 'a'
let (heap2,yref) = insert heap1 () [(1::Int),2,3]
let (heap3,zref) = insert heap2 () "abcd"
putStrLn "\nAfter allocations"
-- print heap3
putStr "x is "; print $ lookp heap3 xref
putStr "y is "; print $ lookp heap3 yref
putStr "z is "; print $ lookp heap3 zref
let heap31 = update heap3 xref 'z'
let heap32 = update heap31 yref []
let heap33 = update heap32 zref "new string"
putStrLn "\nAfter updates"
putStr "x is "; print $ lookp heap33 xref
putStr "y is "; print $ lookp heap33 yref
putStr "z is "; print $ lookp heap33 zref
putStrLn "\nFunctional values"
let (heap4,gref) = insert heap33 () (\x->x+(1::Int))
putStr "g 1 is "; print $ liftM2 ($) (lookp heap4 gref) $ Just (1::Int)
return ()
_______________________________________________
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell
