Commit b4a0e0c5 authored by Reg Huijben's avatar Reg Huijben

Changed simulator to use stmt

parent 0f66261b
......@@ -12,6 +12,7 @@ import iTasks => qualified return, >>=, >>|, sequence, forever, :: Set
*/
import Data.Functor, Control.Applicative, Control.Monad
import Data.Tuple
import Data.Either
import qualified Data.List as List
import qualified Data.Map as Map
......@@ -211,9 +212,9 @@ logiceval (||. l1 l2) =
logiceval l1 >>= \b1.
logiceval l2 >>= \b2. pure (b1 || b2)
stmteval :: Stmt -> Sem ()
stmteval (Expression expr) = eval expr >>= \e. pure ()
stmteval (Logical l) = logiceval l >>= \e. pure ()
stmteval :: Stmt -> Sem (Either Val Bool)
stmteval (Expression expr) = eval expr >>= \e. pure (Left e)
stmteval (Logical l) = logiceval l >>= \e. pure (Right e)
stmteval (If l st1 st2) = logiceval l >>= \e. if e
(stmteval st1)
(stmteval st2)
......@@ -242,9 +243,9 @@ stmteval (For id st stmt) = (eval st) >>= \st. case st of
foreval :: Ident [Int] Stmt -> Sem ()
foreval id [elem:es] stmt = (store id (I elem)) >>| (stmteval stmt) >>| (foreval id es stmt) >>| pure () //let (Sem z) = (store id (I elem)) in z
foreval id [] stmt = pure ()
foreval :: Ident [Int] Stmt -> Sem (Either Val Bool)
foreval id [elem:es] stmt = (store id (I elem)) >>| (stmteval stmt) >>| (foreval id es stmt) //let (Sem z) = (store id (I elem)) in z
foreval id [] stmt = pure (Left (SetA []))
//>>= \sf. sf
//foreval _ [] =
......@@ -353,7 +354,7 @@ astmt = For "a" aSet stt
//Start = let (Sem f) = (eval anotherexpr2) in f (State 'Map'.newMap)
Start = let (Sem f) = (stmteval astmt) in f (State 'Map'.newMap)
//Start = let (Sem f) = (stmteval astmt) in f (State 'Map'.newMap)
//f = 'Set'.toList ('Set'.fromList [1])
// res : ((Err "Cannot add int with set"),(State Tip))
......@@ -385,22 +386,22 @@ Start = let (Sem f) = (stmteval astmt) in f (State 'Map'.newMap)
//(res, stat) = (f (State 'Map'.newMap))
evl :: Expression State -> (Res Val,State)
evl e s = let (Sem f) = (eval e) in f s
evl :: Stmt State -> (Res (Either Val Bool),State)
evl e s = let (Sem f) = (stmteval e) in f s
//loopert s = enterInformation [] >>>= (\ex. let (res, stat) = (evl2 ex s) in (viewInformation [] res) >>>= (loopert stat) )
emptyState = State 'Map'.newMap
loopert :: State (Maybe (Res Val)) (Maybe Expression) -> Task String//(Expression)
loopert :: State (Maybe (Res (Either Val Bool))) (Maybe Stmt) -> Task String//(Expression)
//loopert s prv =( (Title "Edit" @>> enterInformation [] >>>= (\ex. let (res, stat) = (evl2 ex s) in (loopert stat (Just res)) ) )
loopert prev_state prev_res prev_expr = ( (Title "Edit" @>> enterInformation [] )
-|| (Title "Pretty print" @>> viewInformation [] case prev_expr of
(Just prev_expr) -> (print prev_expr)
loopert prev_state prev_res prev_stmt = ( (Title "Edit" @>> enterInformation [] )
-|| (Title "Pretty print" @>> viewInformation [] case prev_stmt of
(Just prev_stmt) -> (print prev_stmt)
Nothing -> "")
-|| (Title "Result" @>> viewInformation [] prev_res)
-|| (Title "Result state" @>> viewInformation [] prev_state)
)
>>* [ OnAction (Action "Add") (hasValue (\ex. let (res, stat) = (evl ex prev_state) in (loopert stat (Just res) (Just ex)) ))
, OnAction (Action "Reset state") (always ( (loopert emptyState prev_res prev_expr) ))
>>* [ OnAction (Action "Add") (hasValue (\stmt. let (res, stat) = (evl stmt prev_state) in (loopert stat (Just res) (Just stmt)) ))
, OnAction (Action "Reset state") (always ( (loopert emptyState prev_res prev_stmt) ))
, OnAction (Action "Quit") (always ( treturn "Goodbye"))
//, OnAction ActionCancel (always (return []))
]
......@@ -408,7 +409,7 @@ loopert prev_state prev_res prev_expr = ( (Title "Edit" @>> enterInformation []
//loopert s = enterInformation [] >>>= (\ex. let (res, stat) = (evl2 ex s) in (viewInformation [] res) )
//Start world = doTasks ((loopert emptyState Nothing Nothing ) >>>= \s. viewInformation [] s) world
Start world = doTasks ((loopert emptyState Nothing Nothing ) >>>= \s. viewInformation [] s) world
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment