update a lot, try to type shares
authorMart Lubbers <mart@martlubbers.net>
Sun, 12 Mar 2017 14:11:47 +0000 (15:11 +0100)
committerMart Lubbers <mart@martlubbers.net>
Sun, 12 Mar 2017 14:11:47 +0000 (15:11 +0100)
13 files changed:
Devices/mTaskDevice.icl
Generics/gCons.dcl
Generics/gCons.icl
Makefile
Shares/mTaskShare.dcl
Shares/mTaskShare.icl
Tasks/Examples.dcl
Utils/SDS.dcl
Utils/SDS.icl
client/interpret.c
mTaskInterpret.dcl
mTaskInterpret.icl
miTask.icl

index 71c6ee2..0304e7e 100644 (file)
@@ -74,7 +74,7 @@ manageDevices processFun ds = anyTask [
        <<@ ArrangeWithTabs @! ()
 
 viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
-viewDevice pf d = forever $ anyTask 
+viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask 
                [viewInformation "Device settings" [] d @! ()
                ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
                ,forever $ 
@@ -96,26 +96,25 @@ 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 
-       >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare
-       >>| makeShares sdss
+               traceValue "starting to send"
+       >>| get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask)
+       >>= \(msgs, st1)->traceValue "messages generated"
+       >>| set st1 bcStateStore
+       >>| traceValue "bcstate store updated"
+       >>| toSDSRecords st1
+       >>= \sdss->traceValue "Shares created"
+       >>| set sdss sdsStore//MTaskShareaddToSDSShare
+       >>| traceValue "Shares store updated"
        >>| sendMessages msgs device
+       >>| traceValue "Messages sent"
        >>| makeTask wta -1
-       >>= withDevices device o addTask
+       >>= \t->traceValue "Task made"
+       >>| withDevices device (addTask t)
+       >>| traceValue "Tasks share updated"
        @! ()
        where
                sharename i = device.deviceChannels +++ "-" +++ toString i
-               toSDSRecords st = [{MTaskShare |
-                       withTask=wta,
-                       identifier=sdsi,
-                       initVal=sdsval,
-                       //We skip the only/local shares
-                       realShare="mTaskSDS-" +++ toString sdsi}
-                               \\{sdsi,sdspub,sdsval}<-st.sdss | sdspub]
-
-               makeShares :: [MTaskShare] -> Task ()
-               makeShares shs = treturn () //foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
+               toSDSRecords st = sequence "" [makeShare wta sdsi sdsval\\{sdsi,sdspub,sdsval}<-st.sdss]// | sdspub]
 
                addTask :: MTaskTask MTaskDevice -> MTaskDevice
                addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
index 409a255..71183db 100644 (file)
@@ -10,7 +10,7 @@ definition module Generics.gCons
 from Data.Maybe import :: Maybe
 import StdGeneric
 
-class gCons a | conses{|*|}, consName{|*|}, consIndex{|*|} a
+class gCons a | conses{|*|}, consName{|*|}, consIndex{|*|}, consNum{|*|} a
 
 consByName :: String -> Maybe a | conses{|*|}, consName{|*|} a
 
@@ -22,3 +22,6 @@ derive consIndex CONS of {gcd_index},UNIT,PAIR,EITHER,OBJECT,FIELD,RECORD,Int,Bo
 
 generic conses a :: [a]
 derive conses CONS,UNIT,PAIR,EITHER,OBJECT,FIELD,RECORD,Int,Bool,Char,Real,String,(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),{},{!},[],[! ],[ !],[!!],(->)
+
+generic consNum a :: a -> Int
+derive consNum CONS of {gcd_arity},UNIT,PAIR,EITHER,OBJECT,FIELD,RECORD,Int,Bool,Char,Real,String,(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),{},{!},[],[! ],[ !],[!!]
index 62caa27..07365e2 100644 (file)
@@ -106,3 +106,22 @@ conses{|{}|} _ = [{}]
 conses{|{!}|} _ = [{!}]
 conses{|(->)|} _ _ = [const undef]
 derive conses [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+
+generic consNum a :: a -> Int
+consNum{|CONS of {gcd_arity}|} f x = gcd_arity
+consNum{|UNIT|} _ = 0
+consNum{|PAIR|} f _ (PAIR x y) = f x
+consNum{|EITHER|} f _ (LEFT x) = f x
+consNum{|EITHER|} _ g (RIGHT y) = g y
+consNum{|OBJECT|} f (OBJECT x) = f x
+consNum{|RECORD|} f (RECORD x) = f x
+consNum{|FIELD|} f (FIELD x) = f x
+consNum{|Int|} _ = 0
+consNum{|Bool|} _ = 0
+consNum{|Char|} _ = 0
+consNum{|Real|} _ = 0
+consNum{|String|} _ = 0
+consNum{|{}|} _ _ = 0
+consNum{|{!}|} _ _ = 0
+consNum{|(->)|} _ _ _ = 0
+derive consNum [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
index cbc1ea9..cbca7ae 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -19,7 +19,7 @@ CLMLIBS:=\
        -I $(CLEAN_HOME)/lib/TCPIP\
        -I ./CleanSerial
 
-BINARIES:= mTaskInterpret miTask mTaskExamples 
+BINARIES:= testi mTaskInterpret miTask # mTaskExamples 
 
 all: CleanSerial/Clean\ System\ Files/TTY.o $(BINARIES) #client/mTaskSymbols.h
        mkdir -p miTask-www
index 6b39448..3af2eac 100644 (file)
@@ -1,14 +1,17 @@
 definition module Shares.mTaskShare
 
 import iTasks
+import iTasks._Framework.Serialization
 
-:: MTaskShare = {
-               withTask :: String,
-               identifier :: Int,
-               initVal :: String,
-               realShare :: String
-       }
-
-instance zero MTaskShare
+derive class iTask MTaskShareType
+:: MTaskShareType = MTaskWithShare String | MTaskLens String
+:: MTaskShare =
+               {withTask :: String
+               ,identifier :: Int
+               ,realShare :: MTaskShareType
+               ,value :: String
+               }
 
 manageShares :: [MTaskShare] -> Task ()
+
+makeShare :: String Int String -> Task MTaskShare
index eb799df..8eb7dc0 100644 (file)
@@ -1,42 +1,49 @@
 implementation module Shares.mTaskShare
 
+import dynamic_string
 import Utils.SDS
 import Utils.Devices
 import iTasks
 import mTask
 from Data.Func import $
 
+derive class iTask MTaskShareType
 manageShares :: [MTaskShare] -> Task ()
-manageShares shares = forever (enterChoice "Choose share to update" [ChooseFromGrid id] shares)
-       @! ()
-
-
-
-/*
+manageShares shares =
        forever (enterChoice "Choose share to update" [ChooseFromGrid id] shares
        >&^ \st->whileUnchanged st $ \msh->case msh of
-               Nothing = viewShares shares @! zero
+               Nothing = viewShares shares
                Just sh = forever (
-                               viewSharedInformation "View value" [] (getSDSStore sh)
-                       >>* [OnAction (Action "Update") (withValue (Just o updateInformation "New value" []))]
-                       >>= updateShare sh
+                               viewSharedInformation "View value" [] (getSDSShare sh) >>| treturn sh
+//                     >>* [OnAction (Action "Update") (withValue (Just o updateInformation "New value" []))]
+//                     >>= updateShare sh
                        )
                        
-       ) @! ()*/
-
-updateShare :: MTaskShare a -> Task MTaskShare | toByteCode, iTask a
-updateShare sh=:{withTask,identifier} a = getDeviceByName withTask
-       >>= sendMessages [MTUpd identifier $ toString $ toByteCode a]
-       >>| treturn sh
-
-
-viewShares :: [MTaskShare] -> Task ()
-viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal @! ()
-
-viewShare :: MTaskShare -> Task ()
-viewShare m = treturn ()//viewSharedInformation "" [] (getSDSStore m)
-       //<<@ Title ("SDS: " +++ toString m.identifier) @! ()
-
-instance zero MTaskShare where
-       zero = {withTask="",identifier=0,realShare="",initVal=""}
-
+       ) @! ()
+
+//updateShare :: MTaskShare a -> Task MTaskShare | toByteCode, iTask a
+//updateShare sh=:{withTask,identifier} a = getDeviceByName withTask
+//     >>= sendMessages [MTUpd identifier $ toString $ toByteCode a]
+//     >>| treturn sh
+
+
+viewShares :: [MTaskShare] -> Task MTaskShare
+viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal
+       >>| return (hd sh)
+
+viewShare :: MTaskShare -> Task String
+viewShare m = viewSharedInformation "" [] (getSDSShare m)
+       <<@ Title ("SDS: " +++ toString m.identifier)
+
+getSDSShare :: MTaskShare -> Shared String
+getSDSShare s=:{realShare=(MTaskWithShare id)}
+       = memoryShare id s.MTaskShare.value
+
+makeShare :: String Int String -> Task MTaskShare
+makeShare withTask identifier value = treturn 
+               {MTaskShare
+               |withTask=withTask
+               ,identifier=identifier
+               ,value=value
+               ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier
+               } >>= \sh->set value (getSDSShare sh) >>| treturn sh
index 6c099dd..f3a8a3a 100644 (file)
@@ -5,6 +5,7 @@ import mTask
 
 countAndLed :: Main (ByteCode () Stmt)
 blink :: UserLED -> Main (ByteCode () Stmt)
+blinkShare :: Main (ByteCode () Stmt)
 ledtOn :: UserLED -> Main (ByteCode () Stmt)
 ledtOff :: UserLED -> Main (ByteCode () Stmt)
 
index 6836af1..47e6647 100644 (file)
@@ -13,5 +13,4 @@ sdsStore :: Shared [MTaskShare]
 bcStateStore :: Shared BCState
 mTaskTaskStore :: Shared [String]
 
-getSDSStore :: MTaskShare -> Shared a | iTask, mTaskType a
 getSDSRecord :: Int -> Task MTaskShare
index 3d8e3a0..9c6b46a 100644 (file)
@@ -25,8 +25,5 @@ bcStateStore = memoryShare "mTaskBCState" zero
 mTaskTaskStore :: Shared [String]
 mTaskTaskStore = memoryShare "mTaskTasks" $ 'DM'.keys allmTasks
 
-getSDSStore :: MTaskShare -> Shared a | iTask, mTaskType a
-getSDSStore sh = memoryShare sh.realShare $ fromByteCode sh.initVal
-
 getSDSRecord :: Int -> Task MTaskShare
 getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]
index 39c24b0..0335f1d 100644 (file)
@@ -140,10 +140,12 @@ void run_task(struct task *t)
                        sp--;
                        break;
                case BCLEDON: trace("LedOn(%d)", program[pc]);
-                       led_on(program[pc++]);
+                       led_on(stack[sp-1]);
+                       sp--;
                        break;
                case BCLEDOFF: trace("LedOn(%d)", program[pc]);
-                       led_off(program[pc++]);
+                       led_off(stack[sp-1]);
+                       sp--;
                        break;
                default:
                        trace("unrecognized");
index 24dc6a6..f476232 100644 (file)
@@ -63,8 +63,8 @@ decode :: String -> MTaskMSGRecv
        | BCJmpT Int
        | BCJmpF Int
        //UserLED
-       | BCLedOn UserLED
-       | BCLedOff UserLED
+       | BCLedOn
+       | BCLedOff
        //Serial
        | BCSerialAvail
        | BCSerialPrint
@@ -78,7 +78,6 @@ decode :: String -> MTaskMSGRecv
        | BCDigitalWrite Pin
        | BCTest AnalogPin
 
-derive gPrint BC
 derive class gCons BC
 
 :: ByteCode a p = BC (RWS () [BC] BCState ())
index 1caa4ba..5acd1da 100644 (file)
@@ -86,23 +86,6 @@ instance toString MTaskMSGRecv where
        toString (MTMessage m) = m
        toString MTEmpty = "Empty message"
 
-bclength :: BC -> Int
-bclength (BCPush _) = 3
-bclength (BCLab _) = 2
-bclength (BCSdsStore _) = 3
-bclength (BCSdsFetch _) = 3
-bclength (BCSdsPublish _) = 3
-bclength (BCAnalogRead _) = 2
-bclength (BCAnalogWrite _) = 2
-bclength (BCDigitalRead _) = 2
-bclength (BCDigitalWrite _) = 2
-bclength (BCLedOn _) = 2
-bclength (BCLedOff _) = 2
-bclength (BCJmp i) = 2
-bclength (BCJmpT i) = 2
-bclength (BCJmpF i) = 2
-bclength _ = 1
-
 toByteVal :: BC -> String
 toByteVal b = {toChar $ consIndex{|*|} b} +++
        case b of
@@ -115,8 +98,6 @@ toByteVal b = {toChar $ consIndex{|*|} b} +++
                (BCAnalogWrite i) = {toChar i}
                (BCDigitalRead i) = {toChar i}
                (BCDigitalWrite i) = {toChar i}
-               (BCLedOn i) = toByteCode i
-               (BCLedOff i) = toByteCode i
                (BCJmp i) = {toChar i}
                (BCJmpT i) = {toChar i}
                (BCJmpF i) = {toChar i}
@@ -234,10 +215,10 @@ unBC (BC x) = x
 instance sds ByteCode where
        sds f = {main = BC $ freshs 
                                >>= \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)}
                where
-                       addSDS i v s = {s & sdss=[
-                               {sdsi=i,sdspub=False,sdsval=toByteCode v}:s.sdss]}
+                       addSDS i v s = {s & sdss=[{sdsi=i,sdspub=False,sdsval=v}:s.sdss]}
+
        con f = undef
        pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s])
                        (listen x >>= \(_, [BCSdsFetch s])->modify (publish s)) >>| tell mempty
@@ -247,6 +228,7 @@ instance sds ByteCode where
 instance assign ByteCode where
        (=.) (BC v) (BC e) = BC $ e >>| censor makeStore v
                where 
+                       //This is going to include pins as well, as variables
                        makeStore [BCSdsFetch i] = [BCSdsStore i]
 
 instance seq ByteCode where
@@ -261,8 +243,11 @@ instance serial ByteCode where
        serialParseInt = tell` [BCSerialParseInt]
 
 instance userLed ByteCode where
-       ledOn  (BC l) = BC $ censor (\[BCPush d]->[BCLedOn  $ fromByteCode d]) l
-       ledOff (BC l) = BC $ censor (\[BCPush d]->[BCLedOff $ fromByteCode d]) l
+       ledOn  (BC l) = BC $ l >>| tell [BCLedOn]
+       ledOff (BC l) = BC $ l >>| tell [BCLedOff]
+
+func :: (a -> BC) [BC] -> [BC] | mTaskType a
+func f b = abort ('Text'.join "\n" (map printToString b))
 
 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}
@@ -281,7 +266,8 @@ implGotos _ i = i
 computeGotos :: [BC] Int -> ([BC], 'DM'.Map Int Int)
 computeGotos [] _ = ([], 'DM'.newMap)
 computeGotos [BCLab l:xs] i = appSnd ('DM'.put l i) (computeGotos xs i)
-computeGotos [x:xs] i = appFst (\bc->[x:bc]) (computeGotos xs (i+(bclength x)))
+computeGotos [x:xs] i = appFst (\bc->[x:bc])
+       (computeGotos xs $ i + 1 + consNum{|*|} x)
 
 readable :: BC -> String
 readable (BCPush d) = "BCPush " +++ concat [safe c\\c<-:d]
@@ -300,14 +286,15 @@ toReadableByteCode x s
 
 toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState)
 toMessages interval (bytes, st=:{sdss}) = (
-       [MTSds s.sdsi (toString s.sdsval)\\s<-sdss] ++
+       [MTSds s.sdsi (toByteCode s.sdsval)\\s<-sdss] ++
        [MTTask interval bytes], st)
 
 toSDSUpdate :: Int Int -> [MTaskMSGSend]
 toSDSUpdate i v = [MTUpd i (to16bit v)]
 
 //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero
-Start = fst $ toReadableByteCode (unMain bc) zero
+Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
+               in (bcs, st.sdss)
        where
 //             bc = {main = ledOn (lit LED1)}
                bc = sds \x=5 In 
index 47d3c8c..5a65116 100644 (file)
@@ -62,7 +62,7 @@ mTaskManager = startupDevices >>| anyTask
                                proc [m:ms] = (case m of
 //                                     MTSDSAck i = traceValue (toString m) @! ()
 //                                     MTSDSDelAck i = traceValue (toString m) @! ()
-                                       MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
+//                                     MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
                                        MTTaskAck i = deviceTaskAcked device i
                                        MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
                                        MTEmpty = treturn ()