From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 3 Jul 2020 13:08:38 +0000 (+0200)
Subject: many changes
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=ae3a7c7945f08f78b9cd9d68e71e43dda568a7c7;p=clean-tests.git

many changes
---

diff --git a/cloudiTasks/cloudiTasks.icl b/cloudiTasks/cloudiTasks.icl
index f5dbace..40c0b35 100644
--- a/cloudiTasks/cloudiTasks.icl
+++ b/cloudiTasks/cloudiTasks.icl
@@ -10,25 +10,26 @@ master :: Task ()
 master
 	= get applicationOptions
 	>>- \eo->traceValue ("Master started on port " +++ toString eo.serverPort)
+	>-| updateSharedInformation [] (remoteShare (sharedStore "bork" 42) {domain="localhost",port=9099})
 //	>-| set 42 (remoteShare (sharedStore "bork" 42) {domain="localhost",port=9099})
 //	>-| asyncTask (ExistingNode "localhost" 9099) (blockWait 5)
 //	>-| asyncTask "localhost" 9090 (blockWait 5)
 //	>-| asyncTask (PrivateNode 9099) (traceValue 5 >-| traceValue 42)
-	>-| asyncTask "localhost" 9099 (updateInformation [] 5)
+//	>-| asyncTask "localhost" 9099 (updateInformation [] 5)
 //	>-| sleepSortPar [5,1,3,8]
 	>&^ viewSharedInformation []
 	@! ()
-
-asyncTaskChannel :: !String !Int !((sds () (Queue r) w) -> Task a) !((sds () (Queue w) r) -> Task b) -> Task (a, b)
-asyncTaskChannel host port remote local
-	=    asyncTask host port (remote shareTo)
-	-&&- 
-where
-	shareTo :: (sds () (Queue r) (Queue r))
-	shareTo = sdsFocus ("to-" +++ host +++ toString port) $ memoryStore "asyncITasks-channels" (Just newQueue)
-
-	shareFro :: (sds () (Queue w) (Queue w))
-	shareFro = sdsFocus ("fro-" +++ host +++ toString port) $ memoryStore "asyncITasks-channels" (Just newQueue)
+//
+//asyncTaskChannel :: !String !Int !((sds () (Queue r) w) -> Task a) !((sds () (Queue w) r) -> Task b) -> Task (a, b)
+//asyncTaskChannel host port remote local
+//	=    asyncTask host port (remote shareTo)
+//	-&&- 
+//where
+//	shareTo :: (sds () (Queue r) (Queue r))
+//	shareTo = sdsFocus ("to-" +++ host +++ toString port) $ memoryStore "asyncITasks-channels" (Just newQueue)
+//
+//	shareFro :: (sds () (Queue w) (Queue w))
+//	shareFro = sdsFocus ("fro-" +++ host +++ toString port) $ memoryStore "asyncITasks-channels" (Just newQueue)
 
 blockWait :: Int -> Task Int
 blockWait i = accWorld (sleep i)
@@ -41,8 +42,8 @@ where
 sleepSortPar :: [Int] -> Task [Int]
 sleepSortPar numbers = parallel
 	[ (Embedded, \stl->
-		    asyncTaskSpawn port (blockWait num)
-		>-| appendTask Embedded (\_->return num) stl
+/*		    asyncTaskSpawn port (blockWait num)
+		>-| */appendTask Embedded (\_->return num) stl
 		@? const NoValue)
 	\\ num  <- numbers
 	&  port <- [9092..9099]
diff --git a/constraint/test.hs b/constraint/test.hs
new file mode 100644
index 0000000..845a371
--- /dev/null
+++ b/constraint/test.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ConstraintKinds #-}
+module Main where
+
+import Prelude hiding (print)
+import Data.Functor.Identity
+class Empty x
+
+instance Empty x
+
+main = putStrLn $ show (unP e1 [])
+
+e1 :: Printer Int
+e1 = lit 42
+
+infixl 6 +., -.
+infixl 7 *.
+infix 4 ==.
+class Expr v c where
+    lit :: (c a) => a -> v a
+    (+.) :: (c a, Num a) => v a -> v a -> v a
+    (-.) :: (c a, Num a) => v a -> v a -> v a
+    (*.) :: (c a, Num a) => v a -> v a -> v a
+    (==.) :: (c a, Eq a) => v a -> v a -> v Bool
+--    if' :: (c a) => v Bool -> v a -> v a -> v a
+
+data Printer a = P ([String] -> [String])
+unP (P a) = a
+instance Expr Printer Show where
+    lit a = P (show a:)
+    l +. r  = P $ unP l . ("+":) .  unP r
+    l -. r  = P $ unP l . ("-":) .  unP r
+    l *. r  = P $ unP l . ("*":) .  unP r
+    l ==. r = P $ unP l . ("==":) . unP r
+--    if' i t e = P $ ("if ":) . unP i . (" then ":) . unP t . (" else ":) . unP e
+
+data Eval a = E a
+unE (E a) = a
+instance Expr Eval Empty where
+    lit a = E a
+    l +. r  = E $ unE l +  unE r
+    l -. r  = E $ unE l -  unE r
+    l *. r  = E $ unE l *  unE r
+    l ==. r = E $ unE l == unE r
+--    if' i t e = if unE i then t else e
diff --git a/constraint/test.icl b/constraint/test.icl
new file mode 100644
index 0000000..3bd8f73
--- /dev/null
+++ b/constraint/test.icl
@@ -0,0 +1,46 @@
+module test
+
+import StdEnv
+
+class expr v c
+where
+	lit :: a -> v (c a)
+
+//class plus v c
+//where
+//	(+.) infixl 6 :: (v c a) (v c a) -> v c a | + a
+
+:: BM x y = { to :: x -> y, fro :: y -> x }
+bm :: BM a a
+bm = {to=id, fro=id}
+
+:: ToString a = E.e: ToString (BM a e) & toString e
+
+:: Printer a = P a ([String] -> [String])
+:: PrintConstraints a = E.e: PC (BM a e) & toString e
+
+print :: (Printer (PrintConstraints a)) -> [String]
+print (P _ a) = a []
+
+instance expr Printer PrintConstraints
+where
+	lit a = P (PC bm) \c->[toString (bm.to a):c]
+//instance plus Printer PrintConstraints
+//where
+//	(+.) (P l) (P r) = P \c->["(":l ["+":r [")":c]]]
+
+//:: Eval c a = E a | EBlurp (c a)
+//:: EvalConstraints a = EC a
+//eval :: (Eval EvalConstraints a) -> a
+//eval (E a) = a
+//
+//instance expr Eval EvalConstraints
+//where
+//	lit a = E a
+//instance plus Eval PrintConstraints
+//where
+//	(+.) (E l) (E r) = E (l + r)
+
+Start = print t
+where
+	t = lit 42
diff --git a/deep.icl b/deep.icl
deleted file mode 100644
index 5124c43..0000000
--- a/deep.icl
+++ /dev/null
@@ -1,29 +0,0 @@
-module deep
-
-import StdEnv
-
-:: DSL
-	= Lit Int
-	| Plus DSL DSL
-	| Div DSL DSL
-
-eval :: DSL -> Int
-eval (Lit i) = i
-eval (Plus x y) = eval x + eval y
-eval (Div x y) = eval x / eval y
-
-//Start = eval (Plus (Lit 41) (Lit 1))
-
-import Control.Applicative
-import Control.Monad
-import Data.Functor
-import Data.Maybe
-
-evalM :: DSL -> Maybe Int
-evalM (Lit i) = pure i
-evalM (Plus x y) = (+) <$> evalM x <*> evalM y
-evalM (Div x y) = evalM x >>= \x->evalM y >>= \y->case y of
-	0 = Nothing
-	x = Just (x / y)
-
-Start = evalM (Plus (Lit 41) (Lit 1))
diff --git a/eadt.icl b/eadt.icl
deleted file mode 100644
index 30ec0e1..0000000
--- a/eadt.icl
+++ /dev/null
@@ -1,73 +0,0 @@
-module eadt
-
-import StdEnv
-import Control.Monad
-import Control.Applicative
-import Data.Functor
-import Data.Maybe
-
-:: BM a b = { to :: a -> b, fro :: b -> a}
-bm :: BM a a
-bm = {to=id, fro=id}
-
-class eval m where eval :: (m a) -> Maybe a
-class print m where print :: (m a) [String] -> [String]
-class flat m where flat :: (m a) -> DSL a
-:: DSL a
-	= E.e: Lit (BM e a) a & toString e
-	| E.e: Plus (BM e a) (DSL e) (DSL e) & + e
-	| E.m: Ext (m a) & eval, print, flat m
-lit = Lit bm
-(+.) infixl 6
-(+.) = Plus bm
-
-instance eval DSL where
-	eval (Lit _ a) = Just a
-	eval (Plus bm x y) = bm.to <$> ((+) <$> eval x <*> eval y)
-	eval (Ext m) = eval m
-
-instance print DSL where
-	print (Lit bm a) c = [toString (bm.fro a):c]
-	print (Plus _ x y) c = print x ["+":print y c]
-	print (Ext m) c = print m c
-
-instance flat DSL where
-	flat (Ext m) = Ext (flat m)
-	flat a = a
-
-:: Div a = E.e: Div (BM e a) (DSL e) (DSL e) & /, zero, == e
-(/.) infixl 7
-(/.) x y = Ext (Div bm x y)
-
-instance eval Div where
-	eval (Div bm x y) = bm.to <$> (eval x >>= \x->eval y >>= \y->
-		if (y == zero) Nothing (Just (x/y)))
-
-instance print Div where
-	print (Div bm x y) c = print x ["/":print y c]
-
-instance flat Div where
-	flat a = Ext a
-
-:: In a b = In infix 0 a b
-:: Var a = E.b: Var ((DSL b) -> In (DSL b) (DSL a))
-var = Ext o Var
-instance eval Var where
-	eval (Var def) =
-		let (init In body) = def init
-		in eval body
-
-instance print Var where
-	print (Var def) c =
-		let (init In body) = def init
-		in ["let _ = ":print init [" in ":print body c]]
-
-instance flat Var where
-	flat (Var def) =
-		let (init In body) = def init
-		in body
-
-Start = printEval (var \x=lit 41 In x +. lit 1)
-
-printEval :: (DSL a) -> (Maybe a, [String])
-printEval e = (eval e, print e [])
diff --git a/erin/DSLUnique.icl b/erin/DSLUnique.icl
new file mode 100644
index 0000000..5d83c25
--- /dev/null
+++ b/erin/DSLUnique.icl
@@ -0,0 +1,138 @@
+module DSLUnique
+
+import StdEnv
+import UniqueState
+
+class list v
+where
+	list :: [Int] -> *v *[Int]
+	(++.) infixr 5 :: *(v *[Int]) *(v *[Int]) -> *(v *[Int])
+
+class select v
+where
+	(!.) infixl 9 :: *(v *[Int]) *(v Int) -> *(v Int)
+
+class expr v
+where
+	lit :: a -> *(v a) | toStringU a
+	(+.) infixl 6 :: *(v Int) *(v Int) -> *(v Int)
+	(-.) infixl 6 :: *(v Int) *(v Int) -> *(v Int)
+	(*.) infixl 7 :: *(v Int) *(v Int) -> *(v Int)
+	(/.) infixl 7 :: *(v Int) *(v Int) -> *(v Int)
+	If :: *(v Bool) *(v a) *(v a) -> *(v a)
+
+class step v
+where
+	(>>*.) infixl 1 :: *(v .t) *[Step *v .t .u] -> *(v .u)
+
+:: *Step v t u
+	= IfValue ((v t) -> *(v Bool, v t)) ((v t) -> v u)
+	| Always (v u)
+
+class toStringU a
+where
+	toStringU :: .a -> String
+
+instance toStringU Bool
+where
+	toStringU :: !.Bool -> String
+	toStringU a
+		= code inline {
+			.d 0 1 i
+				jsr BtoAC
+			.o 1 0
+		}
+instance toStringU Int
+where
+	toStringU :: !.Int -> String
+	toStringU a
+		= code inline {
+			.d 0 1 i
+				jsr ItoAC
+			.o 1 0
+		}
+
+instance toStringU String
+where
+	toStringU :: !.String -> String
+	toStringU a
+		= code inline {
+			no_op
+		}
+
+show :: u:a -> *(State String u:b) | toStringU a
+show x = State \s -> (undef, s +++ toStringU x)
+
+instance list (State String)
+where
+	list x = show " list " >>| pure undef
+	(++.) l r = l >>| show " ++ " >>| r >>| pure undef
+
+instance select (State String)
+where
+	// >>| expects both sides to have the same attribute, this is not the case
+	// here
+	(!.) a i = a >>| show " ! " >>| i >>| pure undef
+
+instance expr (State String)
+where
+	lit x = show x
+	(+.) l r = l >>| show " + " >>| r >>| pure undef
+	(-.) l r = l >>| show " - " >>| r >>| pure undef
+	(*.) l r = l >>| show " * " >>| r >>| pure undef
+	(/.) l r = l >>| show " / " >>| r >>| pure undef
+	If b t e = show "If " >>| b >>| t >>| e >>| pure undef
+
+instance step (State String)
+where
+	(>>*.) l cs = l >>| show " >>*. [" >>|
+		printSteps cs
+	where
+		printSteps [] = show "]"
+		printSteps [IfValue p c:cs]
+			# (pb, pr) = p (show "i")
+			= show "IfValue (\\i->(" >>| pb >>| show ", " >>| pr >>| show ")) (\\v->" >>| c (show "v") >>| show ")" >>| commaCont cs
+		printSteps [Always c:cs] = show "Always " >>| c >>| commaCont cs
+
+		commaCont [] = printSteps []
+		commaCont cs = show ", " >>| printSteps cs
+	
+instance list Maybe
+where
+	list x = undef//Just x
+	(++.) l r = l >>= \l -> r >>= \r -> pure (l ++ r)
+
+instance select Maybe
+where
+	(!.) a i = a >>= \a -> i >>= \i -> pure (a!!i)
+
+instance expr Maybe
+where
+	lit x = pure x
+	(+.) l r = l >>= \l -> r >>= \r -> pure (l + r)
+	(-.) l r = l >>= \l -> r >>= \r -> pure (l - r)
+	(*.) l r = l >>= \l -> r >>= \r -> pure (l * r)
+	(/.) _ (Just 0) = Nothing
+	(/.) l r = l >>= \l -> r >>= \r -> pure (l / r)
+	If b t e = b >>= \b
+		| b = t
+		| otherwise = e
+
+instance step Maybe
+where
+	(>>*.) _ [] = Nothing
+	(>>*.) _ [Always c:_] = c
+	(>>*.) Nothing [_:cs] = Nothing >>*. cs
+	(>>*.) v=:(Just _) [IfValue p c:cs]
+		= case p v of
+			(Nothing, v) = Nothing
+			(Just b, v) = if b (c v) (v >>*. cs)
+
+Start :: (Maybe Int, String, Maybe Int, String)
+Start = (lit 1 +. lit 2, snd (runState (lit 1 +. lit 2) ""), t, snd (runState t ""))
+
+t :: *(v Int) | expr, step v
+t = lit 38 /. lit 0 >>*.
+	[ IfValue (\v->(lit True, v)) (\i->i)
+	, Always (lit 42)
+	]
diff --git a/erin/UniqueState.dcl b/erin/UniqueState.dcl
new file mode 100644
index 0000000..19ac579
--- /dev/null
+++ b/erin/UniqueState.dcl
@@ -0,0 +1,34 @@
+definition module UniqueState
+
+:: Maybe a = Just a | Nothing
+
+class Functor f
+where
+	fmap :: u:(v:a -> w:b) *(f v:a) -> *(f w:b)
+
+class Applicative f | Functor f
+where
+	(<*>) infixl 4 :: *(f v:(w:a -> x:b)) *(f w:a) -> *(f x:b)
+	pure :: u:a -> *(f u:a)
+
+class Monad m | Applicative m
+where
+	bind :: *(m v:b) w:(v:b -> *(m x:c)) -> *(m x:c)
+	(>>=) infixl 1 :: *(m v:b) w:(v:b -> *(m x:c)) -> *(m x:c)
+	(>>=) ma a2mb :== bind ma a2mb
+	(>>|) infixl 1 :: *(m v:b) w:(v:b -> *(m x:c)) -> *(m x:c)
+	(>>|) ma mb :== ma >>= \_ -> mb
+	return :: u:a -> *(m u:a) | Applicative m
+	return x :== pure x
+
+:: State s a = State .(s -> .(a, s))
+
+runState :: u:(State .s .a) .s -> v:(.a,.s), [u <= v]
+
+instance Functor (State String)
+instance Applicative (State String)
+instance Monad (State String)
+
+instance Functor Maybe
+instance Applicative Maybe
+instance Monad Maybe
diff --git a/erin/UniqueState.icl b/erin/UniqueState.icl
new file mode 100644
index 0000000..534ea57
--- /dev/null
+++ b/erin/UniqueState.icl
@@ -0,0 +1,49 @@
+implementation module UniqueState
+
+import StdEnv
+
+runState :: u:(State .s .a) .s -> v:(.a,.s), [u <= v]
+runState (State f) s = f s
+
+instance Functor (State String)
+where
+	//fmap :: u:(v:a -> w:b) x:(State String v:a) -> x:(State String w:b), [x <= u,x <= v,x <= w]
+	fmap f a = State (\s
+		# (a`, s`) = runState a s
+		= (f a`, s`))
+
+instance Applicative (State String)
+where
+	//(<*>) infixl 4 :: u:(State String v:(w:a -> x:b)) y:(State String w:a) -> z:(State String x:b), [z <= u,u <= v,y <= w,z <= x,z <= y]
+	(<*>) f a = State (\s
+		# (f`, s`) = runState f s
+		# (a`, s``) = runState a s`
+		= (f` a`, s``))
+
+	//pure :: u:a -> v:(State String u:a), [v <= u]
+	pure x = State (\s -> (x, s))
+
+instance Monad (State String)
+where
+	//bind :: u:(State String v:a) w:(v:a -> x:(State String y:b)) -> x:(State String y:b), [x <= u,u <= v,x <= w,x <= y]
+	bind a f = State (\s
+		# (v, s`) = runState a s
+		# a` = f v
+		= runState a` s`)
+
+instance Functor Maybe
+where
+	fmap f (Just x) = Just (f x)
+	fmap _ _ = Nothing
+
+instance Applicative Maybe
+where
+	(<*>) (Just f) (Just x) = Just (f x)
+	(<*>) _ _ = Nothing
+
+	pure x = Just x
+
+instance Monad Maybe
+where
+	bind (Just x) f = f x
+	bind _ _ = Nothing
diff --git a/fixdeep/test.icl b/fixdeep/test.icl
new file mode 100644
index 0000000..4ad2dac
--- /dev/null
+++ b/fixdeep/test.icl
@@ -0,0 +1,23 @@
+module test
+
+import StdEnv, StdMaybe
+import Data.Functor
+
+:: Expr v
+	= Lit Int
+	| Add (Expr v) (Expr v)
+	| E.e: Ext (e v) & eval e v
+:: Fix f = Fix (f (Fix f))
+
+
+class eval t v where
+	eval :: (t v) -> Int
+instance eval Expr v
+where
+	eval (Lit i) = i
+
+
+Start = eval t
+
+t :: Expr (Fix Expr)
+t = Lit 42
diff --git a/gengen/gen.icl b/gengen/gen.icl
new file mode 100644
index 0000000..b344b38
--- /dev/null
+++ b/gengen/gen.icl
@@ -0,0 +1,179 @@
+module gen
+
+import Control.Applicative
+import Control.Monad => qualified join
+import Control.Monad.State
+import Control.Monad.Writer
+import Control.Monad.Trans
+import Data.Either
+import Data.Func
+import Data.Functor
+import Data.Functor.Identity
+import Data.Generics
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Tuple
+import StdEnv, StdGeneric
+import Text
+
+:: Box b a =: Box b
+derive bimap Box
+unBox (Box b) :== b
+box b :== Box b
+reBox x :== box (unBox x)
+
+:: GType
+	= GTyBasic String
+	| GTyArrow GType GType
+	| GTyArray Bool GType
+	| GTyUnit
+	| GTyEither GType GType
+	| GTyPair GType GType
+	| GTyCons GenericConsDescriptor GType
+	| GTyField GenericFieldDescriptor GType
+	| GTyObject GenericTypeDefDescriptor GType
+	| GTyRecord GenericRecordDescriptor GType
+class print a :: a [String] -> [String]
+instance print Int where print s c = [toString s:c]
+instance print Char where print s c = [toString s:c]
+instance print String where print s c = [s:c]
+instance print GType
+where
+	print (GTyBasic s) c = [s:c]
+	print (GTyArrow l r) c = ["((->)":print l [" ":print r [")":c]]]
+	print (GTyArray s a) c = ["(", if s "!" "", "Array ":print a [")":c]]
+	print GTyUnit c = ["UNIT":c]
+	print (GTyEither l r) c = ["(EITHER":print l [" ":print r [")":c]]]
+	print (GTyPair l r) c = ["(PAIR ":print l [")":c]]
+	print (GTyCons _ a) c = ["(CONS ":print a [")":c]]
+	print (GTyField _ a) c = ["(FIELD ":print a [")":c]]
+	print (GTyObject _ a) c = ["(OBJECT ":print a [")":c]]
+	print (GTyRecord _ a) c = ["(RECORD ":print a [")":c]]
+
+:: Type
+	= TyBasic String
+	| TyArrow Type Type
+	| TyArray Bool Type
+	| TyNewType GenericTypeDefDescriptor GenericConsDescriptor Type
+	| TyObject GenericTypeDefDescriptor [(GenericConsDescriptor, [Type])]
+	| TyRecord GenericRecordDescriptor [(GenericFieldDescriptor, Type)]
+instance print Type
+where
+	print (TyBasic s) c = [s:c]
+	print (TyArrow l r) c = print l [" -> ":print r c]
+	print (TyArray s a) c = ["{", if s "!" "":print a ["}":c]]
+	print (TyNewType i j cons) c = pTyVars i.gtd_name i.gtd_arity
+		[": ", j.gcd_name, " ":print (nttype j.gcd_type) c]
+	where nttype (GenTypeArrow l r) = l
+	print (TyRecord i fields) c = pTyVars i.grd_name i.grd_type_arity
+		[" {":isperse ", " (pField (\i c->[i.gfd_name, " :: ":c]) fields i.grd_type) ["}":c]]
+	print (TyObject i conses) c = pTyVars i.gtd_name i.gtd_arity
+		$ [" ":isperse " | " (map pCons conses) c]
+	where
+		pCons :: (GenericConsDescriptor, [Type]) [String] -> [String]
+		pCons (i, ts) c = n [" ":isperse " " (pField (\_->id) [(i, t)\\t<-ts] i.gcd_type) c]
+		where
+			n c = case i.gcd_prio of
+				GenConsNoPrio = [i.gcd_name:c]
+				GenConsPrio a s = ["(",i.gcd_name,") infix",case a of
+					GenConsAssocRight = "r";
+					GenConsAssocLeft = "l"
+					_ = "", " ":print s c]
+
+pTyVars :: String Int [String] -> [String]
+pTyVars ty arity c = [":: ", ty, " ":isperse " " (map print ['a'..'a'+toChar (arity-1)]) [" =":c]]
+
+pField :: (a [String] -> [String]) [(a, Type)] GenType -> [[String] -> [String]]
+pField pre [] _ = []
+pField pre [(i, t):xs] (GenTypeArrow l r) = [pre i o print l:pField pre xs r]
+
+instance print GenType
+where
+	print (GenTypeVar i) c = print (['a'..] !! i) c
+	print t=:(GenTypeApp _ _) c = ["(":isperse " " (collectApps t []) [")":c]]
+	where
+		collectApps (GenTypeApp l r) c = collectApps l [print r:c]
+		collectApps a c = [print a:c]
+	print (GenTypeCons s) c = [s:c]
+	print (GenTypeArrow l r) c = ["(":print l [" -> ":print r [")":c]]]
+
+isperse :: a [[a] -> [a]] [a] -> [a]
+isperse s m c = foldr id c $ intersperse (\c->[s:c]) m
+
+gTypeToType :: GType -> Maybe Type
+gTypeToType (GTyBasic a) = pure $ TyBasic a
+gTypeToType (GTyArrow l r) = TyArrow <$> gTypeToType l <*> gTypeToType r
+gTypeToType (GTyArray s a) = TyArray s <$> gTypeToType a
+gTypeToType (GTyRecord i t) = TyRecord i <$> gtrec t
+where
+	gtrec (GTyField i t) = (\x->[(i, x)]) <$> gTypeToType t
+	gtrec (GTyPair l r) = (++) <$> gtrec l <*> gtrec r
+	gtrec _ = Nothing
+gTypeToType (GTyObject i t)
+	| i.gtd_num_conses == 0 = TyNewType i (hd i.gtd_conses) <$> gTypeToType t
+	                        = TyObject i <$> gtobj t
+where
+	gtobj :: GType -> Maybe [(GenericConsDescriptor, [Type])]
+	gtobj (GTyEither l r) = (++) <$> gtobj l <*> gtobj r
+	gtobj (GTyCons i a) = (\x->[(i, x)]) <$> gtcons a
+	gtobj _ = Nothing
+	
+	gtcons :: GType -> Maybe [Type]
+	gtcons GTyUnit = pure []
+	gtcons (GTyPair l r) = (++) <$> gtcons l <*> gtcons r
+	gtcons t = (\x->[x]) <$> gTypeToType t
+
+flattenGType :: GType -> [GType]
+flattenGType t = execWriter $ evalStateT (mkf t) []
+where
+	add :: (g GType -> GType) g GType -> StateT [String] (WriterT [GType] Identity) GType | genericDescriptorName g
+	add cons t a = gets (isMember $ genericDescriptorName t) >>= \b->if b
+		(pure $ GTyBasic $ genericDescriptorName t)
+		(cons t <$ modify (\x->[genericDescriptorName t:x]) <*> mkf a
+			>>= \ty->liftT (tell [ty]) >>| add cons t a)
+
+	mkf :: GType -> StateT [String] (WriterT [GType] Identity) GType
+	mkf (GTyObject t a) = add GTyObject t a
+	mkf (GTyRecord t a) = add GTyRecord t a
+	mkf (GTyEither l r) = GTyEither <$> mkf l <*> mkf r
+	mkf (GTyPair l r) = GTyPair <$> mkf l <*> mkf r
+	mkf (GTyCons i a) = GTyCons i <$> mkf a
+	mkf (GTyField i a) = GTyField i <$> mkf a
+	mkf (GTyArrow l r) = GTyArrow <$> mkf l <*> mkf r
+	mkf (GTyArray s a) = GTyArray s <$> mkf a
+	mkf t = pure t
+
+generic type a :: Box GType a
+type{|Int|} = box $ GTyBasic "Int"
+type{|Bool|} = box $ GTyBasic "Bool"
+type{|Real|} = box $ GTyBasic "Real"
+type{|Char|} = box $ GTyBasic "Char"
+type{|World|} = box $ GTyBasic "World"
+type{|Dynamic|} = box $ GTyBasic "Dynamic"
+type{|(->)|} l r = box $ GTyArrow (unBox l) (unBox r)
+type{|{}|} a = box $ GTyArray False $ unBox a
+type{|{!}|} a = box $ GTyArray True $ unBox a
+
+type{|UNIT|} = box GTyUnit
+type{|EITHER|} l r = box $ GTyEither (unBox l) (unBox r)
+type{|PAIR|} l r = box $ GTyPair (unBox l) (unBox r)
+type{|CONS of gcd|} a = box $ GTyCons gcd $ unBox a
+type{|FIELD of gfd|} a = box $ GTyField gfd $ unBox a
+type{|OBJECT of gtd|} a = box $ GTyObject gtd $ unBox a
+type{|RECORD of grd|} a = box $ GTyRecord grd $ unBox a
+
+derive type [], Either, Maybe, T, R, Frac, Tr, (,)
+
+:: T a =: T2 a
+:: R a = {f1 :: Maybe (R a), f2 :: Bool, f3 :: T a, f4 :: Char -> Dynamic}
+
+:: Tr m b= Tr (m Int b)
+
+:: Frac a = (/.) infixl 7 a a 
+
+Start :: [String]
+Start = foldr (\i c->print i ["\n":c]) [] $ catMaybes $ map gTypeToType $ flattenGType $ unBox t
+
+t :: Box GType ([Either (R (T *World)) (Frac Real)], Tr Either Bool)
+t = type{|*|}
diff --git a/gengen/test.icl b/gengen/test.icl
new file mode 100644
index 0000000..86a0281
--- /dev/null
+++ b/gengen/test.icl
@@ -0,0 +1,53 @@
+module test
+
+import StdEnv, StdGeneric, StdMaybe
+
+import Data.Either, Data.Func
+
+:: Box b a =: Box b
+derive bimap Box
+unBox (Box b) :== b
+box b :== Box b
+reBox x :== box (unBox x)
+
+:: GGFuns st a =
+	{ int    :: st -> Either String (Int, st)
+	, bool   :: st -> Either String (Bool, st)
+	, real   :: st -> Either String (Real, st)
+	, char   :: st -> Either String (Char, st)
+
+	, unit   :: st -> Either String (UNIT, st)
+//	, cons   :: (st -> Either String (a, st)) GenericConsDescriptor st -> Either String (CONS b, st)
+//	, field  :: (st -> Either String (a, st)) GenericFieldDescriptor st -> Either String (FIELD b, st)
+//	, record :: (st -> Either String (a, st)) GenericRecordDescriptor st -> Either String (RECORD b, st)
+//	, object :: (st -> Either String (a, st)) GenericTypeDefDescriptor st -> Either String (OBJECT b, st)
+//	, pair   :: (st -> Either String (al, st)) (st -> Either String (br, st)) st -> Either String (PAIR bl br, st)
+//	, either :: (st -> Either String (al, st)) (st -> Either String (br, st)) st -> Either String (EITHER bl br, st)
+	}
+
+ggcast :: (GGFuns st a) -> GGFuns st c
+ggcast d = {d & int=d.int}
+
+generic gGeneric a :: (GGFuns st a) st -> Either String (a, st)
+
+gGeneric{|Int|} d st = d.int st
+gGeneric{|Bool|} d st = d.bool st
+gGeneric{|Real|} d st = d.real st
+gGeneric{|Char|} d st = d.char st
+
+gGeneric{|UNIT|} d st = d.unit st
+//gGeneric{|CONS of gcd|} f d st = d.cons (f (ggcast d)) gcd st
+//gGeneric{|FIELD of gfd|} f d st = d.field (f (ggcast d)) gfd st
+//gGeneric{|OBJECT of gtd|} f d st = d.object (f (ggcast d)) gtd st
+//gGeneric{|RECORD of grd|} f d st = d.record (f (ggcast d)) grd st
+//gGeneric{|PAIR|} fl fr d st = d.pair (fl (ggcast d)) (fr (ggcast d)) st
+//gGeneric{|EITHER|} fl fr d st = d.either (fl (ggcast d)) (fr (ggcast d)) st
+
+gDefault :: a | gGeneric{|*|} a
+gDefault = fromRight o snd $
+	{ int=basic 0, bool=basic True, real=basic 0.0, char=basic 'a', unit=basic UNIT
+	}
+where
+	basic c = \_->Right (c, ())
+
+Start = 42
diff --git a/lambda/bug.icl b/lambda/bug.icl
new file mode 100644
index 0000000..91cbeb9
--- /dev/null
+++ b/lambda/bug.icl
@@ -0,0 +1,109 @@
+module bug
+
+import StdEnv
+import Data.Functor
+import Data.Func
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+
+:: In a b = In infixl 0 a b
+class lambda v
+where
+	(@) infixr 1 :: (v (a -> v b)) (v a) -> v b
+	\| :: ((v a) -> v b) -> v (a -> v b) | TC a & TC b & TC (v b)
+
+class expr v
+where
+	lit :: a -> v a | toString, TC a
+	(+.) infixl 6 :: (v a) (v a) -> v a | + a
+	(-.) infixl 6 :: (v a) (v a) -> v a | - a
+	(*.) infixl 6 :: (v a) (v a) -> v a | * a
+	(/.) infixl 6 :: (v a) (v a) -> v a | / a
+	(==.) infix 4 :: (v a) (v a) -> v Bool | == a
+	If :: (v Bool) (v a) (v a) -> v a
+
+class let v
+where
+	lett :: ((v a) -> In (v a) (v b)) -> v b | TC a
+
+import Data.Either
+import Data.Tuple
+:: St a = St (Env -> Either String (a, Env))
+:: Env :== [(Int, Dynamic)]
+instance Functor St where fmap f m = St $ fmap (appFst f) o evalSt m
+instance pure St where pure x = St \s->Right (x, s)
+instance <*> St where (<*>) mfa ma = ap mfa ma
+instance Monad St
+where
+	bind ma a2mb = St \s->case evalSt ma s of
+		Left err = Left err
+		Right (a, s) = evalSt (a2mb a) s
+
+get   = St \s->Right (s, s)
+put s = St \_->Right ((), s)
+evalSt (St m) = m
+
+instance expr St
+where
+	lit a = pure a
+	(+.) l r = (+) <$> l <*> r
+	(-.) l r = (-) <$> l <*> r
+	(*.) l r = (*) <$> l <*> r
+	(/.) l r = (/) <$> l <*> r
+	(==.) l r = (==) <$> l <*> r
+	If i t e = if` <$> i <*> t <*> e
+
+instance lambda St
+where
+	(@) l r = l >>= \l->r >>= \r->l r
+	\| def = pure $ def o pure
+
+instance let St
+where
+	lett def = length <$> get >>= \l->
+		let (x In y) = def $ get >>= \s->hd [d\\(x, d :: St a^)<-s | l == x]
+		in  get >>= \s->put [(l, dynamic x):s] >>| y
+
+Start = evalSt t2 []
+where
+// Geeft:
+/*
+initial_unification_environment [module: _SystemDynamic]
+_initial_unification_environment [module: _SystemDynamic]
+_f111;111 [module: bug]
+<lambda>[line:65];38;90 [module: bug]
+<case>[line:39];27;103 [module: bug]
+evalSt [module: bug]
+<lambda>[line:39];23;11 [module: bug]
+evalSt [module: bug]
+<lambda>[line:39];23;11 [module: bug]
+evalSt [module: bug]
+evalSt [module: bug]
+<lambda>[line:39];23;11 [module: bug]
+*/
+	t1  = lett \id     = (\| \x->x)
+//	  In lett \fix    = (\| \f->lett \x=f @ x In x)
+	  In lett \fac    = (\| \n->If (n ==. lit 0) (lit 1) (n *. (fac @ n -. lit 1)))
+//	  In lett \facfix = (\| \n->(fix @ \| \fac-> \| \n->If (n ==. lit 0) (lit 1) (n *. (fac @ n -. lit 1))) @ n)
+	  In fac @ id @ lit 10
+// Geeft:
+/*
+unify_ [module: _SystemDynamic]
+unify_ [module: _SystemDynamic]
+unify_ [module: _SystemDynamic]
+unify_types [module: _SystemDynamic]
+_unify [module: _SystemDynamic]
+_f143;143 [module: bug]
+<lambda>[line:65];38;101 [module: bug]
+<case>[line:39];27;135 [module: bug]
+evalSt [module: bug]
+<lambda>[line:39];23;22 [module: bug]
+evalSt [module: bug]
+evalSt [module: bug]
+*/
+	t2  = lett \id     = (\| \x->x)
+	  In lett \fix    = (\| \f->lett \x=f @ x In x)
+	  In lett \fac    = (\| \n->If (n ==. lit 0) (lit 1) (n *. (fac @ n -. lit 1)))
+	  In lett \facfix = (\| \n->(fix @ \| \fac-> \| \n->If (n ==. lit 0) (lit 1) (n *. (fac @ n -. lit 1))) @ n)
+	  In facfix @ id @ lit 10
diff --git a/lambda/lambda.hs b/lambda/lambda.hs
new file mode 100644
index 0000000..ddb5426
--- /dev/null
+++ b/lambda/lambda.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+module Main where
+
+import Data.Functor
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+import Data.Dynamic
+import Control.Monad.State
+
+main = putStrLn
+    $ show
+    ( concat $ Main.print e4
+--    , eval e4
+    , evalSt $ (lambdalift e4)
+    , concat $ Main.print e5
+    , evalSt $ (lambdalift e5)
+    )
+
+e1 :: Expr v => v Integer
+e1 = lit 41 +. lit 1
+
+e2 :: (Expr v, Lambda v) => v Integer
+e2 = (a $ \x->x) % e1
+
+e3 :: (Expr v, Lambda v, Let v) => v Integer
+e3 =  lett (\id->(a $ \x->x)
+   :- id % e1)
+
+e4 :: (Expr v, Lambda v, Let v, Typeable v) => v Integer
+e4  = {-lett (\id     -> (a $ \x->x)
+   :- -}lett (\fix    -> (a $ \f->lett $ \x->f % x :- x)
+--   :- lett (\fac    -> (a (\n->if' (n ==. lit 0) (lit 1) (n *. (fac % n -. lit 1))))
+   :- lett (\facfix -> (a $ \fac->a $ \n->if' (n ==. lit 0) (lit 1) (n *. (fac % n -. lit 1)))
+   :- (fix % facfix) % lit 10))
+
+e5 :: (Expr v, Lambda v, Let v, Typeable v) => v Integer
+e5  = lett (\fac -> (a $ \n->
+        if' (n ==. lit 0)
+            (lit 1)
+            ((a $ \x->x *. n) % (fac % n -. lit 1))
+        )
+      :- fac % lit 5)
+
+infixl 1 :-
+data In a b = a :- b
+
+infixr 2 %
+class Lambda v where
+    (%) :: v (a -> b) -> v a -> v b
+    a :: (v a -> v b) -> v (a -> b)
+
+infixl 6 +., -.
+infixl 7 *.
+infix 4 ==.
+class Expr v where
+    lit :: Show a => a -> v a
+    (+.) :: Num a => v a -> v a -> v a
+    (-.) :: Num a => v a -> v a -> v a
+    (*.) :: Num a => v a -> v a -> v a
+    (==.) :: Eq a => v a -> v a -> v Bool
+    if' :: v Bool -> v a -> v a -> v a
+
+class Let v where
+    lett :: (Typeable a) => (v a -> In (v a) (v b)) -> v b
+
+data Printer a = P (PS -> [String] -> [String])
+data PS = PS {fresh :: [String]}
+unP (P a) = a
+
+par x = P $ \s->("(":) . unP x s . (")":)
+
+print :: (Printer a) -> [String]
+print a = unP a (PS {fresh = ['v':show x | x <- [0..]]}) []
+
+instance Lambda Printer where
+    l % r = par $ P $ \s->unP l s . (" ":) . unP r s
+    a def = par $ P $ \(PS {fresh=i:is})->
+        (["\\",i,"->"]++) . unP (def (P $ \_->(i:))) (PS {fresh=is})
+
+instance Expr Printer where
+    lit a = P $ \_->(show a:)
+    l +. r  = par $ P $ \s->unP l s . ("+":) . unP r s
+    l -. r  = par $ P $ \s->unP l s . ("-":) . unP r s
+    l *. r  = par $ P $ \s->unP l s . ("*":) . unP r s
+    l ==. r  = par $ P $ \s->unP l s . ("==":) . unP r s
+    if' p t e = P $ \s->("if ":) . unP p s . (" then ":)
+        . unP t s . (" else ":) . unP e s . (" fs":)
+
+instance Let Printer where
+    lett def = P $ \s@(PS {fresh=i:is})->
+        let x :- y = def $ P $ \_->(i:)
+        in  (["let ",i,"="]++) . unP x s . (" in\n":) . unP y (PS {fresh=is})
+
+eval :: Maybe a -> Maybe a
+eval a = a
+
+instance Lambda Maybe where
+    (%) l r = ($) <$> l <*> r
+    a def = pure $ fromJust . def . pure
+
+instance Expr Maybe where
+    lit a = pure a
+    l +. r  = (+) <$> l <*> r
+    l -. r  = (-) <$> l <*> r
+    l *. r  = (*) <$> l <*> r
+    l ==. r = (==) <$> l <*> r
+    if' i t e = i >>= \i->if i then t else e
+
+instance Let Maybe where
+    lett def = let x :- y = def x in y
+
+evalSt :: (State [(Int, Dynamic)] a) -> a
+evalSt s = evalState s []
+
+instance Lambda (State [(Int, Dynamic)]) where
+    l % r = ($) <$> l <*> r
+    a def = get >>= \s->pure $ \a->evalState (def $ pure a) s
+
+instance Expr (State [(Int, Dynamic)]) where
+    lit a = pure a
+    l +. r  = (+) <$> l <*> r
+    l -. r  = (-) <$> l <*> r
+    l *. r  = (*) <$> l <*> r
+    l ==. r = (==) <$> l <*> r
+    if' i t e = i >>= \i->if i then t else e
+
+instance Let (State [(Int, Dynamic)]) where
+    lett def = gets length >>= \l->
+        let x :- y = def $ get >>= \s->head $ catMaybes [fromDynamic d | (x, d)<-s, l == x]
+        in  modify ((l, toDyn x):) >> y
+
+data LambdaLift v a = LL {unLL :: LLS -> (v a, LLS)}
+data LLS = LLS {toplevel :: Bool}
+lambdalift :: LambdaLift v a -> v a
+lambdalift m = fst $ unLL m $ LLS {toplevel=True}
+
+infixl 4 <<$>>, <<*>>
+infixl 1 >>>=
+class FFunctor m where
+    (<<$>>) :: (v a -> w b) -> m v a -> m w b
+
+class AApplicative m where
+    ppure :: v a -> m v a
+    (<<*>>) :: m ((->) (v a)) (w b) -> m v a -> m w b
+
+class MMonad m where
+    (>>>=) :: m v a -> (v a -> m w b) -> m w b
+
+instance FFunctor LambdaLift where
+    f <<$>> m = LL $ \s->let (a, s') = unLL m s in (f a, s')
+instance AApplicative LambdaLift where
+    ppure a = LL $ (,) a
+    m <<*>> n = LL $ \s->
+        let (v, s') = unLL m s
+            (w, s'') = unLL n s
+        in (v w, s'')
+instance MMonad LambdaLift where 
+    --m >>>= a2mb = LL $ uncurry (unLL . a2mb) . unLL m
+    m >>>= a2mb = LL $ \s->let (a, s') = unLL m $ s in unLL (a2mb a) s
+
+instance Expr v => Expr (LambdaLift v) where
+    lit a = ppure (lit a)
+    l +. r  = (+.)  <<$>> l <<*>> r
+    l -. r  = (-.)  <<$>> l <<*>> r
+    l *. r  = (*.)  <<$>> l <<*>> r
+    l ==. r = (==.) <<$>> l <<*>> r
+    if' i t e = if' <<$>> i <<*>> t <<*>> e
+
+instance Lambda v => Lambda (LambdaLift v) where
+    l % r = (%) <<$>> l <<*>> r
+    a def = LL $ \s->(a $ \a->fst $ unLL (def $ ppure a) s, s)
+
+instance Let v => Let (LambdaLift v) where
+    lett def = let x :- y = def x in y
diff --git a/lambda/test.icl b/lambda/test.icl
deleted file mode 100644
index 0841159..0000000
--- a/lambda/test.icl
+++ /dev/null
@@ -1,121 +0,0 @@
-module test
-
-import StdEnv
-import Data.Functor
-import Data.Func
-import Data.Maybe
-import Control.Applicative
-import Control.Monad
-
-:: In a b = In infixl 0 a b
-class lambda v
-where
-	(@) infixr 1 :: (v (a -> b)) (v a) -> v b
-	\| :: ((v a) -> v b) -> v (a -> b) | TC a & TC b
-
-class expr v
-where
-	lit :: a -> v a | toString, TC a
-	(+.) infixl 6 :: (v a) (v a) -> v a | + a
-	(-.) infixl 6 :: (v a) (v a) -> v a | - a
-	(*.) infixl 6 :: (v a) (v a) -> v a | * a
-	(/.) infixl 6 :: (v a) (v a) -> v a | / a
-	(==.) infix 4 :: (v a) (v a) -> v Bool | == a
-	If :: (v Bool) (v a) (v a) -> v a
-
-class let v
-where
-	lett :: ((v a) -> In (v a) (v b)) -> v b | TC a
-
-:: Printer a = P ([String] [String] -> [String])
-unP (P a) = a
-print :: (Printer a) -> [String]
-print (P a) = a ["v" +++ toString i\\i<-[0..]] []
-instance lambda Printer
-where
-	(@) (P l) (P r) = P \i c->l i [" ":r i c]
-	\| def = P \[i:is] c->["(\\", i, "->":unP (def (P \_ c->[i:c])) is [")":c]]
-
-instance expr Printer
-where
-	lit a = P \i c->[toString a:c]
-	(+.) (P l) (P r) = P \i c->["(":l i ["+":r i [")":c]]]
-	(-.) (P l) (P r) = P \i c->["(":l i ["-":r i [")":c]]]
-	(*.) (P l) (P r) = P \i c->["(":l i ["*":r i [")":c]]]
-	(/.) (P l) (P r) = P \i c->["(":l i ["/":r i [")":c]]]
-	(==.) (P l) (P r) = P \i c->["(":l i ["==":r i [")":c]]]
-	If (P p) (P t) (P e) = P \i c->["if ":p i [" then ":t i [" else ":e i [" fi":c]]]]
-
-instance let Printer
-where
-	lett def = P \[i:is] c->
-		let (x In y) = def $ P \_ c->[i:c]
-		in  ["let ",i,"=":(unP x) [i:is] [" in ":(unP y) is c]]
-
-eval :: (Maybe a) -> Maybe a
-eval a = a
-
-instance lambda Maybe
-where
-	(@) l r = ($) <$> l <*> r
-	\| def = Just $ fromJust o def o Just
-
-instance expr Maybe
-where
-	lit a = pure a
-	(+.) l r = (+) <$> l <*> r
-	(-.) l r = (-) <$> l <*> r
-	(*.) l r = (*) <$> l <*> r
-	(/.) l r = (/) <$> l <*> r
-	(==.) l r = (==) <$> l <*> r
-	If i t e = if` <$> i <*> t <*> e
-
-instance let m
-where
-	lett def = let (x In y) = def x in y
-
-:: St a = St (State -> (a, State))
-:: State :== [(Int, Dynamic)]
-instance Functor St where fmap f m = St $ (\(a, b)->(f a, b)) o evalSt m
-instance pure St where pure x = St \s->(x, s)
-instance <*> St where (<*>) mfa ma = ap mfa ma
-instance Monad St
-where
-	bind ma a2mb = St \s
-		# (a, s) = evalSt ma s
-		= evalSt (a2mb a) s
-
-get   = St \s->(s, s)
-put s = St \_->((), s)
-evalSt (St m) = m
-
-instance expr St
-where
-	lit a = pure a
-	(+.) l r = (+) <$> l <*> r
-	(-.) l r = (-) <$> l <*> r
-	(*.) l r = (*) <$> l <*> r
-	(/.) l r = (/) <$> l <*> r
-	(==.) l r = (==) <$> l <*> r
-	If i t e = if` <$> i <*> t <*> e
-
-instance lambda St
-where
-	(@) l r = ($) <$> l <*> r
-	\| def = get >>= \s->pure \a->fst $ evalSt (def $ pure a) s
-
-instance let St
-where
-	lett def = length <$> get >>= \l->
-		let (x In y) = def $ get >>= \s->hd [d\\(x, d :: St a^)<-s | l == x]
-		in  get >>= \s->put [(l, dynamic x):s] >>| y
-
-//Start = (print t, "\n", eval t, semSt t)
-Start = (print t, "\n", fst $ evalSt t [])
-where
-	t :: (v Int) | expr, lambda, let v
-	t  = lett \id =(\| \x->x)
-	  In lett \fix =(\| \f->lett \x=f @ x In x)
-	  In lett \fac=(\| \n->If (n ==. lit 0) (lit 1) (n *. (fac @ n -. lit 1)))
-	  In lett \facfix=(\| \n->(fix @ \| \fac-> \| \n->If (n ==. lit 0) (lit 1) (n *. (fac @ n -. lit 1))) @ n)
-	  In facfix @ id @ lit 10
diff --git a/prj/test.icl b/prj/test.icl
new file mode 100644
index 0000000..bd20f3d
--- /dev/null
+++ b/prj/test.icl
@@ -0,0 +1,5 @@
+module test
+
+import iTasks
+
+Start w = doTasks (return ()) w
diff --git a/shallow.icl b/shallow.icl
deleted file mode 100644
index aeffa23..0000000
--- a/shallow.icl
+++ /dev/null
@@ -1,8 +0,0 @@
-module shallow
-
-import StdEnv
-
-:: DSL = DSL a
-
-lit :: a -> DSL a
-lit a = ...
diff --git a/slave/cloudiTasks/cloudiTasks.icl b/slave/cloudiTasks/cloudiTasks.icl
new file mode 100644
index 0000000..09d6fde
--- /dev/null
+++ b/slave/cloudiTasks/cloudiTasks.icl
@@ -0,0 +1,149 @@
+module cloudiTasks
+
+import Data.Functor
+import Data.Queue
+import iTasks.Internal.Serialization
+import iTasks.Internal.TaskEval
+import iTasks.UI.Editor.Common
+import StdEnv
+import Data.Func
+import Data.Tuple
+import Data.Map.GenJSON
+import iTasks
+import iTasks.Extensions.DateTime
+import iTasks.Internal.Distributed.RemoteTask
+import qualified Data.Map
+import System.Time
+
+:: CloudTaskType = ExistingNode String Int
+
+//mapReadWrite :: !(!r -> r`,!w` r -> Maybe w) !(Maybe (SDSReducer p w w`)) !(sds p r w) -> SDSLens p r` w` | gText{|*|} p & TC p & TC r & TC w & RWShared sds
+
+asyncTask :: CloudTaskType (Task a) -> Task a | iTask a
+asyncTask (ExistingNode host port) t
+	= upd (\tid->(tid, TaskWrapper t)) (remoteShare cloudITasksQueue {domain=host, port=port})
+	>>- \(tid, _)->let rvalue = remoteShare (sdsFocus tid cloudITasksValues) {domain=host,port=port}
+		in Task (proxy NoValue rvalue rvalue)
+where
+	proxy ::
+		//The old task value
+		(TaskValue a)
+		//The original value queue
+		(sds1 () (Queue (TaskValue a, UIChange)) (Queue (TaskValue a, UIChange)))
+		//The temporary value queue
+		(sds2 () (Queue (TaskValue a, UIChange)) (Queue (TaskValue a, UIChange)))
+		Event
+		TaskEvalOpts
+		!*IWorld
+		-> *(TaskResult a, *IWorld) | RWShared sds1 & Readable, Registrable sds2 & iTask a
+	proxy lastVal valueShare tValueShare event {TaskEvalOpts|taskId,lastEval} iworld
+		= case readRegister taskId tValueShare iworld of
+			(Ok (ReadingDone queue), iworld)
+				= case dequeue queue of
+					(Nothing, queue)
+						= (ValueResult
+							lastVal
+							{lastEvent=lastEval, removedTasks=[]}
+							NoChange
+							(Task (proxy lastVal valueShare tValueShare))
+						, iworld)
+					(Just (tv, ui), queue)
+						= case write queue valueShare (TaskContext taskId) iworld of
+							(Ok _, iworld)
+								= (ValueResult
+									tv
+									{lastEvent=lastEval, removedTasks=[]}
+									ui
+									(Task (proxy tv valueShare valueShare))
+								, iworld)
+							(Error e, iworld) = (ExceptionResult e, iworld)
+			(Ok (Reading tValueShare), iworld)
+				= (ValueResult
+					lastVal
+					{lastEvent=lastEval, removedTasks=[]}
+					NoChange
+					(Task (proxy lastVal valueShare tValueShare))
+				, iworld)
+			(Error e, iworld) = (ExceptionResult e, iworld)
+
+Start w = flip doTasksWithOptions w \args eo
+	# (eo, s) = case args of
+		[argv0,"--slave",p] = ({eo & sdsPort=toInt p}, onStartup o slave)
+		_ = (eo, onRequest "/" o master)
+	= Ok (s args, {eo & distributed=True})
+
+JSONEncode{|TaskWrapper|} _ t = [dynamicJSONEncode t]
+JSONDecode{|TaskWrapper|} _ [t:c] = (dynamicJSONDecode t, c)
+JSONDecode{|TaskWrapper|} _ c = (Nothing, c)
+gEq{|TaskWrapper|} _ _ = False
+gEditor{|TaskWrapper|} = emptyEditor
+gText{|TaskWrapper|} tf ma = maybe [] (\_->["TaskWrapper"]) ma
+
+slave :: [String] -> Task ()
+slave args
+	=   get applicationOptions
+	>>- \eo->traceValue ("Slave started on port " +++ toString eo.sdsPort)
+	>-| parallel
+		[(Embedded, \stl->flip (@!) () $ forever $
+			    watch cloudITasksQueueInt
+			>>* [OnValue $ ifValue (not o isEmpty) \[(tid, TaskWrapper task):xs]->
+				    set xs cloudITasksQueueInt
+				>-| appendTask Embedded (\_->wrapTask tid task) stl
+			]
+		)] []
+	@? const NoValue
+where
+	wrapTask :: TaskId (Task a) -> Task () | iTask a
+	wrapTask taskId (Task teval) = Task \event opts iworld->
+		case teval event {TaskEvalOpts|opts & taskId=taskId} iworld of
+			(ValueResult tv tei uic newtask, iworld)
+				= case modify (enqueue (tv, uic)) (sdsFocus taskId cloudITasksValues) EmptyContext iworld of
+					(Ok (ModifyingDone _), iworld)
+						= (ValueResult (() <$ tv) tei uic $ wrapTask taskId newtask, iworld)
+					(Ok _, iworld) = (ExceptionResult $ exception "wrapTask async share????", iworld)
+					(Error e, iworld) = (ExceptionResult e, iworld)
+			(ExceptionResult e, iworld) = (ExceptionResult e, iworld)
+			(DestroyedResult, iworld) = (DestroyedResult, iworld)
+
+derive JSONEncode Queue, Event, Set
+derive JSONDecode Queue, Event, Set
+cloudITasksValues :: SDSLens TaskId (Queue (TaskValue a, UIChange)) (Queue (TaskValue a, UIChange)) | TC, JSONEncode{|*|}, JSONDecode{|*|} a
+cloudITasksValues = sdsTranslate "" toString
+	$ memoryStore "cloudITasks-values" $ Just newQueue
+
+cloudITasksEvents :: SDSLens TaskId (Queue Event) (Queue Event)
+cloudITasksEvents = sdsTranslate "" toString
+	$ memoryStore "cloudITasks-events" $ Just newQueue
+
+nextTaskIdShare :: SDSSource () TaskId ()
+nextTaskIdShare = SDSSource
+	{ SDSSourceOptions
+	| name  = "nextTaskIdShare"
+	, read  = \_->appFst Ok o getNextTaskId
+	, write = \_ _->tuple $ Ok (\_ _->True)
+	}
+
+cloudITasksQueue :: SDSLens () TaskId (TaskId, TaskWrapper)
+cloudITasksQueue =
+	mapReadWrite
+		( \(nextTaskId, _)->nextTaskId
+		, \newTask (nextTaskId, tasks)->Just ((), [newTask:tasks])
+		) Nothing (nextTaskIdShare >*< cloudITasksQueueInt)
+
+cloudITasksQueueInt :: SimpleSDSLens [(TaskId, TaskWrapper)]
+cloudITasksQueueInt = sdsFocus "queue" $ memoryStore "cloudITasks" (Just [])
+
+master :: [String] -> Task ()
+master args
+	= get applicationOptions
+	>>- \eo->traceValue ("Master started on port " +++ toString eo.serverPort)
+	>-| asyncTask (ExistingNode "localhost" 9099) (traceValue "boink")
+	@! ()
+
+blockWait :: Int -> Task Int
+blockWait i = accWorld (sleep i)
+where
+	sleep :: !Int !*e -> (!Int, !*e)
+	sleep _ _ = code {
+			ccall sleep "I:I:A"
+		}
diff --git a/structs/GenC.dcl b/structs/GenC.dcl
index 840bc09..f99f068 100644
--- a/structs/GenC.dcl
+++ b/structs/GenC.dcl
@@ -28,7 +28,7 @@ toStruct :: Box GTSState a | gToStruct{|*|} a
 :: GTSState
 instance zero GTSState
 generic gToStruct a | gPotInf a :: GTSState -> (GTSResult, Box GTSState a)
-derive gToStruct Int, Bool, Char, Real, UNIT, CONS, FIELD, EITHER, PAIR, OBJECT of {gtd_arity,gtd_name,gtd_conses,gtd_num_conses}, RECORD of {grd_arity,grd_name,grd_fields}
+derive gToStruct Int, Bool, Char, Real, UNIT, CONS of {gcd_type}, FIELD, EITHER, PAIR, OBJECT of {gtd_arity,gtd_name,gtd_conses,gtd_num_conses}, RECORD of {grd_arity,grd_name,grd_fields}
 
 /**
  * Given a GTSState, generate typedefinitions
diff --git a/structs/GenC.icl b/structs/GenC.icl
index 19a0652..2995ef2 100644
--- a/structs/GenC.icl
+++ b/structs/GenC.icl
@@ -36,16 +36,17 @@ gPotInf{|RECORD of {grd_name}|} f s
 :: CType
 	= CTTypeDef String
 	| CTEnum [String]
-	| CTStruct Int [(String, [(String, Bool, String)])]
+	| CTStruct Int [(String, [(String, Bool, String, Maybe GenType)])]
 
-:: GTSState = {dict :: Map String CType}
-instance zero GTSState where zero = {dict=newMap}
+:: GTSState = {dict :: Map String CType, ts :: [GenType]}
+instance zero GTSState where zero = {dict=newMap, ts=[]}
 
 toStruct :: Box GTSState a | gToStruct{|*|} a
 toStruct = snd $ gToStruct{|*|} zero
 generic gToStruct a | gPotInf a :: GTSState -> (GTSResult, Box GTSState a)
 :: GTSResult
-	= GTSType Bool String //ispointer and the name
+	= GTSType Bool String (Maybe GenType)//ispointer and the name
+	| GTSTyVar Int
 	| GTSUnit
 	| GTSEither [GTSResult]
 	| GTSPair [GTSResult]
@@ -53,12 +54,18 @@ generic gToStruct a | gPotInf a :: GTSState -> (GTSResult, Box GTSState a)
 
 putst k v st = {st & dict=put k v st.dict}
 
-gToStruct{|Int|} st  = (GTSType False "uint64_t", box st)
-gToStruct{|Bool|} st = (GTSType False "bool", box st)
-gToStruct{|Char|} st = (GTSType False "char", box st)
-gToStruct{|Real|} st = (GTSType False "double", box st)
+import Debug.Trace
+gToStruct{|Int|}  st = (GTSType False "uint64_t" $ listToMaybe st.ts, box st)
+gToStruct{|Bool|} st = (GTSType False "bool" $ listToMaybe st.ts, box st)
+gToStruct{|Char|} st = (GTSType False "char" $ listToMaybe st.ts, box st)
+gToStruct{|Real|} st = (GTSType False "double" $ listToMaybe st.ts, box st)
 gToStruct{|UNIT|} st = (GTSUnit, box st)
-gToStruct{|CONS|} f _ st = appSnd reBox $ f st
+gToStruct{|CONS of {gcd_type}|} f _ st
+	= appSnd reBox $ f {st & ts=pt gcd_type}
+where
+	pt (GenTypeArrow l r) = [l:pt r] 
+	pt a = [a]
+
 gToStruct{|FIELD|} f _ st = appSnd reBox $ f st
 gToStruct{|EITHER|} fl _ fr _ st
 	# (l, Box st) = fl st
@@ -68,9 +75,9 @@ gToStruct{|EITHER|} fl _ fr _ st
 		(a, GTSEither l) = GTSEither [a:l]
 		(l, r) = GTSEither [l, r]
 	, box st)
-gToStruct{|PAIR|} fl _ fr _ st
-	# (l, Box st) = fl st
-	# (r, Box st) = fr st
+gToStruct{|PAIR|} fl _ fr _ st=:{ts=[t:ts]}
+	# (l, Box st) = fl {st & ts = [t]}
+	# (r, Box st) = fr {st & ts = ts}
 	= (case (l, r) of
 		(GTSPair l, GTSPair r) = GTSPair (l ++ r)
 		(a, GTSPair l) = GTSPair [a:l]
@@ -79,21 +86,20 @@ gToStruct{|PAIR|} fl _ fr _ st
 import Debug.Trace
 gToStruct{|OBJECT of {gtd_name,gtd_arity,gtd_conses,gtd_num_conses}|} f i st
 	# (Box isPInf) = i []
-	# ty = GTSType isPInf
 	= case get gtd_name st.dict of
-		Just _ = (GTSType isPInf gtd_name, box st)
+		Just _ = (GTSType isPInf gtd_name $ listToMaybe st.ts, box st)
 		Nothing
 			//Newtype
 			| gtd_num_conses == 0
 				= case f st of
-					(GTSType pi n, Box st) = (GTSType pi gtd_name, box $ putst gtd_name (CTTypeDef n) st)
+					(GTSType pi n mt, Box st) = (GTSType pi gtd_name mt, box $ putst gtd_name (CTTypeDef n) st)
 			//If it is just an enumeration, Just the enum
 			| and [gcd.gcd_arity == 0\\gcd<-gtd_conses]
-				= (GTSType False gtd_name, box $ putst gtd_name (CTEnum [gcd.gcd_name\\gcd<-gtd_conses]) st)
+				= (GTSType False gtd_name Nothing, box $ putst gtd_name (CTEnum [gcd.gcd_name\\gcd<-gtd_conses]) st)
 			//Constructors with data fields
 			# (n, Box st) = appFst mkty $ f $ putst gtd_name (CTTypeDef gtd_name) st
 			=
-				( GTSType isPInf gtd_name
+				( GTSType isPInf gtd_name Nothing
 				, box $ putst gtd_name
 					(CTStruct gtd_arity $ zipWith ctcons gtd_conses $ map mkccons n) st
 				)
@@ -103,26 +109,24 @@ gToStruct{|OBJECT of {gtd_name,gtd_arity,gtd_conses,gtd_num_conses}|} f i st
 		mkty t = [t]
 
 		mkccons :: GTSResult -> [GTSResult]
-		mkccons (GTSType pi t) = [GTSType pi t]
+		mkccons (GTSType pi t a) = [GTSType pi t a]
 		mkccons (GTSPair t) = t
 		mkccons _ = []
 
-		ctcons :: GenericConsDescriptor [GTSResult] -> (String, [(String, Bool, String)])
-		ctcons gcd cons
-			# (_, gcd_name, _, cons, _) = trace_stdout ("\n---\n", gcd.gcd_name, gcd.gcd_type, cons, "\n---\n")
-			= (gcd_name, toT cons)
+		ctcons :: GenericConsDescriptor [GTSResult] -> (String, [(String, Bool, String, Maybe GenType)])
+		ctcons gcd cons = (gcd.gcd_name, toT cons)
 		where
-			toT cons = [(t, pi, "f"+++toString i)\\i<-[0..] & GTSType pi t<-cons]
+			toT cons = [(t, pi, "f"+++toString i, mt)\\i<-[0..] & GTSType pi t mt<-cons]
 gToStruct{|RECORD of {grd_arity,grd_name,grd_fields}|} f i st
 	# (Box isPInf) = i []
 	= case get grd_name st.dict of
-		Just n = (GTSType isPInf grd_name, box st)
+		Just n = (GTSType isPInf grd_name Nothing, box st)
 		Nothing
 			# (n, Box st) = f $ putst grd_name (CTTypeDef grd_name) st
 			= case n of
 				GTSPair l =
-					( GTSType isPInf grd_name
-					, box $ putst grd_name (CTStruct grd_arity [(grd_name, [(t, pi, gfd)\\GTSType pi t<-l & gfd<-grd_fields])]) st)
+					( GTSType isPInf grd_name Nothing
+					, box $ putst grd_name (CTStruct grd_arity [(grd_name, [(t, pi, gfd, mt)\\GTSType pi t mt<-l & gfd<-grd_fields])]) st)
 				_ = (GTSError, box st)
 
 /**
@@ -133,7 +137,7 @@ toCType {dict=m} = foldr proc [] $ scc $ map (appSnd refs) $ toList m
 where
 	refs (CTTypeDef s) = [s]
 	refs (CTEnum _) = []
-	refs (CTStruct _ cs) = map fst3 (flatten (map snd cs))
+	refs (CTStruct _ cs) = map (\(a, _, _, _)->a) (flatten (map snd cs))
 
 	proc [] c = c
 	proc [x] c = ctypedef x (find x m) c
@@ -147,7 +151,7 @@ where
 	ctypedef name (CTEnum a) c = ["enum ", name, " {": enum a ["};\n":c]]
 	ctypedef name (CTStruct _ [(_, fs)]) c =
 		[ "struct ", name, " {\n"
-		: foldr (uncurry3 (field 1))
+		: foldr (field 1)
 		["};\n":c] fs
 		]
 	ctypedef name (CTStruct _ cs) c =
@@ -161,10 +165,10 @@ where
 		cs]]]]
 
 	struct name [] c = c
-	struct name [(ty, pi, _)] c = field 2 ty pi name c
-	struct name fs c = ind 2 ["struct {\n" :foldr (uncurry3 (field 3)) (ind 2 ["} ", name, ";\n":c]) fs]
+	struct name [(ty, pi, _, mt)] c = field 2 (ty, pi, name, mt) c
+	struct name fs c = ind 2 ["struct {\n" :foldr (field 3) (ind 2 ["} ", name, ";\n":c]) fs]
 	
-	field i ty pi name c
+	field i (ty, pi, name, gt) c
 		= ind i $ typeName ty m [if pi " *" " ", name, ";\n":c]
 	
 	enum [] c = c
@@ -191,7 +195,31 @@ toCParser {dict=m} = (funsigs, foldr funbody [] (toList m))
 where
 	funsigs = foldr (uncurry funsig) [";\n"] $ toList m
 	pfname n c = ["parse_", n:c]
-	pfcall n c = pfname n ["(get, alloc, err);":c]
+	pfcall n Nothing c = pfname n ["(get, alloc, err);":c]
+	pfcall n (Just t) c
+		# (n, t) = trace_stdout (n, t)
+		= pf t c
+	where
+		pf (GenTypeCons n) c = pfcall n Nothing c
+		pf (GenTypeVar i) c = pfcall (toString i) Nothing c
+		pf (GenTypeApp t (GenTypeVar i)) c
+			= pf t $ pfcall (toString i) Nothing c
+		pf _ c = c
+//
+//	pfcall n (Just (GenTypeVar i)) c = pfcall (toString i) Nothing c
+//	pfcall n (Just (GenTypeApp (GenTypeCons _) (GenTypeVar i))) c
+//		= pfcall (toString i) Nothing c
+//	pfcall n (Just t) c
+//		# (_, t, c, _) = trace_stdout ("\nblurp: ", t, c, "\n")
+//		= c
+
+//	pfcall n mt c = pfname n ["(get, alloc, err":(maybe id stycall mt) [");":c]]
+//	where
+//		stycall (GenTypeVar i) c
+//			= [", ":pfname (toString i) c]
+//		stycall (GenTypeApp (GenTypeCons _) (GenTypeVar i)) c
+//			= [", ":pfname (toString i) c]
+//		stycall _ c = c
 	funsig n (CTStruct i _) c
 		| i > 0
 			= typeName n m [" "
@@ -211,7 +239,7 @@ where
 		: ind i ["void (*err)(const char *errmsg, ...)"
 		:c]]]
 
-	funb (CTTypeDef a) c = ind 1 ["r = ":pfcall a ["\n":c]]
+	funb (CTTypeDef a) c = ind 1 ["r = ":pfcall a Nothing ["\n":c]]
 	funb (CTEnum a) c = ind 1 ["r = get()\n":c]
 	funb (CTStruct _ [(_, fs)]) c = foldr (sfield 1 "r") c fs
 	funb (CTStruct _ fs) c
@@ -227,9 +255,9 @@ where
 			: foldr (sfield 2 ("r.data."+++ n))
 			(ind 2 ["break;\n":c]) fs]
 
-	sfield i r (ty, ptr, f) c
+	sfield i r (ty, ptr, f, mt) c
 		= (\c->if ptr (ind i [r, ".", f, " = alloc(sizeof(":typeName ty m ["));\n":c]]) c)
-		$ ind i [if ptr "*" "", r, ".", f, " = ":pfcall ty ["\n":c]]
+		$ ind i [if ptr "*" "", r, ".", f, " = ":pfcall ty mt ["\n":c]]
 
 /**
  * Given a GTSState, generate a printer
@@ -266,7 +294,7 @@ where
 			: foldr (sfield 2 ("r.data."+++ n))
 			(ind 2 ["break;\n":c]) fs]
 
-	sfield i r (ty, ptr, f) c
+	sfield i r (ty, ptr, f, mt) c
 		= ind i $ pfcall (concat [if ptr "*" "", r, ".", f]) ty ["\n":c]
 
 toCValue :: a [Char] -> [Char] | gToCValue{|*|} a
diff --git a/structs/qualified b/structs/qualified
deleted file mode 100644
index e69de29..0000000
diff --git a/structs/test.icl b/structs/test.icl
index a0cd464..c301fdf 100644
--- a/structs/test.icl
+++ b/structs/test.icl
@@ -1,5 +1,7 @@
 module test
 
+import Data.Maybe
+import Data.Either
 import GenC
 import Text
 
@@ -9,9 +11,8 @@ import Text
 :: R = {i :: Int, q :: T}
 :: Muta a = Muta (Mutb a)
 :: Mutb a = Mutb (Muta a)
-derive gToStruct NInt, T, List, R, Muta, Mutb, (,), (), [], (,,)
-derive gPotInf NInt, T, List, R, Muta, Mutb, (,), (), [], (,,)
-
+derive gToStruct NInt, T, List, R, Muta, Mutb, (,), (), [], (,,), Maybe, Either
+derive gPotInf NInt, T, List, R, Muta, Mutb, (,), (), [], (,,), Maybe, Either
 
 Start = let (l, r) = (toCParser (unBox t2)) in concat r
 where
@@ -19,5 +20,7 @@ where
 //	t :: Box GTSState NInt
 	t = Box "listmutaint"
 
-	t2 :: Box GTSState (Bool, Int)
+	t2 :: Box GTSState [Either Int Bool]
+//	t2 :: Box GTSState (Either Int Bool)
+//	t2 :: Box GTSState [Int]
 	t2 = toStruct
diff --git a/uds/test.icl b/uds/test.icl
index f2601b9..fe83fe0 100644
--- a/uds/test.icl
+++ b/uds/test.icl
@@ -4,16 +4,16 @@ import StdEnv
 import Data.Maybe
 import Data.Functor
 import Data.Func
+import Data.Tuple
+import Data.List
 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
+class get v ~st :: (v r w) .st -> .(Maybe r, .st) | TC r
+class put v ~st :: w (v r w) .st -> .(Maybe (), .st) | TC w
+
+:: SDS sds a :== sds a a
 
 :: Source r w = Source String
 :: St :== 'Data.Map'.Map String Dynamic
@@ -28,14 +28,15 @@ 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
+:: 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)
+	, left  :: sdsl r1 w1
+	, right :: sdsr r2 w2
 	}
+(>*<) infixl 6 :: (sdsl r1 w1) (sdsr r2 w2) -> Par sdsl sdsr (r1, r2) (w1, w2) | get sdsl St & put sdsr St & TC r1 & TC r2 & TC w1 & TC w2
+(>*<) l r = Par {read= \x y->Just (x, y), write=Just, left=l, right=r}
 
 instance get (Par sdsl sdsr) St | get sdsl St & get sdsr St
 where
@@ -47,14 +48,85 @@ 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)
+			Nothing = (Nothing, st)
+
+:: Lens sds r w = E.r1 w1: Lens (LensOpts sds r1 w1 r w) & TC r1 & TC w1
+:: LensOpts sds r1 w1 r w =
+	{ mapr :: r1   -> Maybe r
+	, mapw :: w r1 -> Maybe w1
+	, lens :: sds r1 w1
+	}
+
+instance get (Lens sds) St | get sds St
+where
+	get (Lens {mapr,lens}) st = appFst ((=<<) mapr) $ get lens st
+instance put (Lens sds) St | get sds St & put sds St
+where
+	put w (Lens {mapw,lens}) st
+		# (mv, st) = get lens st
+		= case mv of
+			Just r = case mapw w r of
+				Just w = put w lens st
+				Nothing = (Nothing, st)
+			Nothing = (Nothing, st)
+
+:: Select sdsl sdsr r w = E.r1 w1: Select (SelectOpts sdsl sdsr r1 w1 r w) & TC r1 & TC w1
+:: SelectOpts sdsl sdsr r1 w1 r w =
+	{ select :: sdsl r1 w1
+	, bind   :: r1 -> (sdsr r w)
+	}
+
+instance get (Select sdsl sdsr) St | get sdsl St & get sdsr St
+where
+	get (Select {select,bind}) st
+		= case get select st of
+			(Just r, st)  = get (bind r) st
+			(Nothing, st) = (Nothing, st)
+instance put (Select sdsl sdsr) St | get sdsl St & put sdsr St
+where
+	put w (Select {select,bind}) st
+		= case get select st of
+			(Just r, st) = put w (bind r) st
+			(Nothing, st) = (Nothing, st)
+
+mapRead :: (r -> r`) (sds r w) -> Lens sds r` w | TC r` & TC r & TC w
+mapRead f sds = Lens {mapr=Just o f, mapw=const o Just, lens=sds}
+(>?@) infixl 6
+(>?@) :== mapRead
+
+mapWrite :: (w` r -> Maybe w) (sds r w) -> Lens sds r w` | TC r & TC w & TC w`
+mapWrite f sds = Lens {mapr=Just, mapw=f, lens=sds}
+(>!@) infixl 6
+(>!@) :== mapWrite
+
+indexedStore :: Int (SDS sds [a]) -> SDS (Lens sds) a | TC a
+indexedStore idx sds
+	= Lens
+		{ mapr = \r->r !? idx
+		, mapw = \w->Just o updateAt idx w
+		, lens = sds
+		}
+
+indexedSelect :: (sdsl Int z) (SDS sdsr [a]) -> SDS (Select sdsl (Lens sdsr)) a | TC a & TC z
+indexedSelect l r = Select {select=l, bind=flip indexedStore r}
+
+keyedSelect :: (sdsl k z) (SDS sdsr ('Data.Map'.Map k v)) -> SDS (Select sdsl (Lens sdsr)) v | TC z & TC v & TC k & < k
+keyedSelect l r = Select {select=l, bind=flip keyedStore r}
+
+keyedStore :: k (SDS sds ('Data.Map'.Map k v)) -> SDS (Lens sds) v | TC v & TC k & < k
+keyedStore key sds
+	= Lens
+		{ mapr = 'Data.Map'.get key
+		, mapw = \r->Just o 'Data.Map'.put key r
+		, lens = sds
+		}
+
+Start = appSnd 'Data.Map'.toList
+	$ put (42, "blurp") (store "foo" >*< store "bar") 'Data.Map'.newMap
 
-Start :: (Maybe Int, .St)
-Start
-	# st = 'Data.Map'.newMap
-	# (Just _, st) = put 42 (Source "blurp") st
-	= get (Source "blurp") st
+store :: (String -> Source a a) | TC a
+store = Source
diff --git a/udynamic/test.icl b/udynamic/test.icl
new file mode 100644
index 0000000..b5e62cc
--- /dev/null
+++ b/udynamic/test.icl
@@ -0,0 +1,14 @@
+module test
+
+import StdArray
+
+someint :: *{Int}
+someint = {1,2,3}
+
+uid :: .a -> .a
+uid x = x
+
+toDyn :: *a -> *Dynamic
+toDyn a = dynamic a
+
+Start = toDyn someint