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
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
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 $ 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)}
- 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))