X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.icl;h=3cf4dfe50b67e1b24188ea8d7add874a56e19dc9;hb=1c8014ff74afb966b891a4689d8ee3e512300746;hp=0d4de1707d942205ce8c0a85a0db551fd50975b3;hpb=790a710d277a608f47bf92f7edb6ef18935a7954;p=mTask.git diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 0d4de17..3cf4dfe 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -21,6 +21,35 @@ from Text import class Text(concat,join,toUpperCase), instance Text String import Text.Encodings.Base64 +encode :: MTaskMessage -> String +encode (MTSds i v) = "s" +++ to16bit i +++ v +++ "\n" +encode (MTTask to data) = "t" +++ to16bit to +++ to16bit (size data) +++ data +++ "\n" +encode (MTPub i v) = "u" +++ to16bit i +++ v +++ "\n" +encode (MTUpd i v) = "u" +++ to16bit i +++ v +++ "\n" +encode MTEmpty = "" + +decode :: String -> MTaskMessage +decode x +| size x == 0 = MTEmpty += case x.[0] of + '\0' = MTEmpty + 'u' = MTUpd (from16bit (x % (1,3))) (x % (3,5)) + _ = abort ("Didn't understand message: " +++ join " " [toString (toInt c)\\c<-: x] +++ "\n") + +safePrint :== toString o toJSON + +derive gPrint MTaskMessage +instance toString MTaskMessage where + toString (MTSds i v) = "Sds id: " +++ toString i + +++ " value " +++ safePrint v + toString (MTTask to data) = "Task timeout: " +++ toString to + +++ " data " +++ safePrint data + toString (MTPub i v) = "Publish id: " +++ toString i + +++ " value " +++ safePrint v + toString (MTUpd i v) = "Update id: " +++ toString i + +++ " value " +++ safePrint v + toString MTEmpty = "Empty message" + toByteVal :: BC -> [Char] toByteVal b # bt = toChar $ consIndex{|*|} b + 1 @@ -54,7 +83,7 @@ runBC (BC m) = m retrn :: ([BC] -> ByteCode a p) retrn = BC o tuple -fmp :: ([BC] -> [BC]) (ByteCode a p) -> ByteCode a p +fmp :: ([BC] -> [BC]) (ByteCode a p) -> ByteCode a q fmp f b = BC \s->let (bc, s`) = runBC b s in (f bc, s`) instance toByteCode Bool where @@ -129,6 +158,7 @@ instance sds ByteCode where in setSDS sds v <++> unMain body } con f = undef + pub x = fmp makePub x // pub _ = undef instance assign ByteCode where @@ -184,36 +214,21 @@ toReadableByteCode x // where // bc :: ByteCode Int Expr // bc = (lit 36 +. lit 42) +. lit 44 -getSDSBytes :: BCState -> String -getSDSBytes {sdss} = concat $ map sd sdss - where sd (i, v) = "s" +++ toString (toChar i) +++ toString v +++ "\n" - -getTaskBytes :: Int String -> String -getTaskBytes i b = "t" +++ to16bit i +++ to16bit (size b) +++ b -// -Start = getSDSBytes (snd bc`) +++ getTaskBytes 400 (fst bc`) +toMessages :: Int (String, BCState) -> [MTaskMessage] +toMessages interval (bytes, {sdss}) = [MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes] + +Start = toMessages 500 $ toRealByteCode (unMain bc) //Start = fst $ toReadableByteCode $ unMain bc where - bc` = toRealByteCode (unMain bc) -// bc :: Main (ByteCode Int Stmt) 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 +//pub :: (ByteCode a b) -> ByteCode a b +//pub x = fmp makePub x to16bit :: Int -> String to16bit i = toString (toChar (i/265)) +++ toString (toChar (i rem 265)) -// -////Run test programma en pretty print -////Start :: String -////Start = "t" +++ to16bit (size b) +++ b -//Start :: Main (ByteCode Int Expr) -//Start = bc -// where -// bc = sds \x=43 In {main = If (x ==. lit 42) (analogRead A1) (analogRead A0)} -// b = toRealByteCode bc -//Start :: ByteCode Int Expr -//Start = If (lit True) (analogRead A1) (analogRead A0) -//Start = If ((lit 36) ==. (lit 42)) (noOp) (noOp) + +from16bit :: String -> Int +from16bit s = toInt s.[0] * 265 + toInt s.[1]