From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 20 Nov 2015 17:52:48 +0000 (+0100)
Subject: now with working gadt
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=a65d8161eb5a64838268edfd69484d3a665c93b0;p=ap2015.git

now with working gadt
---

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