update

[mTask.git] / mTaskInterpret.icl

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index acbff39..615aa10 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -22,6 +22,7 @@ import StdList
 from Data.Func import $
 from Text import class Text(concat,join,toUpperCase), instance Text String
 
+import Data.Array
 import qualified Data.Map as DM
 import Text.Encodings.Base64
 
@@ -93,25 +94,24 @@ bclength (BCJmpT i) = 2
 bclength (BCJmpF i) = 2
 bclength _ = 1
 
-toByteVal :: BC -> [Char]
-toByteVal b
-# bt = toChar $ consIndex{|*|} b
-= [bt:case b of
+toByteVal :: BC -> String
+toByteVal b = {toChar $ consIndex{|*|} b} +++
+       case b of
                (BCPush i) = i
-               (BCLab i) = [toChar i]
-               (BCSdsStore i) = [c\\c<-:to16bit i]
-               (BCSdsFetch i) = [c\\c<-:to16bit i]
-               (BCSdsPublish i) = [c\\c<-:to16bit i]
-               (BCAnalogRead i) = [toChar i]
-               (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]
-               _ = []]
+               (BCLab i) = {toChar i}
+               (BCSdsStore i) = to16bit i
+               (BCSdsFetch i) = to16bit i
+               (BCSdsPublish i) = to16bit i
+               (BCAnalogRead i) = {toChar i}
+               (BCAnalogWrite i) = {toChar i}
+               (BCDigitalRead i) = {toChar i}
+               (BCDigitalWrite i) = {toChar i}
+               (BCLedOn i) = toByteCode i
+               (BCLedOff i) = toByteCode i
+               (BCJmp i) = {toChar i}
+               (BCJmpT i) = {toChar i}
+               (BCJmpF i) = {toChar i}
+               _ = ""
 
 instance Semigroup (ByteCode a p) where
        mappend m n = BC \s->let (b1, (b2, t)) = runBC m <$> runBC m s in (b1 ++ b2, t)
@@ -132,27 +132,42 @@ retrn = BC o tuple
 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 toByteCode b = toByteCode $ if b 1 0
-instance toByteCode Int where toByteCode n = map toChar [n/256,n rem 256]
+instance toByteCode Bool where toByteCode b = if b "\x01" "\x00"
+instance toByteCode Int where toByteCode n = {toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Long where toByteCode (L n) = toByteCode n
-instance toByteCode Char where toByteCode c = [c]
+instance toByteCode Char where toByteCode s = toString s
 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 toByteCode Button where toByteCode s = {toChar $ consIndex{|*|} s}
+instance toByteCode UserLED where toByteCode s = {toChar $ consIndex{|*|} s}
 instance toByteCode MTaskInterval where
        toByteCode OneShot = toByteCode 0
        //Intervals have the first bit 0 and the rest is a 15 bit unsigned int
-       toByteCode (OnInterval i) = map toChar [i/256 bitand 127, i rem 256]
+       toByteCode (OnInterval i) = {toChar $ i/256 bitand 127, toChar $ i rem 256}
        //Intervals have the first bit 1 and the rest is a 15 bit unsigned int
-       toByteCode (OnInterrupt i) = map toChar [i/256 bitor 128, i rem 256]
+       toByteCode (OnInterrupt i) = {toChar $ i/256 bitor 127, toChar $ i rem 256}
+
+instance fromByteCode Bool where fromByteCode s = s == "\x01"
+instance fromByteCode Int where fromByteCode s = (toInt s.[0])*256 + toInt s.[1]
+instance fromByteCode Long where fromByteCode s = L $ fromByteCode s
+instance fromByteCode Char where fromByteCode s = toChar s.[0]
+instance fromByteCode String where fromByteCode s = undef
+instance fromByteCode Button where fromByteCode s = fromJust $ consByName s
+instance fromByteCode UserLED where fromByteCode s = fromJust $ consByName s
+instance fromByteCode MTaskInterval
+       where
+               fromByteCode s
+               //Interval
+               | (toInt s.[0]) bitand 128 == 0 = case fromByteCode s of
+                       0 = OneShot
+                       i = OnInterval i
+               = OnInterrupt $ fromByteCode s bitand 127
 
 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, UserLED
-derive consName BC, Pin, Button
+derive gPrint BC
+derive class gCons BC
 
 instance arith ByteCode where
        lit x = retrn [BCPush $ toByteCode x]
@@ -234,8 +249,8 @@ instance serial ByteCode where
        serialParseInt = retrn [BCSerialParseInt]
 
 instance userLed ByteCode where
-       ledOn l = retrn [BCLedOn $ toByteCode l]
-       ledOff l = retrn [BCLedOff $ toByteCode l]
+       ledOn l = retrn [BCLedOn l]
+       ledOff l = retrn [BCLedOff l]
 
 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}
@@ -257,11 +272,9 @@ computeGotos [BCLab l:xs] i = appSnd ('DM'.put l i) (computeGotos xs i)
 computeGotos [x:xs] i = appFst (\bc->[x:bc]) (computeGotos xs (i+(bclength x)))
 
 readable :: BC -> String
-readable (BCPush d) = "BCPush " +++ concat (map safe d)
+readable (BCPush d) = "BCPush " +++ concat [safe c\\c<-:d]
        where
-               safe c
-               | isControl c = "\\d" +++ toString (toInt c)
-               = toString c
+               safe c = if (isControl c) ("\\d" +++ toString (toInt c)) (toString c)
 readable b = printToString b
 
 toReadableByteCode :: (ByteCode a b) -> (String, BCState)