X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.icl;h=1833e6201e5f5472c8a8c05d5671a33846aaba77;hb=f90517d738696125a067f113edf93f404873115b;hp=0ab4508c6fbf006aa1aa48b6cf5aad5c212af3fc;hpb=8449be73c124cdccd37500c0d67d9404b94fc9c8;p=mTask.git diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 0ab4508..1833e62 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -34,6 +34,7 @@ decode x '\0' = MTEmpty '\n' = MTEmpty 'm' = MTMessage x + 't' = MTTaskAdded (from16bit (x % (1,3))) 'u' = MTPub (from16bit (x % (1,3))) (x % (3,5)) _ = MTMessage x//abort ("Didn't understand message: " +++ join " " [toString (toInt c)\\c<-: x] +++ "\n") @@ -50,6 +51,7 @@ instance toString MTaskMSGSend where instance toString MTaskMSGRecv where toString (MTPub i v) = "Publish id: " +++ toString i +++ " value " +++ safePrint v + toString (MTTaskAdded i) = "Task added with id: " +++ toString i toString MTEmpty = "Empty message" bclength :: BC -> Int @@ -62,6 +64,8 @@ bclength (BCAnalogRead _) = 2 bclength (BCAnalogWrite _) = 2 bclength (BCDigitalRead _) = 2 bclength (BCDigitalWrite _) = 2 +bclength (BCLedOn _) = 2 +bclength (BCLedOff _) = 2 bclength (BCJmp i) = 2 bclength (BCJmpT i) = 2 bclength (BCJmpF i) = 2 @@ -69,7 +73,7 @@ bclength _ = 1 toByteVal :: BC -> [Char] toByteVal b -# bt = toChar $ consIndex{|*|} b + 1 +# bt = toChar $ consIndex{|*|} b = [bt:case b of (BCPush i) = i (BCLab i) = [toChar i] @@ -80,6 +84,8 @@ toByteVal b (BCAnalogWrite i) = [toChar i] (BCDigitalRead i) = [toChar i] (BCDigitalWrite i) = [toChar i] + (BCLedOn i) = i + (BCLedOff i) = i (BCJmp i) = [toChar i] (BCJmpT i) = [toChar i] (BCJmpF i) = [toChar i] @@ -112,13 +118,14 @@ instance toByteCode Long where toByteCode (L n) = toByteCode n instance toByteCode Char where toByteCode c = [c] instance toByteCode String where toByteCode s = undef instance toByteCode Button where toByteCode s = [toChar $ consIndex{|*|} s] +instance toByteCode UserLED where toByteCode s = [toChar $ consIndex{|*|} s] instance toChar Pin where toChar (Digital p) = toChar $ consIndex{|*|} p toChar (Analog p) = toChar $ consIndex{|*|} p derive gPrint BC, AnalogPin, Pin, DigitalPin -derive consIndex BC, Pin, Button +derive consIndex BC, Pin, Button, UserLED derive consName BC, Pin, Button instance arith ByteCode where @@ -159,7 +166,7 @@ BCIfStmt b t e = b <++> retrn [BCJmpF else] <++> t <++> retrn [BCJmp endif,BCLab else] <++> e <++> retrn [BCLab endif] -instance noOp ByteCode where noOp = mempty +instance noOp ByteCode where noOp = retrn [BCNop] withLabel :: (Int -> (ByteCode b q)) -> ByteCode b q withLabel f = BC \s->let [fresh:fs] = s.freshl @@ -205,6 +212,10 @@ instance serial ByteCode where serialRead = retrn [BCSerialRead] serialParseInt = retrn [BCSerialParseInt] +instance userLed ByteCode where + ledOn l = retrn [BCLedOn $ toByteCode l] + ledOff l = retrn [BCLedOff $ toByteCode l] + instance zero BCState where zero = {freshl=[1..], freshs=[1..], sdss=[]} @@ -239,11 +250,6 @@ toReadableByteCode x # (bc, gtmap) = computeGotos bc 0 = (join "\n" $ map readable (map (implGotos gtmap) bc), st) -//Start :: String -//Start = toReadableByteCode bc -// where -// bc :: ByteCode Int Expr -// bc = (lit 36 +. lit 42) +. lit 44 toMessages :: Int (String, BCState) -> ([MTaskMSGSend], BCState) toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes], st) @@ -251,15 +257,11 @@ toSDSUpdate :: Int Int -> [MTaskMSGSend] toSDSUpdate i v = [MTUpd i (to16bit v)] Start = toMessages 500 $ toRealByteCode (unMain bc) -//Start = fst $ toReadableByteCode $ unMain bc where bc = sds \x=5 In sds \y=4 In {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)} -//pub :: (ByteCode a b) -> ByteCode a b -//pub x = fmp makePub x - to16bit :: Int -> String to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))