separate share publishing from share class

[mTask.git] / mTaskInterpret.icl

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index df59c28..697ce50 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -40,6 +40,8 @@ import Text.Encodings.Base64
 
 import Tasks.Examples
 
 
 import Tasks.Examples
 

+instance == BCValue where (==) a b = toByteCode a == toByteCode b
+

 encode :: MTaskMSGSend -> String
 encode (MTTask to data) = "t" +++ toByteCode to +++ to16bit (size data) +++ data +++ "\n"
 encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n"
 encode :: MTaskMSGSend -> String
 encode (MTTask to data) = "t" +++ toByteCode to +++ to16bit (size data) +++ data +++ "\n"
 encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n"


@@ -124,7 +126,7 @@ parseBCValue c s = case c of
 castfbc :: a -> (String -> a) | mTaskType a
 castfbc _ = fromByteCode
 
 castfbc :: a -> (String -> a) | mTaskType a
 castfbc _ = fromByteCode
 

-instance toByteCode Bool where toByteCode b = {#'b',if b '\x01' '\0'}
+instance toByteCode Bool where toByteCode b = {'b',if b '\x01' '\0'}

 instance toByteCode Int where toByteCode n = {'i',toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Long where toByteCode (L n) = {'l',toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Char where toByteCode c = {'c',c}
 instance toByteCode Int where toByteCode n = {'i',toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Long where toByteCode (L n) = {'l',toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Char where toByteCode c = {'c',c}


@@ -196,12 +198,13 @@ gEq{|BCValue|} (BCValue e) (BCValue f) = toByteCode e == toByteCode f
 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec
 
 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec
 

-op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b Expr
+op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b p3

 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc]
 
 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc]
 

-op :: (ByteCode a p) BC -> ByteCode a Expr
+op :: (ByteCode a p) BC -> ByteCode b c

 op (BC x) bc = BC $ x >>| tell [bc]
 
 op (BC x) bc = BC $ x >>| tell [bc]
 

+tell` :: [BC] -> (ByteCode a p)

 tell` x = BC $ tell x
 
 instance arith ByteCode where
 tell` x = BC $ tell x
 
 instance arith ByteCode where


@@ -230,6 +233,12 @@ instance digitalIO ByteCode where
        digitalRead p = tell` [BCDigitalRead $ pin p]
        digitalWrite p b = op b (BCDigitalWrite $ pin p)
 
        digitalRead p = tell` [BCDigitalRead $ pin p]
        digitalWrite p b = op b (BCDigitalWrite $ pin p)
 

+instance aIO ByteCode where
+       aIO p = tell` [BCAnalogRead $ pin p]
+
+instance dIO ByteCode where
+       dIO p = tell` [BCDigitalRead $ 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


@@ -248,6 +257,7 @@ freshs = get >>= \st=:{freshs=[fr:frs]}->put {st & freshs=frs} >>| pure fr
 
 instance noOp ByteCode where noOp = tell` [BCNop]
 
 
 instance noOp ByteCode where noOp = tell` [BCNop]
 

+unBC :: (ByteCode a p) -> RWS () [BC] BCState ()

 unBC (BC x) = x
 
 instance sds ByteCode where
 unBC (BC x) = x
 
 instance sds ByteCode where


@@ -260,6 +270,8 @@ instance sds ByteCode where
                        addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
 
        con f = undef
                        addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
 
        con f = undef

+
+instance sdspub ByteCode where

        pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s]) x
 
 instance assign ByteCode where
        pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s]) x
 
 instance assign ByteCode where


@@ -267,6 +279,8 @@ instance assign ByteCode where
                where 
                        //This is going to include pins as well, as variables
                        makeStore [BCSdsFetch i] = [BCSdsStore i]
                where 
                        //This is going to include pins as well, as variables
                        makeStore [BCSdsFetch i] = [BCSdsStore i]

+                       makeStore [BCDigitalRead i] = [BCDigitalWrite i]
+                       makeStore [BCAnalogRead i] = [BCAnalogWrite i]

 
 instance seq ByteCode where
        (>>=.) _ _ = abort "undef on >>=."
 
 instance seq ByteCode where
        (>>=.) _ _ = abort "undef on >>=."


@@ -280,8 +294,8 @@ instance serial ByteCode where
        serialParseInt = tell` [BCSerialParseInt]
 
 instance userLed ByteCode where
        serialParseInt = tell` [BCSerialParseInt]
 
 instance userLed ByteCode where

-       ledOn  (BC l) = BC $ l >>| tell [BCLedOn]
-       ledOff (BC l) = BC $ l >>| tell [BCLedOff]
+       ledOn  l = op l BCLedOn
+       ledOff l = op l BCLedOff

 
 instance retrn ByteCode where
   retrn = tell` [BCReturn]
 
 instance retrn ByteCode where
   retrn = tell` [BCReturn]


@@ -348,15 +362,21 @@ toMessages interval x s
 instance == BCShare where (==) a b = a.sdsi == b.sdsi
 
 //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero
 instance == BCShare where (==) a b = a.sdsi == b.sdsi
 
 //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero

-Start = fst $ toReadableByteCode (unMain $ countAndLed) zero
+Start = fst $ toReadableByteCode (unMain $ bc) zero

 //Start = fst $ toReadableByteCode (unMain $ blink LED1) zero
 //Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
 //             in (bcs, st.sdss)
        where
 //             bc = {main = ledOn (lit LED1)}
 //Start = fst $ toReadableByteCode (unMain $ blink LED1) zero
 //Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
 //             in (bcs, st.sdss)
        where
 //             bc = {main = ledOn (lit LED1)}

-               bc = sds \x=5 In 
-                       sds \y=4 In
-                       {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
+//             bc = sds \x=5 In 
+//                     sds \y=4 In
+//                     {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
+               bc  = {main =
+                       IF (analogRead A0 >. lit 50)
+                         ( digitalWrite D0 (lit True)  )
+                         ( digitalWrite D0 (lit False) )
+                       }
+

 
 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))
 
 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))