From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 18 Dec 2019 14:21:35 +0000 (+0100)
Subject: ushalow
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=e5305ee9d4290e1aa803a2e62a14f32e5cd29782;p=clean-tests.git

ushalow
---

diff --git a/expruniq/shallow.icl b/expruniq/shallow.icl
new file mode 100644
index 0000000..1d6f065
--- /dev/null
+++ b/expruniq/shallow.icl
@@ -0,0 +1,55 @@
+module shallow
+
+import StdEnv
+
+import Data.Array
+import Data.Maybe
+
+:: In a b = In infix 0 a b
+
+(<$>) infixl 4
+(<$>) f Nothing = Nothing
+(<$>) f (Just a) = Just (f a)
+
+pure a = Just a
+
+(<*>) infixl 4
+(<*>) Nothing _ = Nothing
+(<*>) (Just f) ma = f <$> ma
+
+(>>=) infixl 1
+(>>=) (Just x) k = k x
+(>>=) _ _ = Nothing
+
+var :: ((Maybe a) -> In a (Maybe b)) -> Maybe b
+var def = let (i In b) = def (pure i) in b
+
+lit :: .a -> Maybe .a
+lit a = pure a
+
+(+.) infixl 6 :: (Maybe a) (Maybe a) -> Maybe a | + a
+(+.) l r = (+) <$> l <*> r
+
+(++.) infixr 5 :: (Maybe (arr a)) (Maybe (arr a)) -> Maybe (arr a) | Array arr a
+(++.) l r = appendArr <$> l <*> r
+
+(!.) infixl 8 :: (Maybe (arr a)) (Maybe Int) -> Maybe a | Array arr a
+(!.) a i = a >>= \a->i >>= \i->if (i < 0 || i >= size a) Nothing (Just a.[i])
+
+(=.) infixl 9 :: (Maybe *(arr a)) (Maybe Int, Maybe a) -> (Maybe *(arr a)) | Array arr a
+(=.) a (i, e) = a >>= \a->i >>= \i->if (i < 0 || i >= size a) Nothing (update a i <$> e)
+
+//Start = both (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
+//Start = runPrinter (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
+Start =
+	( "\n"
+//	, var \v={!1,2,3} In v ++. v =. (lit 0, lit 42)
+	, "\n"
+	, var \v={!1,2,3} In v ++. lit {!4,5,6} =. (lit 0, lit 42)
+	, "\n"
+	, var \v={!1,2,3} In v ++. lit {!4,5,65}
+	, "\n"
+	, var \v={!1,2,3} In lit {!4,5,6} ++. v
+	, "\n"
+//	, runMaybe (var \up0=(\a->a =. (lit 0, lit 0)) In up0 (lit {!4,5,6}))
+	)
diff --git a/expruniq/uexpr.icl b/expruniq/uexpr.icl
index 72e3440..e4c5f39 100644
--- a/expruniq/uexpr.icl
+++ b/expruniq/uexpr.icl
@@ -20,13 +20,14 @@ class uexpr v where
 	lit :: a -> v a | toString a
 	(+.) infixl 6 :: (v a) (v a) -> v a | + a
 
-class uvar v where
-	var :: (u:(v .a) -> v:(In u:(v .a) u:(v b))) -> u:(v b), [v <= u]
+class uvar v w where
+	var :: (.(v .a) -> .(In .(v .a) (w b))) -> w b
 
 class uarr v where
-	arr :: *(arr a) -> v *(arr a) | Array arr a & toString a
-	(++.) infixr 5 :: (v .(arr a)) (v .(arr a)) -> v .(arr a) | Array arr a
-	(!.) infixl 9 :: (v .(arr a)) (v Int) -> v a | Array arr a
+	arr :: *(arr a) -> *v *(arr a) | Array arr a & toString a
+	(++.) infixr 5 :: *(v *(arr a)) *(v *(arr a)) -> *v *(arr a) | Array arr a
+	(!.)  infixl 8 :: .(v .(arr a)) .(v Int) -> .v a | Array arr a
+	(=.)  infixl 8 :: (v .(arr a)) (v Int, v a) -> (v .(arr a)) | Array arr a
 
 :: Printer a = P (WriterT [String] (StateT Int Identity) ())
 runPrinter (P a) = concat $ snd $ evalState (runWriterT a) 0
@@ -34,7 +35,7 @@ instance uexpr Printer where
 	lit a = P $ tell [toString a]
 	+. (P l) (P r) = P $ tell ["("] >>| l >>| tell ["+"] >>| r >>| tell [")"]
 
-instance uvar Printer where
+instance uvar Printer Printer where
 	var def = P (
 		        liftT (getState)
 		>>= \s->liftT (put (s+1))
@@ -47,30 +48,42 @@ instance uvar Printer where
 instance uarr Printer where
 	arr a = P $ tell ["{",join "," [toString a\\a<-:a],"}"]
 	++. (P l) (P r) = P $ tell ["("] >>| l >>| tell ["+++"] >>| r >>| tell [")"]
-	!. (P l) (P r) = P $ l >>| tell [".["] >>| r >>| tell ["]"]
+	!.  (P a) (P i) = P $ a >>| tell [".["] >>| i >>| tell ["]"]
+	=.  (P a) (P idx, P el) = P $ a >>| tell ["&"] >>| idx >>| tell ["="] >>| el
 
 :: Eval a = E a
 runEval (E a) = a
 instance uexpr Eval where
-	lit a = E $ pure a
+	lit a = E $ a
 	+. (E l) (E r) = E $ l + r
 
-//instance uvar Eval where
-//	var def = let (i In b) = def i in b
+instance uvar Eval Eval where
+	var def = let (i In b) = def i in b
 
 instance uarr Eval where
 	arr a = E a
 	++. (E l) (E r) = E (appendArr l r)
-	!. (E l) (E r) = E (select l r)
+	!.  (E a) (E i) = E (select a i)
+	=.  (E a) (E idx, E el) = undef//E (update a idx el)
 
-appendArr :: .(arr a) .(arr a) -> .arr a | Array arr a
-appendArr l r = {if (i < size l) l.[i] r.[i rem size l]\\i<-[0..size l + size r - 1]}
+runBoth (Both l r) = (runPrinter l, runEval r)
 
 //Start = both (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
-Start = runPrinter (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
-
-//both :: (A.v: v a | uexpr, uarr, uvar v) -> (String, a)
-//both f = (runPrinter f, runEval f)
+//Start = runPrinter (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
+Start =
+	( "\n"
+//	, runPrinter $ var \v=arr {!1,2,3} In v ++. v ?. lit 0 =. lit 42
+	, "\n"
+//	, runEval $ var \v=arr {!1,2,3} In v ++. v ?. lit 0 =. lit 42
+	, "\n"
+	, runPrinter $ var \v=arr {!1,2,3} In v ++. arr {!4,5,65}
+	, "\n"
+	, runPrinter $ var \v=arr {!1,2,3} In v ++. arr {!4,5,6}
+	, "\n"
+	, runEval $ var \v=arr {!1,2,3} In arr {!4,5,6} ++. v
+	, "\n"
+	, runPrinter $ var \v=arr {!1,2,3} In arr {!4,5,6} ++. v
+	)
 
 //i :: v Int | uexpr v
 //i = lit 41 +. lit 1