From 27b73130a759ac1fdd20c8f6ab07cb259bc96419 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 3 Sep 2020 07:02:51 +0200 Subject: [PATCH] update, segfault --- uds/ASDS.icl | 12 ++++++++++++ uds/test.icl | 1 - 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/uds/ASDS.icl b/uds/ASDS.icl index 54f9334..041e2c8 100644 --- a/uds/ASDS.icl +++ b/uds/ASDS.icl @@ -1,5 +1,7 @@ implementation module ASDS +import StdEnv + import Data.Functor import Control.Monad import Control.Monad.State @@ -28,3 +30,13 @@ setShare w s = write s () w >>= \v->case v of updShare :: (r -> w) (sds m () r w) -> PViewT m w | Monad m & read sds & write sds & TC r & TC w updShare f s = f <$> getShare s >>= \v->setShare v s >>| liftT (pure v) + +trigger :: (p -> Bool) -> PViewT m () | TC p & Monad m +trigger inv = gets (filter (match inv)) >>= mapM_ run +where + match :: (p -> Bool) (NRequest m) -> Bool | TC p + match inv (NRequest oid ohnd (a :: p^)) = inv a + match _ _ = False + + run :: (NRequest m) -> PViewT m () | Monad m + run (NRequest oid ohnd _) = liftT ohnd diff --git a/uds/test.icl b/uds/test.icl index 4d8049e..edb8eeb 100644 --- a/uds/test.icl +++ b/uds/test.icl @@ -18,7 +18,6 @@ import ASDS.Parallel instance MonadFail (Either String) where fail s = Left s - readwrite :: r w (sds m () r w) -> PViewT m () | MonadFail m & read sds & write sds & TC r & TC w & == r readwrite r w sds = equal r (setShare w sds >>| getShare sds) -- 2.20.1