X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.icl;h=697ce50da46fc200d6d9b8b0d73d13b47189e69d;hb=848595d1288804d6de43625f9e6f1cf76295c285;hp=df59c2839092fc5cdbd3c70916fc7f022007d2ac;hpb=8d4571009f6d539374a8beaf19a7880298308f67;p=mTask.git diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index df59c28..697ce50 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -40,6 +40,8 @@ import Text.Encodings.Base64 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" @@ -124,7 +126,7 @@ parseBCValue c s = case c of 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} @@ -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 -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 @@ -230,6 +233,12 @@ instance digitalIO ByteCode where 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 @@ -248,6 +257,7 @@ freshs = get >>= \st=:{freshs=[fr:frs]}->put {st & freshs=frs} >>| pure fr instance noOp ByteCode where noOp = tell` [BCNop] +unBC :: (ByteCode a p) -> RWS () [BC] BCState () 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 + +instance sdspub 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] + makeStore [BCDigitalRead i] = [BCDigitalWrite i] + makeStore [BCAnalogRead i] = [BCAnalogWrite i] instance seq ByteCode where (>>=.) _ _ = abort "undef on >>=." @@ -280,8 +294,8 @@ instance serial 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] @@ -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 -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))