a8/mart/skeleton8.icl

   1 module skeleton8
   2
   3 import StdList, StdInt, Data.Tuple, StdClass, iTasks._Framework.Generic, Text.JSON, Data.Functor, Control.Applicative, Control.Monad, Data.Void
   4 import qualified iTasks
   5 import qualified Text
   6 from Text import class Text, instance Text String
   7 from StdFunc import o
   8 from StdTuple import fst
   9 import qualified Data.Map as DM
  10 import Data.Either
  11 import qualified Data.List as List
  12
  13 :: Element :== Stmt Int
  14 :: Set :== Stmt [Int]
  15 :: Val = I Int | S [Int] | B Bool
  16 :: State :== Map String Val
  17 :: Sem a = Sem (State -> (Either String a, State))
  18 :: Stmt a = {v :: Sem a, p :: [String]}
  19
  20 :: THEN = THEN
  21 :: ELSE = ELSE
  22 :: DO = DO
  23
  24 instance Functor Sem where
  25         fmap :: (a -> b) (Sem a) -> Sem b
  26         fmap f (Sem s) = Sem \st.let (a, st`) = s st in (fmap f a, st`)
  27
  28 instance Applicative Sem where
  29         pure :: a -> Sem a
  30         pure s = Sem \st.(pure s, st)
  31         (<*>) infixl 4  :: (Sem (a -> b)) (Sem a) -> Sem b
  32         (<*>) a f = ap a f
  33
  34 instance Monad Sem where
  35         bind :: (Sem a) (a -> Sem b) -> Sem b
  36         bind (Sem s) f = Sem \st.case s st of
  37                 (Right v, st`) = let (Sem r) = f v in r st`
  38                 (Left e, st`) = (Left e, st`)
  39
  40 fail :: String -> Sem a
  41 fail s = Sem \st.(Left s,st)
  42
  43 instance + Element where
  44         (+) s1 s2 = {v=(+) <$> s1.v <*> s2.v, p=s1.p ++ ["+"] ++ s2.p}
  45 instance - Element where
  46         (-) s1 s2 = {v=(-) <$> s1.v <*> s2.v, p=s1.p ++ ["-"] ++ s2.p}
  47 instance * Element where
  48         (*) s1 s2 = {v=(*) <$> s1.v <*> s2.v, p=s1.p ++ ["*"] ++ s2.p}
  49
  50 integer :: Int -> Element
  51 integer i = {v=return i, p=[toString i]}
  52
  53 size :: Set -> Element
  54 size s = {v=length <$> s.v, p=["|":s.p++["|"]]}
  55
  56 new :: Set
  57 new = {v=return [], p=["∅"]}
  58
  59 insert :: Element Set -> Set
  60 insert e s = union {v=((\x.[x]) <$> e.v), p=["{":e.p++["}"]]} s
  61
  62 delete :: Element Set -> Set
  63 delete e s = difference {v=((\x.[x]) <$> e.v), p=["{":e.p++["}"]]} s
  64
  65 union :: Set Set -> Set
  66 union s1 s2 = {v='List'.union <$> s1.v <*> s2.v, p=s1.p++["∪":s2.p]}
  67
  68 difference :: Set Set -> Set
  69 difference s1 s2 = {v='List'.difference <$> s1.v <*> s2.v, p=s1.p++["\\":s2.p]}
  70
  71 intersection :: Set Set -> Set
  72 intersection s1 s2 = {v='List'.intersect <$> s1.v <*> s2.v, p=s1.p++["∩":s2.p]}
  73
  74 class variable a :: String -> a
  75
  76 instance variable Element where
  77         variable k = {v=Sem \st.case 'DM'.get k st of
  78                 (Just (I v)) = (Right v, st)
  79                 (Just _) = (Left "Wrong type, expected Int", st)
  80                 _ = (Left ("Variable '"+++ k +++ "' not found"), st), p=[k]}
  81
  82 instance variable Set where
  83         variable k = {v=Sem \st.case 'DM'.get k st of
  84                 (Just (S v)) = ((Right v), st)
  85                 (Just _) = (Left "Wrong type, expected Set", st)
  86                 _ = (Left ("Variable '" +++ k +++ "' not found"), st), p=[k]}
  87 class (=.) infix 2 a :: String a -> a
  88
  89 instance =. Element where
  90         (=.) k v = {v=Sem \st.let (Sem v`) = v.v in case v` st of
  91                 (Right v`, st) = (Right v`, 'DM'.put k (I v`) st)
  92                 (Left e, st) = (Left e, st), p=[k:[":=":v.p]]}
  93
  94 instance =. Set where
  95         (=.) k v = {v=Sem \st.let (Sem v`) = v.v in case v` st of
  96                 (Right v`, st) = (Right v`, 'DM'.put k (S v`) st)
  97                 (Left e, st) = (Left e, st), p=[k:[":=":v.p]]}
  98
  99 (:.) infixl 1 :: (Stmt a) (Stmt b) -> (Stmt b)
 100 (:.) s1 s2 = {v=s1.v >>| s2.v, p=s1.p ++ [";\n":s2.p]}
 101
 102 (==.) infix 4 :: (Stmt a) (Stmt a) -> (Stmt Bool) | == a
 103 (==.) s1 s2 = {v=(==) <$> s1.v <*> s2.v, p=s1.p++["==":s2.p]}
 104
 105 (<.) infix 4 :: (Stmt a) (Stmt a) -> (Stmt Bool) | < a
 106 (<.) s1 s2 = {v=(<) <$> s1.v <*> s2.v, p=s1.p++["<":s2.p]}
 107
 108 IF :: (Stmt Bool) THEN (Stmt a) ELSE (Stmt a) -> Stmt a
 109 IF c _ t _ e = {v=c.v >>= \c`.if c` t.v e.v,
 110                 p=["IF ":c.p]++[" THEN\n":t.p]++ ["\nELSE\n":e.p] ++ ["\nFI"]}
 111
 112 WHILE :: (Stmt Bool) DO (Stmt a) -> Stmt Int
 113 WHILE c _ b = {v=while c.v b.v, p=["WHILE ":c.p]++[" DO\n":b.p]++["\nOD"]}
 114         where
 115                 while c b = c >>= \c`.if c` (((+) 1) <$> (b >>| while c b)) (return 0)
 116
 117 eval e = let (Sem ev) = e.v in let (_, st) = ev 'DM'.newMap in 'DM'.toList st
 118 print e = 'Text'.concat e.p
 119
 120 Start = print expr10
 121 //Start = eval expr10
 122
 123 expr1 :: Element
 124 expr1 = integer 2
 125
 126 expr2 :: Element
 127 expr2 = expr1 + expr1
 128
 129 expr3 :: Element
 130 expr3 = expr1 + expr1 * integer 3
 131
 132 expr4 :: Set
 133 expr4 = union new (insert expr1 (insert expr3 new))
 134
 135 expr5 :: Set
 136 expr5 =
 137     x =. expr4 :.
 138     variable x
 139
 140 expr6 :: Element
 141 expr6 =
 142     x =. insert (integer 11) new :.
 143     x =. size (variable x) :.
 144     variable x
 145
 146 expr7 :: Set
 147 expr7 =
 148     x =. insert (integer 11) new :.
 149     y =. variable x
 150
 151 expr8 :: Set
 152 expr8 =
 153     x =. insert (integer 11) new :.
 154     x =. insert (size (variable x)) (variable x) :.
 155     variable x
 156
 157 expr9 :: Set
 158 expr9 =
 159     x =. insert (integer 0) new :.
 160     IF (size (variable x) ==. integer 0) THEN
 161         (x =. insert (integer 0) (variable x))
 162     ELSE
 163         (x =. delete (integer 0) (variable x)) :.
 164     variable x
 165
 166 expr10 :: Set
 167 expr10 =
 168         z =. integer 7 :.
 169         x =. new :.
 170         x =. insert (variable z) (variable x) :.
 171         y =. union (variable x) (variable x) :.
 172         WHILE (size (variable x) <. integer 5) DO
 173                 (x =. insert (size (variable x)) (variable x)) :.
 174         z =. difference (variable x) (intersection (variable x) (insert (variable z) new))
 175
 176 x = "x"
 177 y = "y"
 178 z = "z"