all finished upto itask
authorMart Lubbers <mart@martlubbers.net>
Fri, 6 Nov 2015 14:43:16 +0000 (15:43 +0100)
committerMart Lubbers <mart@martlubbers.net>
Fri, 6 Nov 2015 14:43:16 +0000 (15:43 +0100)
a7/mart/skeleton7.icl

index 4d73431..43b58b2 100644 (file)
@@ -11,6 +11,8 @@ import Data.Tuple, StdClass, StdList, iTasks._Framework.Generic, Text.JSON,
        Data.Functor, Control.Applicative, Control.Monad, Data.Map, Data.Either
 import qualified iTasks
 import qualified Text
+import qualified Data.List as List
+import StdTuple
 from Text import class Text, instance Text String
 from StdFunc import o
 
@@ -36,11 +38,12 @@ e = Insert New (Oper New +. (Union (Integer 7) (Size (Integer 9))))
 
 
 // === State
-:: Val = Int Int | Set Set
+:: Val = Int Int | Set [Int]
 :: State :== Map String Val
 
 :: Sem a = Sem (State -> (Either String a, State)) 
 
+// === semantics
 unsem :: (Sem a) -> (State -> (Either String a, State))
 unsem (Sem a) = a
 
@@ -67,10 +70,70 @@ read i = Sem \st.case get i st of
 fail :: String -> Sem a
 fail s = Sem \st.(Left s,st)
 
-// === semantics
-
+expectInt :: Expression String -> Sem Int
+expectInt e m = eval e >>= \r.case r of
+       (Int i) = return i
+       _ = fail (m +++ " argument has to be an Int")
+
+expectSet :: Expression String -> Sem [Int]
+expectSet e m = eval e >>= \r.case r of
+       (Set i) = return i
+       _ = fail (m +++ " argument has to be a Set")
+
+instance toString Op where
+       toString (+.) = "+"
+       toString (-.) = "-"
+       toString (*.) = "*"
+
+eval :: Expression -> Sem Val
+eval New = return (Set [])
+eval (Insert e s) = expectInt e "Insert, 1st" 
+       >>= \e.expectSet s "Insert, 2nd" 
+       >>= \s.return (Set [e:s])
+eval (Delete e s) = expectInt e "Delete, 1st"
+       >>= \e.expectSet s "Delete, 2nd"
+       >>= \s.return (Set ('List'.delete e s))
+eval (Variable e) = read e
+eval (Union s1 s2) = expectSet s1 "Union, 1st"
+       >>= \s1.expectSet s2 "Union, 2nd"
+       >>= \s2.return (Set ('List'.union s1 s2))
+eval (Difference s1 s2) = expectSet s1 "Difference, 1st"
+       >>= \s1.expectSet s2 "Difference, 2nd"
+       >>= \s2.return (Set ('List'.difference s1 s2))
+eval (Intersection s1 s2) = expectSet s1 "Intersection, 1st"
+       >>= \s1.expectSet s2 "Intersection, 2nd"
+       >>= \s2.return (Set ('List'.intersect s1 s2))
+eval (Integer i) = return (Int i)
+eval (Size s) = expectSet e "Size, 1st" >>= \e.return (Int (length e))
+eval (Oper e1 o e2) = expectInt e1 (toString o +++ ", 1st")
+       >>= \e1.expectInt e2 (toString o +++ ", 2nd")
+       >>= \e2.case o of
+               (+.) = return (Int (e1+e2))
+               (-.) = return (Int (e1-e2))
+               (*.) = return (Int (e1*e2))
+eval (i =. e) = eval e >>= \e.store i e
+
+evalExpr :: Expression State -> Either String Val
+evalExpr e s = fst (unsem (eval e) s)
+
+print :: Expression -> String
+print e = 'Text'.concat (print` e [])
+
+print` :: Expression [String] -> [String]
+print` New l = ["Ø":l]
+print` (Insert e s) l = ["{":print` e ["}∪":print` s l]]
+print` (Delete e s) l = ["(":print` s [")\\{":print` e ["}":l]]]
+print` (Variable e) l = [e:l]
+print` (Union s1 s2) l = ["(":print` s1 [")∪(":print` s2 [")":l]]]
+print` (Difference s1 s2) l = ["(":print` s1 [")∆(":print` s2 [")":l]]]
+print` (Intersection s1 s2) l = ["(":print` s1 [")∩(":print` s2 [")":l]]]
+print` (Integer i) l = [toString i: l]
+print` (Size s) l = ["|":print` s ["|":l]]
+print` (Oper e1 o e2) l = ["(":print` e1 [")",toString o,"(":print` e2 [")":l]]]
+print` (i =. e) l = [i,"=":print` e l++["\n"]]
 
 // === simulation
+
 (>>>=) :== 'iTasks'.tbind
 (>>>|) a b :== 'iTasks'.tbind a (\_ -> b)
 treturn :== 'iTasks'.return
@@ -78,4 +141,6 @@ ActionOk :== 'iTasks'.ActionOk
 ActionQuit :== 'iTasks'.ActionQuit
 ActionNew :== 'iTasks'.ActionNew
 
-Start = Void
+//Start = print (Delete (Integer 4) (Insert (Integer 5) New))
+//Start = print 
+Start = print (Insert (Size (Insert (Oper (Integer 5) +. (Integer 6)) New)) New)