a3/code/Generics/GenMonad.icl

   1 implementation module GenMonad
   2
   3 import StdGeneric, StdMaybe, StdList, StdFunc
   4
   5 generic gMapLM a b :: a:a -> m:(m b:b) | Monad m, [m <= b]
   6 gMapLM{|c|} x                                           = ret x
   7 gMapLM{|PAIR|} fx fy (PAIR x y)         = fx x >>= \x1 -> fy y >>= \y1 -> ret (PAIR x1 y1)
   8 gMapLM{|EITHER|} fl fr x                        = mapMEITHER fl fr x
   9 gMapLM{|CONS|} f (CONS x)                       = f x >>= ret o CONS
  10 gMapLM{|FIELD|} f (FIELD x)                     = f x >>= ret o FIELD
  11 gMapLM{|OBJECT|} f (OBJECT x)           = f x >>= ret o OBJECT
  12
  13 generic gMapRM a b :: a:a -> m:(m b:b) | Monad m, [m <= b]
  14 gMapRM{|c|} x                                           = ret x
  15 gMapRM{|PAIR|} fx fy (PAIR x y)                 = fy y >>= \y1 -> fx x >>= \x1 -> ret (PAIR x1 y1)
  16 gMapRM{|EITHER|} fl fr x                        = mapMEITHER fl fr x
  17 gMapRM{|CONS|} f (CONS x)                       = f x >>= ret o CONS
  18 gMapRM{|FIELD|} f (FIELD x)                     = f x >>= ret o FIELD
  19 gMapRM{|OBJECT|} f (OBJECT x)           = f x >>= ret o OBJECT
  20
  21 derive gMapLM [], Maybe, (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
  22 derive gMapRM [], Maybe, (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
  23
  24 mapMEITHER fl fr (LEFT x) = fl x >>= ret o LEFT
  25 mapMEITHER fl fr (RIGHT x) = fr x >>= ret o RIGHT
  26
  27 //----------------------------------------------------------------------
  28 instance Monad Maybe where
  29         ret x = Just x
  30         (>>=) Nothing f = Nothing
  31         (>>=) (Just x) f = f x
  32
  33 instance Monad [] where
  34         ret x = [x]
  35         //(>>=) xs f = flatten (map f xs)       // uniqueness typing makes it a problem because f is shared
  36         (>>=) [x:xs] f = f x
  37
  38 //-----------------------
  39 // state monad
  40
  41 //retStMonad :: .a -> .(StMonad .s .a)
  42 retStMonad x = {st_monad = (\s -> (x, s))}
  43
  44 //bindStMonad :: !.(StMonad .a .b) .(.b -> .(StMonad .a .c)) -> .(StMonad .a .c)
  45 bindStMonad {st_monad} f = {st_monad  = \s -> let (a, s1) = st_monad s in (f a).st_monad s1}
  46
  47 mapFst f (x, y) = (f x, y)
  48
  49 //mapStMonad :: .(a:a -> .b) !v:(StMonad s:s a:a) -> .(StMonad s:s .b), [v <= a,v <= s]
  50 mapStMonad f {st_monad} = {st_monad = mapFst f o st_monad}
  51
  52 instance Monad (StMonad .s) where
  53         ret x           = retStMonad x
  54         (>>=) x f       = bindStMonad x f
  55
  56 derive bimap (,)
  57 derive bimap StMonad