uds

diff --git a/uds/test.icl b/uds/test.icl
new file mode 100644 (file)
index 0000000..f2601b9
--- /dev/null
+++ b/uds/test.icl
@@ -0,0 +1,60 @@
+module test
+
+import StdEnv
+import Data.Maybe
+import Data.Functor
+import Data.Func
+import Control.Applicative
+import Control.Monad
+import qualified Data.Map
+
+class get v ~st
+where
+       get :: (v r w) .st -> .(Maybe r, .st) | TC r
+class put v ~st
+where
+       put :: w (v r w) .st -> .(Maybe (), .st) | TC w
+
+:: Source r w = Source String
+:: St :== 'Data.Map'.Map String Dynamic
+
+instance get Source St
+where
+       get (Source n) st = case 'Data.Map'.get n st of
+               Just (a :: a^) = (Just a, st)
+               _ = (Nothing, st)
+
+instance put Source St
+where
+       put w (Source n) st = (Just (), 'Data.Map'.put n (dynamic w) st)
+
+:: Par sdsl sdsr r w = E.r1 r2 w1 w2: Par (ParOpts sdsl sdsr r1 r2 w1 w2 r w)
+       & TC r1 & TC r2 & TC w1 & TC w2
+:: ParOpts sdsl sdsr r1 r2 w1 w2 r w =
+       { read  :: r1 r2 -> Maybe r
+       , write :: w -> Maybe (w1, w2)
+       , left  :: (sdsl r1 w1)
+       , right :: (sdsr r2 w2)
+       }
+
+instance get (Par sdsl sdsr) St | get sdsl St & get sdsr St
+where
+       get (Par {read,left,right}) st
+               # (ml, st) = get left st
+               # (mr, st) = get right st
+               = (join $ read <$> ml <*> mr, st)
+instance put (Par sdsl sdsr) St | put sdsl St & put sdsr St
+where
+       put w (Par {write,left,right}) st
+               = case write w of
+                       Nothing = (Nothing, st)
+                       Just (w1, w2)
+                               # (ml, st) = put w1 left st
+                               # (mr, st) = put w2 right st
+                               = (ml *> mr, st)
+
+Start :: (Maybe Int, .St)
+Start
+       # st = 'Data.Map'.newMap
+       # (Just _, st) = put 42 (Source "blurp") st
+       = get (Source "blurp") st