now with working gadt

diff --git a/a9/mart/skeleton9.icl b/a9/mart/skeleton9.icl
index 9230c3a..4d283ed 100644 (file)
--- a/a9/mart/skeleton9.icl
+++ b/a9/mart/skeleton9.icl
@@ -9,7 +9,7 @@ from iTasks import always, hasValue, :: TaskValue(..), :: Task, :: Stability,
        instance TFunctor Task, class TApplicative, instance TApplicative Task,\r
        instance Publishable Task, Void\r
 import Data.Tuple, StdClass, StdList, iTasks._Framework.Generic, Text.JSON,\r
-       Data.Functor, Control.Applicative, Control.Monad, Data.Map\r
+       Data.Functor, Control.Applicative, Control.Monad, Data.Map, StdMisc\r
 import qualified iTasks\r
 import qualified Text\r
 from Text import class Text, instance Text String\r
@@ -73,8 +73,7 @@ instance show (Expr a) | show a where
 \r
 // === State\r
 :: Ident :== String\r
-:: Val = I Int | S [Int]\r
-:: State :== Map Ident Val\r
+:: State :== Map Ident Dynamic\r
 :: Sem a = Sem (State -> (MaybeEx a, State))\r
 :: MaybeEx a = Result a | Exception String\r
 \r
@@ -125,47 +124,44 @@ instance Monad Sem where
 fail :: String -> Sem a\r
 fail msg = Sem \st.(Exception msg, st)\r
 \r
-store :: Ident Val -> Sem Val\r
-store i v = Sem \st.(Result v, put i v st)\r
+store :: Ident a -> Sem a | TC a\r
+store i v = Sem \st.(Result v, put i (dynamic v) st)\r
 \r
-read :: Ident -> Sem Val\r
-read i = Sem \st.(maybe (Exception (i +++ " not found")) Result (get i st), st)\r
-\r
-(>>.) infixl 1 :: (Sem Val) (Int -> Sem Val) -> Sem Val\r
-(>>.) f g = f >>= \x.case x of\r
-       I i = g i\r
-       S s = fail ("Element expected instead of set")\r
-\r
-(>>..) infixl 1 :: (Sem Val) ([Int] -> Sem Val) -> Sem Val\r
-(>>..) f g = f >>= \x.case x of\r
-       S s = g s\r
-       I i = fail ("Set expected instead of element " +++ toString i)\r
+read :: Ident -> Sem a | TC a\r
+read i = Sem \st.case get i st of\r
+       Just (a :: a^) = (Result a, st)\r
+       Just d = (Exception ('Text'.concat ["expected ", toString expType, " got ",\r
+               toString (typeCodeOfDynamic d)]), st)\r
+       Nothing = (Exception "No variable with that name", st)\r
+where\r
+       expType = typeCodeOfDynamic (dynamic undef :: a^)\r
 \r
 // === semantics\r
-eval :: (Expr a) -> Sem Val\r
-eval (New _) = return (S [])\r
-eval (Insert _ e s) = eval e >>. \a.eval s >>..\r
-       \x.return (S ('List'.union [a] x))\r
-eval (Delete _ e s) = eval e >>. \a.eval s >>..\r
-       \x.return (S ('List'.delete a x))\r
-eval (Variable _ i) = read i\r
-eval (Assign _ v e) = eval e >>= store v\r
-eval (Union _ s1 s2) = eval s1 >>.. \x.eval s2\r
-       >>.. \y.return (S ('List'.union x y))\r
-eval (Difference _ s1 s2) = eval s1 >>.. \x.eval s2\r
-       >>.. \y.return (S ('List'.difference x y))\r
-eval (Intersection _ s1 s2) = eval s1 >>.. \x.eval s2 \r
-       >>.. \y.return (S ('List'.intersect x y))\r
-eval (Integer _ i) = return (I i)\r
-eval (Size _ s) = eval s >>.. \x.return (I (length x))\r
-eval (Oper _ e1 o e2) = eval e1 >>. \a.eval e2 >>. \b.return (I (case o of\r
+eval :: (Expr a) -> Sem a | TC a\r
+eval (New {f}) = return (f [])\r
+eval (Variable {f} i) = read i\r
+eval (Assign {f} v e) = eval e >>= \a.store v a\r
+eval (Insert {f} e s) = eval e >>= \a.eval s \r
+       >>= \x.return (f ('List'.union [a] x))\r
+eval (Delete {f} e s) = eval e >>= \a.eval s\r
+       >>= \x.return (f ('List'.delete a x))\r
+eval (Union {f} s1 s2) = eval s1 >>= \x.eval s2\r
+       >>= \y.return (f ('List'.union x y))\r
+eval (Difference {f} s1 s2) = eval s1 >>= \x.eval s2\r
+       >>= \y.return (f ('List'.difference x y))\r
+eval (Intersection {f} s1 s2) = eval s1 >>= \x.eval s2 \r
+       >>= \y.return (f ('List'.intersect x y))\r
+eval (Integer {f} i) = return (f i)\r
+eval (Size {f} s) = eval s >>= \x.return (f (length x))\r
+eval (Oper {f} e1 o e2) = eval e1 >>= \a.eval e2 >>= \b.return (f (case o of\r
        Pl = a+b\r
        Mi = a-b\r
        Ti = a*b))\r
 \r
-evalExpr :: (Expr a) State -> (MaybeEx Val, State)\r
+evalExpr :: (Expr a) State -> (MaybeEx a, State) | TC a\r
 evalExpr expr st = let (Sem func) = eval expr in func st\r
 \r
-Start = evalExpr (size (variable "x")) st\r
+Start :: (MaybeEx Int, State)\r
+Start = evalExpr (size (variable "x")) state\r
        where\r
-               (_, st) = evalExpr ("x" =. size (insert (integer 42) new)) newMap\r
+               (_, state) = evalExpr ("x" =. (insert (integer 42) new)) newMap\r