From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 3 Sep 2020 05:02:51 +0000 (+0200)
Subject: update, segfault
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=27b73130a759ac1fdd20c8f6ab07cb259bc96419;p=clean-tests.git

update, segfault
---

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)