From: Mart Lubbers Date: Sun, 5 Mar 2017 20:03:45 +0000 (+0100) Subject: clean up share code and only show published tasks X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=547eb2278f48ab8b94e70ef4a1fc2bf5093bdfb2;p=mTask.git clean up share code and only show published tasks --- diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl index 6a717f0..213fccb 100644 --- a/Devices/mTaskDevice.dcl +++ b/Devices/mTaskDevice.dcl @@ -9,7 +9,7 @@ import mTaskInterpret import Generics.gCons import iTasksTTY -derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend +derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare derive conses MTaskResource, TCPSettings derive consName MTaskResource, TCPSettings diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index bb5b353..6a8c369 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -16,7 +16,7 @@ import iTasks._Framework.Store from Data.Func import $ -derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend +derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings @@ -85,7 +85,7 @@ deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d) sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () sendToDevice wta mTask (device, timeout) = get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask) - >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords + >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare >>| makeShares sdss >>| sendMessage device msgs @@ -95,11 +95,12 @@ sendToDevice wta mTask (device, timeout) = where sharename i = device.deviceChannels +++ "-" +++ toString i toSDSRecords st = [{MTaskShare | - initValue=toInt d1*265 + toInt d2, + initValue=toInt (sdsval!!0)*265 + toInt (sdsval!!1), withTask=wta, - identifier=i, - realShare="mTaskSDS-" +++ toString i} - \\(i,[d1,d2])<-st.sdss] + identifier=sdsi, + //We skip the only/local shares + realShare="mTaskSDS-" +++ toString sdsi} + \\{sdsi,sdspub,sdsval}<-st.sdss | sdspub] makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ()) addTask :: MTaskTask MTaskDevice -> MTaskDevice diff --git a/Tasks/Examples.icl b/Tasks/Examples.icl index 7d872ef..b2a79de 100644 --- a/Tasks/Examples.icl +++ b/Tasks/Examples.icl @@ -3,9 +3,10 @@ implementation module Tasks.Examples import qualified Data.Map as DM import mTask +import Devices.mTaskDevice import iTasks._Framework.Serialization -derive class iTask UserLED, Main, ByteCode, Stmt, BC, BCState +derive class iTask UserLED countAndLed :: Main (ByteCode () Stmt) countAndLed = sds \x=1 In sds \pinnetje=1 In {main = diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl index ef46243..94bcc8a 100644 --- a/Tasks/mTaskTask.dcl +++ b/Tasks/mTaskTask.dcl @@ -1,5 +1,6 @@ definition module Tasks.mTaskTask +import Devices.mTaskDevice import mTask import iTasks diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 2701fcf..17034be 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -80,10 +80,16 @@ decode :: String -> MTaskMSGRecv instance Semigroup (ByteCode a p) instance Monoid (ByteCode a p) +:: BCShare = { + sdsi :: Int, + sdspub :: Bool, + sdsval :: [Char] + } + :: BCState = { freshl :: [Int], freshs :: [Int], - sdss :: [(Int, [Char])] + sdss :: [BCShare] } instance zero BCState diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 3f57e7d..acbff39 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -180,9 +180,9 @@ instance digitalIO ByteCode where digitalRead p = retrn [BCDigitalRead $ pin p] digitalWrite p b = b <+-> [BCDigitalWrite $ pin p] -//instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e -//instance If ByteCode e Stmt Stmt where If b t e = BCIfStmt b t e -//instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e +instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e +instance If ByteCode e Stmt Stmt where If b t e = BCIfStmt b t e +instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e instance If ByteCode x y Stmt where If b t e = BCIfStmt b t e instance IF ByteCode where IF b t e = BCIfStmt b t e @@ -203,7 +203,8 @@ withSDS f = BC \s->let [fresh:fs] = s.freshs in runBC (f fresh) {s & freshs=fs} setSDS :: Int v -> ByteCode b q | toByteCode v -setSDS ident val = BC \s->([], {s & sdss = [(ident, toByteCode val):s.sdss]}) +setSDS ident val = BC \s->([], {s & sdss=[ + {BCShare|sdsi=ident,sdspub=False,sdsval=toByteCode val}:s.sdss]}) instance sds ByteCode where sds f = {main = withSDS \sds-> @@ -211,20 +212,15 @@ instance sds ByteCode where in setSDS sds v <++> unMain body } con f = undef - pub x = fmp makePub x + pub x = BC \s-> let ((i, bc), s`) = appFst makePub $ runBC x s + in (bc, {s` & sdss=map (publish i) s`.sdss}) + where + publish i s = if (i == s.sdsi) {s & sdspub=True} s + makePub [BCSdsFetch i:xs] = (i, [BCSdsPublish i:xs]) instance assign ByteCode where (=.) v e = e <++> fmp makeStore v - -makePub [] = [] -makePub [x:xs] = case x of - BCSdsFetch i = [BCSdsPublish i:xs] - y = [y:xs] - -makeStore [] = [] -makeStore [x:xs] = case x of - BCSdsFetch i = [BCSdsStore i:xs] - y = [y:xs] + where makeStore [BCSdsFetch i:xs] = [BCSdsStore i:xs] instance seq ByteCode where (>>=.) _ _ = abort "undef on >>=." @@ -275,7 +271,9 @@ toReadableByteCode x = (join "\n" $ map readable (map (implGotos gtmap) bc), st) toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState) -toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes], st) +toMessages interval (bytes, st=:{sdss}) = ( + [MTSds s.sdsi (toString s.sdsval)\\s<-sdss] ++ + [MTTask interval bytes], st) toSDSUpdate :: Int Int -> [MTaskMSGSend] toSDSUpdate i v = [MTUpd i (to16bit v)]