separate share publishing from share class

[mTask.git] / mTaskInterpret.icl

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 5504a21..697ce50 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -126,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}


@@ -198,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


@@ -233,7 +234,7 @@ instance digitalIO ByteCode where
        digitalWrite p b = op b (BCDigitalWrite $ pin p)
 
 instance aIO ByteCode where
        digitalWrite p b = op b (BCDigitalWrite $ pin p)
 
 instance aIO ByteCode where

-       aIO p = undef
+       aIO p = tell` [BCAnalogRead $ pin p]

 
 instance dIO ByteCode where
        dIO p = tell` [BCDigitalRead $ pin p]
 
 instance dIO ByteCode where
        dIO p = tell` [BCDigitalRead $ pin p]


@@ -256,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


@@ -268,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


@@ -290,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]


@@ -358,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))