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"
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}
= OnInterrupt $ fromByteCode s bitand 127
instance fromByteCode MTaskDeviceSpec where
fromByteCode s = let c = toInt s.[0] in
- {MTaskDeviceSpec
- |haveLed=(c bitand 1) > 0
- ,haveAio=(c bitand 2) > 0
- ,haveDio=(c bitand 4) > 0
- ,bytesMemory=from16bit $ s % (1,3)
+ { MTaskDeviceSpec
+ | haveLed = (c bitand 1) > 0
+ , haveAio = (c bitand 2) > 0
+ , haveDio = (c bitand 4) > 0
+ , bytesMemory = from16bit $ s % (1,3)
+ , stackSize = from16bit $ s % (3,5)
+ , aPins = toInt s.[5]
+ , dPins = toInt s.[6]
}
derive gPrint Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC, 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]
-op :: (ByteCode a p) BC -> ByteCode a Expr
+op :: (ByteCode a p) BC -> ByteCode b c
op (BC x) bc = BC $ x >>| tell [bc]
+tell` :: [BC] -> (ByteCode a p)
tell` x = BC $ tell x
instance arith 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]
t >>| tell [BCJmp endif, BCLab else] >>|
e >>| tell [BCLab endif]
-freshl = get >>= \st=:{freshl=[fr:frs]}->put {st & freshl=frs} >>| pure fr
-freshs = get >>= \st=:{freshs=[fr:frs]}->put {st & freshs=frs} >>| pure fr
+freshl = get >>= \st=:{freshl}->put ({st & freshl=freshl+1}) >>| pure freshl
+freshs = get >>= \st=:{freshs}->put ({st & freshs=freshs+1}) >>| pure freshs
instance noOp ByteCode where noOp = tell` [BCNop]
+unBC :: (ByteCode a p) -> RWS () [BC] BCState ()
unBC (BC x) = x
instance sds ByteCode where
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)}
- where
- addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
-
+ >>= \sdsi->pure {BCShare | sdsname="", sdsi=sdsi, sdsval=BCValue 0}
+ >>= \sds ->pure (f $ tell` [BCSdsFetch sds])
+ >>= \(v In bdy)->modify (addSDS sds v)
+ >>| unBC (unMain bdy)}
+ where
+ addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
con f = undef
+
+instance namedsds ByteCode where
+ namedsds f = {main = BC $ freshs
+ >>= \sdsi->pure {BCShare | sdsname="", sdsi=sdsi, sdsval=BCValue 0}
+ >>= \sds ->pure (f $ tell` [BCSdsFetch sds])
+ >>= \(v Named n In bdy)->modify (addSDS sds n v)
+ >>| unBC (unMain bdy)}
+ where
+ addSDS sds n v s = {s & sdss=[{sds & sdsname=n, sdsval=BCValue v}:s.sdss]}
+
+instance sdspub ByteCode where
pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s]) x
instance assign 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 zero BCState where
- zero = {freshl=[1..], freshs=[1..], sdss=[]}
+ zero = {freshl=1, freshs=1, sdss=[]}
toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)
toRealByteCode x s
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 $ blink LED1) zero
-//Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
-// in (bcs, st.sdss)
+//Start = [fst $ toReadableByteCode (unMain $ p0) zero
+// ,'Text'.concat $ compile p0
+// ]
+Start = toReadableByteCode (unMain $ p0) zero
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)}
+ p0 :: (Main (a Int Expr)) | assign, namedsds, sds, arith a
+// p0 = sds \x = 6 In {main = x =. x *. lit 7}
+ p0 = namedsds \x = 6 Named "x" In {main = x =. x *. lit 7}
+
+ 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))