a8 done

diff --git a/a8/mart/skeleton8.icl b/a8/mart/skeleton8.icl
index 3ba9d63..1d0e15f 100644 (file)
--- a/a8/mart/skeleton8.icl
+++ b/a8/mart/skeleton8.icl
@@ -6,22 +6,24 @@ import qualified Text
 from Text import class Text, instance Text String\r
 from StdFunc import o\r
 from StdTuple import fst\r
 from Text import class Text, instance Text String\r
 from StdFunc import o\r
 from StdTuple import fst\r

-from Data.Map import :: Map, put, get, newMap\r
+import qualified Data.Map as DM\r

 import Data.Either\r
 import qualified Data.List as List\r
 \r
 import Data.Either\r
 import qualified Data.List as List\r
 \r

-:: Element :== Sem Int\r
-:: Set :== Sem [Int]\r
+:: Element :== Stmt Int\r
+:: Set :== Stmt [Int]\r

 :: Val = I Int | S [Int] | B Bool\r
 :: State :== Map String Val\r
 :: Sem a = Sem (State -> (Either String a, State)) \r
 :: Val = I Int | S [Int] | B Bool\r
 :: State :== Map String Val\r
 :: Sem a = Sem (State -> (Either String a, State)) \r

+:: Stmt a = {v :: Sem a, p :: [String]}\r

 \r
 \r

-unsem :: (Sem a) -> (State -> (Either String a, State))\r
-unsem (Sem a) = a\r
+:: THEN = THEN\r
+:: ELSE = ELSE\r
+:: DO = DO\r

 \r
 instance Functor Sem where\r
        fmap :: (a -> b) (Sem a) -> Sem b\r
 \r
 instance Functor Sem where\r
        fmap :: (a -> b) (Sem a) -> Sem b\r

-       fmap f s = Sem \st.let (a, st`) = unsem s st in (fmap f a, st`)\r
+       fmap f (Sem s) = Sem \st.let (a, st`) = s st in (fmap f a, st`)\r

 \r
 instance Applicative Sem where\r
        pure :: a -> Sem a\r
 \r
 instance Applicative Sem where\r
        pure :: a -> Sem a\r


@@ -32,108 +34,92 @@ instance Applicative Sem where
 instance Monad Sem where\r
        bind :: (Sem a) (a -> Sem b) -> Sem b\r
        bind (Sem s) f = Sem \st.case s st of\r
 instance Monad Sem where\r
        bind :: (Sem a) (a -> Sem b) -> Sem b\r
        bind (Sem s) f = Sem \st.case s st of\r

-               (Right v, st`) = unsem (f v) st`\r
+               (Right v, st`) = let (Sem r) = f v in r st`\r

                (Left e, st`) = (Left e, st`)\r
 \r
                (Left e, st`) = (Left e, st`)\r
 \r

-store :: String Val -> Sem Val\r
-store i v = Sem \st.(pure v, put i v st)\r
-\r
-read :: String -> Sem Val\r
-read i = Sem \st.case get i st of\r
-               (Just v) = (Right v, st)\r
-               _ = unsem (fail "variable not found") st\r
-\r

 fail :: String -> Sem a\r
 fail s = Sem \st.(Left s,st)\r
 \r
 fail :: String -> Sem a\r
 fail s = Sem \st.(Left s,st)\r
 \r

-instance + Element where (+) s1 s2 = fmap (+) s1 <*> s2\r
-instance - Element where (-) s1 s2 = fmap (-) s1 <*> s2\r
-instance * Element where (*) s1 s2 = fmap (*) s1 <*> s2\r
+instance + Element where \r
+       (+) s1 s2 = {v=(+) <$> s1.v <*> s2.v, p=s1.p ++ ["+"] ++ s2.p}\r
+instance - Element where\r
+       (-) s1 s2 = {v=(-) <$> s1.v <*> s2.v, p=s1.p ++ ["-"] ++ s2.p}\r
+instance * Element where\r
+       (*) s1 s2 = {v=(*) <$> s1.v <*> s2.v, p=s1.p ++ ["*"] ++ s2.p}\r

 \r
 integer :: Int -> Element\r
 \r
 integer :: Int -> Element\r

-integer i = return i\r
+integer i = {v=return i, p=[toString i]}\r

 \r
 size :: Set -> Element\r
 \r
 size :: Set -> Element\r

-size s = fmap length s\r
+size s = {v=length <$> s.v, p=["|":s.p++["|"]]}\r

 \r
 new :: Set\r
 \r
 new :: Set\r

-new = return []\r
+new = {v=return [], p=["∅"]}\r

 \r
 insert :: Element Set -> Set\r
 \r
 insert :: Element Set -> Set\r

-insert e s = union (fmap (\x.[x]) e) s\r
+insert e s = union {v=((\x.[x]) <$> e.v), p=["{":e.p++["}"]]} s\r

 \r
 delete :: Element Set -> Set\r
 \r
 delete :: Element Set -> Set\r

-delete e s = difference (fmap (\x.[x]) e) s\r
+delete e s = difference {v=((\x.[x]) <$> e.v), p=["{":e.p++["}"]]} s\r

 \r
 union :: Set Set -> Set\r
 \r
 union :: Set Set -> Set\r

-union s1 s2 = fmap 'List'.union s1 <*> s2\r
+union s1 s2 = {v='List'.union <$> s1.v <*> s2.v, p=s1.p++["∪":s2.p]}\r

 \r
 difference :: Set Set -> Set\r
 \r
 difference :: Set Set -> Set\r

-difference s1 s2 = fmap 'List'.difference s1 <*> s2\r
+difference s1 s2 = {v='List'.difference <$> s1.v <*> s2.v, p=s1.p++["\\":s2.p]}\r

 \r
 intersection :: Set Set -> Set\r
 \r
 intersection :: Set Set -> Set\r

-intersection s1 s2 = fmap 'List'.intersect s1 <*> s2\r
-\r
-class eval a :: (Sem a) -> (Either String a, State)\r
-\r
-instance eval Element where\r
-       eval (Sem e) = e newMap\r
-\r
-instance eval Set where\r
-       eval (Sem s) = s newMap\r
-\r
-instance eval Int where\r
-       eval (Sem s) = s newMap\r
-\r
-instance eval [Int] where\r
-       eval (Sem s) = s newMap\r
+intersection s1 s2 = {v='List'.intersect <$> s1.v <*> s2.v, p=s1.p++["∩":s2.p]}\r

 \r
 class variable a :: String -> a\r
 \r
 instance variable Element where\r
 \r
 class variable a :: String -> a\r
 \r
 instance variable Element where\r

-       variable k = Sem \st.case get k st of\r
+       variable k = {v=Sem \st.case 'DM'.get k st of\r

                (Just (I v)) = (Right v, st)\r
                (Just _) = (Left "Wrong type, expected Int", st)\r
                (Just (I v)) = (Right v, st)\r
                (Just _) = (Left "Wrong type, expected Int", st)\r

-               _ = (Left "Variable not found", st)\r
+               _ = (Left ("Variable '"+++ k +++ "' not found"), st), p=[k]}\r

 \r
 instance variable Set where\r
 \r
 instance variable Set where\r

-       variable k = Sem \st.case get k st of\r
+       variable k = {v=Sem \st.case 'DM'.get k st of\r

                (Just (S v)) = ((Right v), st)\r
                (Just _) = (Left "Wrong type, expected Set", st)\r
                (Just (S v)) = ((Right v), st)\r
                (Just _) = (Left "Wrong type, expected Set", st)\r

-               _ = (Left "Variable not found", st)\r
-\r
+               _ = (Left ("Variable '" +++ k +++ "' not found"), st), p=[k]}\r

 class (=.) infix 2 a :: String a -> a\r
 \r
 instance =. Element where\r
 class (=.) infix 2 a :: String a -> a\r
 \r
 instance =. Element where\r

-       (=.) k (Sem v) = Sem \st.case v st of\r
-               (Right v, st) = (Right v, put k (I v) st)\r
-               (Left e, st) = (Left e, st)\r
+       (=.) k v = {v=Sem \st.let (Sem v`) = v.v in case v` st of\r
+               (Right v`, st) = (Right v`, 'DM'.put k (I v`) st)\r
+               (Left e, st) = (Left e, st), p=[k:[":=":v.p]]}\r

 \r
 instance =. Set where\r
 \r
 instance =. Set where\r

-       (=.) k (Sem v) = Sem \st.case v st of\r
-               (Right v, st) = (Right v, put k (S v) st)\r
-               (Left e, st) = (Left e, st)\r
+       (=.) k v = {v=Sem \st.let (Sem v`) = v.v in case v` st of\r
+               (Right v`, st) = (Right v`, 'DM'.put k (S v`) st)\r
+               (Left e, st) = (Left e, st), p=[k:[":=":v.p]]}\r

 \r
 \r

-(:.) infixl 1 :: (Sem a) (Sem b) -> (Sem b)\r
-(:.) s1 s2 = s1 >>| s2\r
+(:.) infixl 1 :: (Stmt a) (Stmt b) -> (Stmt b)\r
+(:.) s1 s2 = {v=s1.v >>| s2.v, p=s1.p ++ [";\n":s2.p]}\r

 \r
 \r

-(==.) infix 4 :: (Sem a) (Sem a) -> (Sem Bool) | == a\r
-(==.) s1 s2 = fmap (==) s1 <*> s2\r
+(==.) infix 4 :: (Stmt a) (Stmt a) -> (Stmt Bool) | == a\r
+(==.) s1 s2 = {v=(==) <$> s1.v <*> s2.v, p=s1.p++["==":s2.p]}\r

 \r
 \r

-(<.) infix 4 :: (Sem a) (Sem a) -> (Sem Bool) | < a\r
-(<.) s1 s2 = fmap (<) s1 <*> s2\r
+(<.) infix 4 :: (Stmt a) (Stmt a) -> (Stmt Bool) | < a\r
+(<.) s1 s2 = {v=(<) <$> s1.v <*> s2.v, p=s1.p++["<":s2.p]}\r

 \r
 \r

-IF :: (Sem Bool) THEN (Sem a) ELSE (Sem a) -> Sem a\r
-IF c _ t _ e = c >>= \c.if c t e\r
+IF :: (Stmt Bool) THEN (Stmt a) ELSE (Stmt a) -> Stmt a\r
+IF c _ t _ e = {v=c.v >>= \c`.if c` t.v e.v,\r
+               p=["IF ":c.p]++[" THEN\n":t.p]++ ["\nELSE\n":e.p] ++ ["\nFI"]}\r

 \r
 \r

-WHILE :: (Sem Bool) DO (Sem a) -> Sem Int\r
-WHILE c _ b = c >>= \c`.if c` (fmap ((+) 1) (b >>| WHILE c DO b)) (return 0)\r
+WHILE :: (Stmt Bool) DO (Stmt a) -> Stmt Int\r
+WHILE c _ b = {v=while c.v b.v, p=["WHILE ":c.p]++[" DO\n":b.p]++["\nOD"]}\r
+       where\r
+               while c b = c >>= \c`.if c` (((+) 1) <$> (b >>| while c b)) (return 0)\r

 \r
 \r

-:: THEN = THEN\r
-:: ELSE = ELSE\r
-:: DO = DO\r
+eval e = let (Sem ev) = e.v in let (_, st) = ev 'DM'.newMap in 'DM'.toList st\r
+print e = 'Text'.concat e.p\r
+\r
+Start = print expr10\r
+//Start = eval expr10\r

 \r
 \r

-// examples\r

 expr1 :: Element\r
 expr1 = integer 2\r
 \r
 expr1 :: Element\r
 expr1 = integer 2\r
 \r


@@ -190,5 +176,3 @@ expr10 =
 x = "x"\r
 y = "y"\r
 z = "z"\r
 x = "x"\r
 y = "y"\r
 z = "z"\r

-\r
-Start = (eval expr10)\r

diff --git a/a8/mart/skeleton8_without_printing.icl b/a8/mart/skeleton8_without_printing.icl
new file mode 100644 (file)
index 0000000..7496c12
--- /dev/null
+++ b/a8/mart/skeleton8_without_printing.icl
@@ -0,0 +1,183 @@
+module skeleton8\r
+\r
+import StdList, StdInt, Data.Tuple, StdClass, iTasks._Framework.Generic, Text.JSON, Data.Functor, Control.Applicative, Control.Monad, Data.Void\r
+import qualified iTasks\r
+import qualified Text\r
+from Text import class Text, instance Text String\r
+from StdFunc import o\r
+from StdTuple import fst\r
+from Data.Map import :: Map, put, get, newMap\r
+import Data.Either\r
+import qualified Data.List as List\r
+\r
+:: Element :== Sem Int\r
+:: Set :== Sem [Int]\r
+:: Val = I Int | S [Int] | B Bool\r
+:: State :== Map String Val\r
+:: Sem a = Sem (State -> (Either String a, State)) \r
+\r
+instance Functor Sem where\r
+       fmap :: (a -> b) (Sem a) -> Sem b\r
+       fmap f (Sem s) = Sem \st.let (a, st`) = s st in (fmap f a, st`)\r
+\r
+instance Applicative Sem where\r
+       pure :: a -> Sem a\r
+       pure s = Sem \st.(pure s, st)\r
+       (<*>) infixl 4  :: (Sem (a -> b)) (Sem a) -> Sem b\r
+       (<*>) a f = ap a f\r
+\r
+instance Monad Sem where\r
+       bind :: (Sem a) (a -> Sem b) -> Sem b\r
+       bind (Sem s) f = Sem \st.case s st of\r
+               (Right v, st`) = let (Sem r) = f v in r st`\r
+               (Left e, st`) = (Left e, st`)\r
+\r
+fail :: String -> Sem a\r
+fail s = Sem \st.(Left s,st)\r
+\r
+instance + Element where (+) s1 s2 = (+) <$> s1 <*> s2\r
+instance - Element where (-) s1 s2 = (-) <$> s1 <*> s2\r
+instance * Element where (*) s1 s2 = (*) <$> s1 <*> s2\r
+\r
+integer :: Int -> Element\r
+integer i = return i\r
+\r
+size :: Set -> Element\r
+size s = length <$> s\r
+\r
+new :: Set\r
+new = return []\r
+\r
+insert :: Element Set -> Set\r
+insert e s = union ((\x.[x]) <$> e) s\r
+\r
+delete :: Element Set -> Set\r
+delete e s = difference ((\x.[x]) <$> e) s\r
+\r
+union :: Set Set -> Set\r
+union s1 s2 = fmap 'List'.union s1 <*> s2\r
+\r
+difference :: Set Set -> Set\r
+difference s1 s2 = fmap 'List'.difference s1 <*> s2\r
+\r
+intersection :: Set Set -> Set\r
+intersection s1 s2 = fmap 'List'.intersect s1 <*> s2\r
+\r
+class eval a :: (Sem a) -> (Either String a, State)\r
+\r
+instance eval Element where\r
+       eval (Sem e) = e newMap\r
+\r
+instance eval Set where\r
+       eval (Sem s) = s newMap\r
+\r
+instance eval Int where\r
+       eval (Sem s) = s newMap\r
+\r
+instance eval [Int] where\r
+       eval (Sem s) = s newMap\r
+\r
+class variable a :: String -> a\r
+\r
+instance variable Element where\r
+       variable k = Sem \st.case get k st of\r
+               (Just (I v)) = (Right v, st)\r
+               (Just _) = (Left "Wrong type, expected Int", st)\r
+               _ = (Left "Variable not found", st)\r
+\r
+instance variable Set where\r
+       variable k = Sem \st.case get k st of\r
+               (Just (S v)) = ((Right v), st)\r
+               (Just _) = (Left "Wrong type, expected Set", st)\r
+               _ = (Left "Variable not found", st)\r
+\r
+class (=.) infix 2 a :: String a -> a\r
+\r
+instance =. Element where\r
+       (=.) k (Sem v) = Sem \st.case v st of\r
+               (Right v, st) = (Right v, put k (I v) st)\r
+               (Left e, st) = (Left e, st)\r
+\r
+instance =. Set where\r
+       (=.) k (Sem v) = Sem \st.case v st of\r
+               (Right v, st) = (Right v, put k (S v) st)\r
+               (Left e, st) = (Left e, st)\r
+\r
+(:.) infixl 1 :: (Sem a) (Sem b) -> (Sem b)\r
+(:.) s1 s2 = s1 >>| s2\r
+\r
+(==.) infix 4 :: (Sem a) (Sem a) -> (Sem Bool) | == a\r
+(==.) s1 s2 = fmap (==) s1 <*> s2\r
+\r
+(<.) infix 4 :: (Sem a) (Sem a) -> (Sem Bool) | < a\r
+(<.) s1 s2 = fmap (<) s1 <*> s2\r
+\r
+IF :: (Sem Bool) THEN (Sem a) ELSE (Sem a) -> Sem a\r
+IF c _ t _ e = c >>= \c.if c t e\r
+\r
+WHILE :: (Sem Bool) DO (Sem a) -> Sem Int\r
+WHILE c _ b = c >>= \c`.if c` (fmap ((+) 1) (b >>| WHILE c DO b)) (return 0)\r
+\r
+:: THEN = THEN\r
+:: ELSE = ELSE\r
+:: DO = DO\r
+\r
+// examples\r
+expr1 :: Element\r
+expr1 = integer 2\r
+\r
+expr2 :: Element\r
+expr2 = expr1 + expr1\r
+\r
+expr3 :: Element\r
+expr3 = expr1 + expr1 * integer 3\r
+\r
+expr4 :: Set\r
+expr4 = union new (insert expr1 (insert expr3 new))\r
+\r
+expr5 :: Set\r
+expr5 =\r
+    x =. expr4 :.\r
+    variable x\r
+\r
+expr6 :: Element\r
+expr6 =\r
+    x =. insert (integer 11) new :.\r
+    x =. size (variable x) :.\r
+    variable x\r
+\r
+expr7 :: Set\r
+expr7 =\r
+    x =. insert (integer 11) new :.\r
+    y =. variable x\r
+\r
+expr8 :: Set\r
+expr8 =\r
+    x =. insert (integer 11) new :.\r
+    x =. insert (size (variable x)) (variable x) :.\r
+    variable x\r
+\r
+expr9 :: Set\r
+expr9 =\r
+    x =. insert (integer 0) new :.\r
+    IF (size (variable x) ==. integer 0) THEN\r
+        (x =. insert (integer 0) (variable x))\r
+    ELSE\r
+        (x =. delete (integer 0) (variable x)) :.\r
+    variable x\r
+\r
+expr10 :: Set\r
+expr10 =\r
+       z =. integer 7 :.\r
+       x =. new :.\r
+       x =. insert (variable z) (variable x) :.\r
+       y =. union (variable x) (variable x) :.\r
+       WHILE (size (variable x) <. integer 5) DO\r
+               (x =. insert (size (variable x)) (variable x)) :.\r
+       z =. difference (variable x) (intersection (variable x) (insert (variable z) new))\r
+\r
+x = "x"\r
+y = "y"\r
+z = "z"\r
+\r
+Start = expr10\r