ushalow

diff --git a/expruniq/shallow.icl b/expruniq/shallow.icl
new file mode 100644 (file)
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 (file)
--- 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