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
-:: 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
+:: Stmt a = {v :: Sem a, p :: [String]}\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
- 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
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
-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
+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
-integer i = return i\r
+integer i = {v=return i, p=[toString i]}\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
-new = return []\r
+new = {v=return [], p=["∅"]}\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
-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
-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
-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
-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
- 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
- _ = (Left "Variable not found", st)\r
+ _ = (Left ("Variable '"+++ k +++ "' not found"), st), p=[k]}\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
- _ = (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
- (=.) 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
- (=.) 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
-(:.) 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
-(==.) 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
-(<.) 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
-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
-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
-:: 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
-// examples\r
expr1 :: Element\r
expr1 = integer 2\r
\r
x = "x"\r
y = "y"\r
z = "z"\r
-\r
-Start = (eval expr10)\r
--- /dev/null
+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
repositories / ap2015.git / commitdiff