update a lot, try to type shares

[mTask.git] / mTaskInterpret.icl

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 1caa4ba..5acd1da 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -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