extend shares
authorMart Lubbers <mart@martlubbers.net>
Wed, 17 May 2017 11:05:26 +0000 (13:05 +0200)
committerMart Lubbers <mart@martlubbers.net>
Wed, 17 May 2017 11:05:26 +0000 (13:05 +0200)
Tasks/mTaskTask.icl
mTaskInterpret.dcl
mTaskInterpret.icl

index 9bd5612..46637e8 100644 (file)
@@ -17,7 +17,7 @@ sendTaskToDevice wta mTask (device, timeout) =
                get bcStateStore @ toMessages timeout mTask
        >>= \(msgs, st1)->set st1 bcStateStore
        >>| toSDSRecords msgs st1 device
-       >>= \sdss->upd (mergeShares sdss) sdsStore 
+       >>= \sdss->upd ((++) sdss) sdsStore 
        >>| sendMessages msgs device
        >>| makeTask wta -1
        >>= withDevices device o addTask
@@ -28,11 +28,7 @@ sendTaskToDevice wta mTask (device, timeout) =
                toSDSRecords :: [MTaskMSGSend] BCState MTaskDevice -> Task [MTaskShare]
                toSDSRecords s st device = treturn 
                        [makeShare wta device.deviceName sdsi sdsval
-                       \\{sdsi,sdspub,sdsval}<-st.sdss
-                       , (MTSds sdsi` _)<-s
-                       | sdsi == sdsi`]
-
-               mergeShares a b = a ++ b
+                       \\{sdsi,sdsval}<-st.sdss, (MTSds sdsi` _)<-s | sdsi == sdsi`]
 
                addTask :: MTaskTask MTaskDevice -> MTaskDevice
                addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
index 011c130..5065585 100644 (file)
@@ -55,9 +55,9 @@ decode :: String -> MTaskMSGRecv
 //     | BCPush String
        | BCPop
        //SDS functions
-       | BCSdsStore Int
-       | BCSdsFetch Int
-       | BCSdsPublish Int
+       | BCSdsStore BCShare
+       | BCSdsFetch BCShare
+       | BCSdsPublish BCShare
        //Unary ops
        | BCNot
        //Binary Int ops
@@ -115,7 +115,6 @@ derive gEq BCValue
 
 :: BCShare = {
                sdsi :: Int,
-               sdspub :: Bool,
                sdsval :: BCValue
        }
 
index 635f68b..df59c28 100644 (file)
@@ -100,9 +100,9 @@ toByteVal b = {toChar $ consIndex{|*|} b} +++
        case b of
                (BCPush (BCValue i)) = toByteCode i
                (BCLab i) = {toChar i}
-               (BCSdsStore i) = to16bit i
-               (BCSdsFetch i) = to16bit i
-               (BCSdsPublish i) = to16bit i
+               (BCSdsStore i) = to16bit i.sdsi
+               (BCSdsFetch i) = to16bit i.sdsi
+               (BCSdsPublish i) = to16bit i.sdsi
                (BCAnalogRead i) = {toChar $ consIndex{|*|} i}
                (BCAnalogWrite i) = {toChar $ consIndex{|*|} i}
                (BCDigitalRead i) = {toChar $ consIndex{|*|} i}
@@ -166,7 +166,7 @@ instance fromByteCode MTaskDeviceSpec where
                }
 
 derive gPrint Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC, MTaskDeviceSpec
-derive class gCons BC
+derive class gCons BC, BCShare
 
 consIndex{|BCValue|} _ = 0
 consName{|BCValue|} _ = "BCValue"
@@ -251,18 +251,16 @@ instance noOp ByteCode where noOp = tell` [BCNop]
 unBC (BC x) = x
 
 instance sds ByteCode where
-       sds f = {main = BC $ freshs 
+       sds f = {main = BC $ freshs
+                               >>= \sdsi->pure {BCShare | sdsi=sdsi,sdsval=BCValue 0}
                                >>= \sds->pure (f (tell` [BCSdsFetch sds]))
-                               >>= \(v In bdy)->modify (addSDS sds v) >>| unBC (unMain bdy)}
-//                             >>= \(v In bdy)->modify (addSDS sds (toByteCode v)) >>| unBC (unMain bdy)}
+                               >>= \(v In bdy)->modify (addSDS sds v)
+                               >>| unBC (unMain bdy)}
                where
-                       addSDS i v s = {s & sdss=[{sdsi=i,sdspub=False,sdsval=(BCValue v)}:s.sdss]}
+                       addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
 
        con f = undef
-       pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s])
-                       (listen x >>= \(_, [BCSdsFetch s])->modify (publish s)) >>| tell mempty
-               where
-                       publish i st = {st & sdss=[if (i == s.sdsi) {s & sdspub=True} s \\s<-st.sdss]}
+       pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s]) x
 
 instance assign ByteCode where
        (=.) (BC v) (BC e) = BC $ e >>| censor makeStore v