formalized bytecode conversions

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index a6b7b61..92f6683 100644 (file)
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -119,11 +119,10 @@ class fromByteCode a :: String -> a
 class mTaskType a | toByteCode, fromByteCode, iTask, TC a
 
 instance toByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue
 class mTaskType a | toByteCode, fromByteCode, iTask, TC a
 
 instance toByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue

-instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED
+instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue

 instance toByteCode MTaskInterval
 instance fromByteCode MTaskInterval
 
 instance toByteCode MTaskInterval
 instance fromByteCode MTaskInterval
 

-instance toChar Pin

 instance arith ByteCode
 instance boolExpr ByteCode
 instance analogIO ByteCode
 instance arith ByteCode
 instance boolExpr ByteCode
 instance analogIO ByteCode

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 873e250..8da4585 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -2,6 +2,8 @@ implementation module mTaskInterpret
 
 import Generics.gCons
 
 
 import Generics.gCons
 

+from iTasks.UI.Editor.Common import emptyEditor
+

 import GenEq, StdMisc, StdArray, GenBimap
 import GenPrint
 import StdEnum
 import GenEq, StdMisc, StdArray, GenBimap
 import GenPrint
 import StdEnum


@@ -91,38 +93,40 @@ instance toString MTaskMSGRecv where
 toByteVal :: BC -> String
 toByteVal b = {toChar $ consIndex{|*|} b} +++
        case b of
 toByteVal :: BC -> String
 toByteVal b = {toChar $ consIndex{|*|} b} +++
        case b of

-               (BCPush i) = toByteCode i
+               (BCPush (BCValue i)) = toByteCode i

                (BCLab i) = {toChar i}
                (BCSdsStore i) = to16bit i
                (BCSdsFetch i) = to16bit i
                (BCSdsPublish i) = to16bit 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}
+               (BCAnalogRead i) = {toChar $ consIndex{|*|} i}
+               (BCAnalogWrite i) = {toChar $ consIndex{|*|} i}
+               (BCDigitalRead i) = {toChar $ consIndex{|*|} i}
+               (BCDigitalWrite i) = {toChar $ consIndex{|*|} i}

                (BCJmp i) = {toChar i}
                (BCJmpT i) = {toChar i}
                (BCJmpF i) = {toChar i}
                _ = ""
 
                (BCJmp i) = {toChar i}
                (BCJmpT i) = {toChar i}
                (BCJmpF i) = {toChar i}
                _ = ""
 

-instance toByteCode BCValue where toByteCode (BCValue v) = toByteCode v
-instance toByteCode Bool where toByteCode b = toByteCode $ if b 1 0
-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 = toByteCode $ toInt c
+parseBCValue :: Char String -> BCValue
+parseBCValue c s = case c of
+       'b' = BCValue $ castfbc True s
+       'i' = BCValue $ castfbc 0 s
+       'l' = BCValue $ castfbc (L 0) s
+       'c' = BCValue $ castfbc ('0') s
+       'B' = BCValue $ castfbc (NoButton) s
+       'L' = BCValue $ castfbc (LED1) s
+
+castfbc :: a -> (String -> a) | mTaskType a
+castfbc _ = fromByteCode
+
+instance toByteCode Bool where toByteCode b = {#'b','\0',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','\0',c}

 instance toByteCode String where toByteCode s = abort $ "Undef on toBytecode String" +++ s
 instance toByteCode String where toByteCode s = abort $ "Undef on toBytecode String" +++ s

-instance toByteCode Button where toByteCode s = toByteCode $ consIndex{|*|} s
-instance toByteCode UserLED where toByteCode s = toByteCode $ 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) = {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) = {toChar $ i/256 bitor 127, toChar $ i rem 256}
-
-//parseByteCode :: String -> BCValue
-//parseByteCode "b" = BCValue True
-//parseByteCode "i" = BCValue 0
+instance toByteCode Button where toByteCode s = {'B','\0',toChar $ consIndex{|*|} s}
+instance toByteCode UserLED where toByteCode s = {'L','\0',toChar $ consIndex{|*|} s}
+instance toByteCode BCValue where toByteCode (BCValue v) = toByteCode v

 
 instance fromByteCode Bool where fromByteCode s = fromByteCode s == 1
 instance fromByteCode Int where fromByteCode s = (toInt s.[0])*256 + toInt s.[1]
 
 instance fromByteCode Bool where fromByteCode s = fromByteCode s == 1
 instance fromByteCode Int where fromByteCode s = (toInt s.[0])*256 + toInt s.[1]


@@ -131,19 +135,14 @@ instance fromByteCode Char where fromByteCode s = fromInt $ fromByteCode s
 instance fromByteCode String where fromByteCode s = abort $ "Undef on fromBytecode String" +++ s
 instance fromByteCode Button where fromByteCode s = conses{|*|} !! fromByteCode s
 instance fromByteCode UserLED where fromByteCode s = conses{|*|} !! fromByteCode s
 instance fromByteCode String where fromByteCode s = abort $ "Undef on fromBytecode String" +++ s
 instance fromByteCode Button where fromByteCode s = conses{|*|} !! fromByteCode s
 instance fromByteCode UserLED where fromByteCode s = conses{|*|} !! fromByteCode s

-instance fromByteCode BCValue
-       where
-               fromByteCode s = let tail = subString 1 (size s) s in case s.[0] of
-                       'b' = BCValue $ castfbc True tail
-                       'i' = BCValue $ castfbc 0 tail
-                       'l' = BCValue $ castfbc (L 0) tail
-                       'c' = BCValue $ castfbc ('0') tail
-                       'B' = BCValue $ castfbc (NoButton) tail
-                       'L' = BCValue $ castfbc (LED1) tail
-               where
-                       castfbc :: a -> (String -> a) | mTaskType a
-                       castfbc _ = fromByteCode
-               
+instance fromByteCode BCValue where fromByteCode s = parseBCValue s.[0] 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) = {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) = {toChar $ i/256 bitor 127, toChar $ i rem 256}

 instance fromByteCode MTaskInterval
        where
                fromByteCode s
 instance fromByteCode MTaskInterval
        where
                fromByteCode s


@@ -153,10 +152,6 @@ instance fromByteCode MTaskInterval
                        i = OnInterval i
                = OnInterrupt $ fromByteCode s bitand 127
 
                        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 Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC
 derive class gCons BC
 
 derive gPrint Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC
 derive class gCons BC
 


@@ -166,7 +161,7 @@ conses{|BCValue|} = [BCValue 0]
 consNum{|BCValue|} _ = 1
 gPrint{|BCValue|} v ps = gPrint{|*|} (readable $ BCPush v) ps
 
 consNum{|BCValue|} _ = 1
 gPrint{|BCValue|} v ps = gPrint{|*|} (readable $ BCPush v) ps
 

-gEditor{|BCValue|} = undef
+gEditor{|BCValue|} = emptyEditor

 gText{|BCValue|} fm Nothing = []
 gText{|BCValue|} fm (Just (BCValue e)) = gText{|*|} fm (Just e)
 JSONEncode{|BCValue|} b (BCValue e) = JSONEncode{|*|} b (toByteCode e)
 gText{|BCValue|} fm Nothing = []
 gText{|BCValue|} fm (Just (BCValue e)) = gText{|*|} fm (Just e)
 JSONEncode{|BCValue|} b (BCValue e) = JSONEncode{|*|} b (toByteCode e)


@@ -175,7 +170,7 @@ JSONDecode{|BCValue|} b n = appFst (fmap fromByteCode) $ JSS b n
                JSS :: (Bool [JSONNode] -> (Maybe String, [JSONNode]))
                JSS = JSONDecode{|*|}
 gDefault{|BCValue|} = BCValue 0
                JSS :: (Bool [JSONNode] -> (Maybe String, [JSONNode]))
                JSS = JSONDecode{|*|}
 gDefault{|BCValue|} = BCValue 0

-gEq{|BCValue|} (BCValue e) (BCValue f) = False
+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
 
 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode


@@ -269,9 +264,6 @@ instance userLed ByteCode where
        ledOn  (BC l) = BC $ l >>| tell [BCLedOn]
        ledOff (BC l) = BC $ l >>| tell [BCLedOff]
 
        ledOn  (BC l) = BC $ l >>| tell [BCLedOn]
        ledOff (BC l) = BC $ l >>| tell [BCLedOff]
 

-func :: (a -> BC) [BC] -> [BC] | mTaskType a
-func f b = abort ('Text'.join "\n" (map printToString b))
-

 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}
 
 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}
 


@@ -286,7 +278,6 @@ implGotos map (BCJmpT t) = BCJmpT $ fromJust ('DM'.get t map)
 implGotos map (BCJmpF t) = BCJmpF $ fromJust ('DM'.get t map)
 implGotos _ i = i
 
 implGotos map (BCJmpF t) = BCJmpF $ fromJust ('DM'.get t map)
 implGotos _ i = i
 

-import StdDebug

 bclength :: BC -> Int
 bclength (BCPush s) = 1 + size (toByteCode s)
 bclength (BCSdsStore _) = 3
 bclength :: BC -> Int
 bclength (BCPush s) = 1 + size (toByteCode s)
 bclength (BCSdsStore _) = 3


@@ -311,7 +302,6 @@ runBC (BC x) = execRWS x ()
 toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)
 toReadableByteCode x s
 # (s, bc) = runBC x s
 toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)
 toReadableByteCode x s
 # (s, bc) = runBC x s

-| not (trace_tn $ ('Text'.join "\n" $ lineNumbers numbers bc) +++ "\n") = undef

 # (bc, gtmap) = computeGotos bc 0
 = ('Text'.join "\n" $ lineNumbers numbers (map (implGotos gtmap) bc), s)
        where
 # (bc, gtmap) = computeGotos bc 0
 = ('Text'.join "\n" $ lineNumbers numbers (map (implGotos gtmap) bc), s)
        where