From 111565b97002ef709dd5f822d0edee426a03e1a1 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 30 Jun 2020 19:16:44 +0200 Subject: [PATCH] uds --- uds/test.icl | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 uds/test.icl diff --git a/uds/test.icl b/uds/test.icl new file mode 100644 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 -- 2.20.1