uds/ASDS.icl

   1 implementation module ASDS
   2
   3 import StdEnv
   4
   5 import Data.Functor
   6 import Control.Monad
   7 import Control.Monad.State
   8 import Control.Monad.Trans
   9
  10 import ASDS.Source
  11 import ASDS.Lens
  12 import ASDS.Select
  13 import ASDS.Parallel
  14
  15 sds :: (sds m p r w) -> SDS m p r w | read sds & write sds & Monad m
  16 sds s = SDS s (pure ())
  17
  18 instance read SDS where read (SDS s _) p = read s p
  19 instance write SDS where write (SDS sds _) p w = write sds p w
  20
  21 getShare :: (sds m () r w) -> PViewT m r | Monad m & read sds & TC r & TC w
  22 getShare s = read s () >>= \v->case v of
  23         Reading s = getShare s
  24         Read r = liftT (pure r)
  25
  26 setShare :: w (sds m () r w) -> PViewT m () | Monad m & write sds & TC r & TC w
  27 setShare w s = write s () w >>= \v->case v of
  28         Writing s = setShare w s
  29         Written _ = liftT (pure ())
  30
  31 updShare :: (r -> w) (sds m () r w) -> PViewT m w | Monad m & read sds & write sds & TC r & TC w
  32 updShare f s = f <$> getShare s >>= \v->setShare v s >>| liftT (pure v)
  33
  34 trigger :: (p -> Bool) -> PViewT m () | TC p & Monad m
  35 trigger inv = gets (filter (match inv)) >>= mapM_ run
  36 where
  37         match :: (p -> Bool) (NRequest m) -> Bool | TC p
  38         match inv (NRequest oid ohnd (a :: p^)) = inv a
  39         match _ _ = False
  40
  41         run :: (NRequest m) -> PViewT m () | Monad m
  42         run (NRequest oid ohnd _) = liftT ohnd