alles tot printen klaar

diff --git a/a8/mart/skeleton8.icl b/a8/mart/skeleton8.icl
index ea9960d..3ba9d63 100644 (file)
--- a/a8/mart/skeleton8.icl
+++ b/a8/mart/skeleton8.icl
@@ -7,12 +7,134 @@ from Text import class Text, instance Text String
 from StdFunc import o\r
 from StdTuple import fst\r
 from Data.Map import :: Map, put, get, newMap\r
-from Data.List import union, removeMember, instance Functor []\r
+import Data.Either\r
 import qualified Data.List as List\r
 \r
-// examples\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
+unsem :: (Sem a) -> (State -> (Either String a, State))\r
+unsem (Sem a) = a\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
+\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`) = unsem (f v) st`\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
+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
+\r
+integer :: Int -> Element\r
+integer i = return i\r
+\r
+size :: Set -> Element\r
+size s = fmap length s\r
+\r
+new :: Set\r
+new = return []\r
+\r
+insert :: Element Set -> Set\r
+insert e s = union (fmap (\x.[x]) e) s\r
+\r
+delete :: Element Set -> Set\r
+delete e s = difference (fmap (\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
-/*expr1 :: Element\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
@@ -22,7 +144,7 @@ expr3 :: Element
 expr3 = expr1 + expr1 * integer 3\r
 \r
 expr4 :: Set\r
-expr4 = insert expr3 new\r
+expr4 = union new (insert expr1 (insert expr3 new))\r
 \r
 expr5 :: Set\r
 expr5 =\r
@@ -67,6 +189,6 @@ expr10 =
 \r
 x = "x"\r
 y = "y"\r
-z = "z"*/\r
-        \r
-Start = "implement 'eval' function"//eval expr1\r
+z = "z"\r
+\r
+Start = (eval expr10)\r