added gracefull shutdown

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 95c549e..e05d61b 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -99,7 +99,9 @@ viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask
                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 
 deleteDevice :: MTaskDevice -> Task ()
-deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d)
+deleteDevice d = sendMessages [MTShutdown] d
+       >>| wait "Waiting for the channels to empty" (\(r,s,ss)->isEmpty s) (channels d)
+       >>| upd (\(r,s,ss)->(r,s,True)) (channels d)
        >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask
        >>| upd (filter ((<>)d)) deviceStore
        >>| cleanSharesDevice d.deviceName

diff --git a/Tasks/Examples.dcl b/Tasks/Examples.dcl
index bf962cd..57f0c85 100644 (file)
--- a/Tasks/Examples.dcl
+++ b/Tasks/Examples.dcl
@@ -3,6 +3,8 @@ definition module Tasks.Examples
 from Data.Map import :: Map
 import mTask
 
+faculty :: Int -> Main (ByteCode () Stmt)
+countTo5 :: Main (ByteCode () Stmt)
 countAndLed :: Main (ByteCode () Stmt)
 blink :: UserLED -> Main (ByteCode () Stmt)
 count :: Main (ByteCode () Stmt)

diff --git a/Tasks/Examples.icl b/Tasks/Examples.icl
index 78b0d67..2e2a973 100644 (file)
--- a/Tasks/Examples.icl
+++ b/Tasks/Examples.icl
@@ -6,12 +6,21 @@ import mTask
 import Devices.mTaskDevice
 import iTasks._Framework.Serialization
 
+faculty :: Int -> Main (ByteCode () Stmt)
+faculty i = sds \y=i In sds \x=1 In {main =
+       IF (y <=. lit 1) (
+               pub x :. retrn
+       ) (
+               x =. x *. y :.
+               y =. y -. lit 1
+       )}
+
 countTo5 :: Main (ByteCode () Stmt)
 countTo5 = sds \x=0 In {main =
        x =. x +. lit 1 :.
        pub x :.
        IF ( x >. lit 5) (
-               retrn x
+               retrn
        ) (
                noOp
        )}
@@ -78,4 +87,5 @@ allmTasks = 'DM'.fromList
        ,("blinkShare", treturn blinkShare)
        ,("count", treturn count)
        ,("countTo5", treturn countTo5)
+       ,("faculty", enterInformation "Faculty" [] @ faculty)
        ]

diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl
index 3370e4a..0beddf2 100644 (file)
--- a/Tasks/mTaskTask.dcl
+++ b/Tasks/mTaskTask.dcl
@@ -13,4 +13,4 @@ derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCS
        }
 
 makeTask :: String Int -> Task MTaskTask
-sendTaskToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
+sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task ()

diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl
index 208b123..9bd5612 100644 (file)
--- a/Tasks/mTaskTask.icl
+++ b/Tasks/mTaskTask.icl
@@ -4,7 +4,6 @@ import mTask
 import iTasks
 import Devices.mTaskDevice
 
-
 import iTasks._Framework.Serialization
 
 derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, RWST, Identity
@@ -13,7 +12,7 @@ makeTask :: String Int -> Task MTaskTask
 makeTask name ident = get currentDateTime 
        @ \dt->{MTaskTask | name=name,ident=ident,dateAdded=dt}
 
-sendTaskToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
+sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
 sendTaskToDevice wta mTask (device, timeout) =
                get bcStateStore @ toMessages timeout mTask
        >>= \(msgs, st1)->set st1 bcStateStore

diff --git a/client/interpret.c b/client/interpret.c
index 66173e2..08a20df 100644 (file)
--- a/client/interpret.c
+++ b/client/interpret.c
@@ -163,7 +163,6 @@ void run_task(struct task *t)
                        break;
 #endif
                case BCRETURN: trace("Return");
-                       t->value = (uint16_t) stack[sp-1];
                        debug("Task returned");
                        task_delete(t->taskid);
                        return;

diff --git a/mTask.dcl b/mTask.dcl
index 9eb93da..7766d30 100644 (file)
--- a/mTask.dcl
+++ b/mTask.dcl
@@ -95,7 +95,7 @@ class seq v where
   (>>=.) infixr 0 :: (v t p) ((v t Expr) -> (v u q)) -> (v u Stmt) | type t & type u
   (:.) infixr 0 :: (v t p) (v u q) -> v u Stmt | type t & type u
 class retrn v where
-  retrn :: (v t p) -> (v t Stmt) | type t
+  retrn :: v () Expr
 class step` v where
     (>>*.) infixl 1 :: (v t p) ((v t Expr) -> [Step v u]) -> v u Stmt | type t & type u
 :: Step v t = E.p.q: Cond (v Bool q) (v t p) | E.p: Ever (v t p)

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 29e1fb9..011c130 100644 (file)
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -23,6 +23,7 @@ from Generics.gCons import class gCons, generic conses, generic consName, generi
 :: MTaskMSGSend
        = MTTask MTaskInterval String
        | MTTaskDel Int
+       | MTShutdown
        | MTSds Int BCValue
        | MTUpd Int BCValue
        | MTSpec

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 5e17aeb..635f68b 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -46,6 +46,7 @@ encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n"
 encode (MTSds i v) = "s" +++ to16bit i +++ toByteCode v +++ "\n"
 encode (MTUpd i v) = "u" +++ to16bit i +++ toByteCode v +++ "\n"
 encode (MTSpec) = "c\n"
+encode (MTShutdown) = "h\n"
 
 import StdDebug
 decode :: String -> MTaskMSGRecv
@@ -79,6 +80,8 @@ instance toString MTaskMSGSend where
        toString (MTTaskDel i) = "Task delete request: " +++ toString i
        toString (MTUpd i v) = "Update id: " +++ toString i
                +++ " value " +++ safePrint v
+       toString (MTSpec) = "Spec request"
+       toString (MTShutdown) = "Shutdown request"
 
 instance toString MTaskMSGRecv where
        toString (MTTaskAck i mem) = "Task added with id: " +++ toString i
@@ -283,7 +286,7 @@ instance userLed ByteCode where
        ledOff (BC l) = BC $ l >>| tell [BCLedOff]
 
 instance retrn ByteCode where
-  retrn (BC l) = tell` [BCReturn]
+  retrn = tell` [BCReturn]
 
 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}