From 4dff4046c87727f8b09558969f7c655b9e4de3c1 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Wed, 4 Jan 2017 20:04:44 +0100 Subject: [PATCH] add sending and encoding options --- Makefile | 2 +- mTaskInterpret.dcl | 14 ++++++++++-- mTaskInterpret.icl | 56 ++++++++++++++++++++++++++++------------------ miTask.icl | 25 ++++++++++++++------- 4 files changed, 64 insertions(+), 33 deletions(-) diff --git a/Makefile b/Makefile index 6273d8e..3956c1d 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ CLEAN_HOME?=/opt/clean CLM:=clm -override CLMFLAGS+=-dynamics -l -no-pie -h 200M -t -nt -lat +override CLMFLAGS+=-dynamics -l -no-pie -h 200M -nt CLMLIBS:=\ -I $(CLEAN_HOME)/lib/iTasks-SDK/Patches/Dynamics\ -I $(CLEAN_HOME)/lib/iTasks-SDK/Patches/Generics\ diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 0deb665..bca5df7 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -5,6 +5,17 @@ from Control.Monad.State import :: State, :: StateT from Data.Monoid import class Semigroup, class Monoid import mTask +:: MTaskMessage + = MTSds Int String + | MTTask Int String + | MTPub Int String + | MTUpd Int String + +instance toString MTaskMessage +safePrint :: String -> String +encode :: MTaskMessage -> String +decode :: String -> MTaskMessage + :: BC = BCNop | BCLab Int @@ -83,8 +94,7 @@ instance assign ByteCode instance seq ByteCode instance serial ByteCode -getSDSBytes :: BCState -> String -getTaskBytes :: Int String -> String +toMessages :: Int (String, BCState) -> [MTaskMessage] toByteVal :: BC -> [Char] toReadableByteCode :: (ByteCode a b) -> (String, BCState) diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 0d4de17..760281c 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -21,6 +21,33 @@ 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 +encode (MTTask to data) = "t" +++ to16bit to +++ toString (size data) +++ data +encode (MTPub i v) = "u" +++ to16bit i +++ v +encode (MTUpd i v) = "u" +++ to16bit i +++ v + +decode :: String -> MTaskMessage +decode x = case x.[0] of + 'u' = MTUpd (toInt x.[1]) (x % (2,4)) + _ = abort ("Didn't understand message: " +++ x) + +safePrint :: String -> String +safePrint s = join " " [saf c\\c<-:s] + where + saf c = "\x" +++ toString (toInt c) + +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 + toByteVal :: BC -> [Char] toByteVal b # bt = toChar $ consIndex{|*|} b + 1 @@ -184,18 +211,12 @@ 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)} @@ -205,15 +226,6 @@ 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] diff --git a/miTask.icl b/miTask.icl index 1fc0b2f..f8fa8ba 100644 --- a/miTask.icl +++ b/miTask.icl @@ -7,18 +7,25 @@ from Text import class Text(concat,join,split), instance Text String import iTasks import mTask +derive class iTask MTaskMessage + Start :: *World -> *World Start world = startEngine (withShared ([], False, [], False) mTaskTask) world //Start world = startEngine mTaskTask world -mTaskTask :: (Shared ([String],Bool,[String],Bool)) -> Task () +mTaskTask :: (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task () mTaskTask ch = - syncNetworkChannel "localhost" 8124 "\n" id id ch ||- - viewSharedInformation "channels" [ViewWith lens] ch ||- - sendString (makemTask 500 bc) ch @! () + syncNetworkChannel "localhost" 8124 "\n" decode encode ch ||- + ( + sendMsg (hd msgs) ch >>= \_-> + sendMsg (hd (tl msgs)) ch >>= \_-> + viewSharedInformation "channels" [ViewWith lens] ch @! () + ) where - lens :: ([String],Bool,[String],Bool) -> String - lens (r,_,s,_) = "channels" + lens :: ([MTaskMessage],Bool,[MTaskMessage],Bool) -> ([String], [String]) + lens (r,_,s,_) = (map toString r, map toString s) + + msgs = toMessages 500 (toRealByteCode (unMain bc)) bc :: Main (ByteCode Int Expr) bc = sds \x=0 In {main = x =. x +. lit 1} @@ -29,8 +36,10 @@ makemTask to bc = "t" +++ toString (toChar (to / 265)) +++ toString (toChar (to rem 265)) +++ toString bc +++ "\n" -sendString :: String (Shared ([String],Bool,[String],Bool)) -> Task () -sendString m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ [m],ss)) ch @! () +sendMsg :: MTaskMessage (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task () +sendMsg m ch +| not (trace_tn ("\'" +++ toString m +++ "\'")) = undef += upd (\(r,rs,s,ss)->(r,rs,s ++ [m],ss)) ch @! () syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m syncNetworkChannel server port msgSeparator decodeFun encodeFun channel -- 2.20.1