update specs

[mTask.git] / mTaskInterpret.icl

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 5504a21..2d2005a 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -126,7 +126,7 @@ parseBCValue c s = case c of
 castfbc :: a -> (String -> a) | mTaskType a
 castfbc _ = fromByteCode
 
 castfbc :: a -> (String -> a) | mTaskType a
 castfbc _ = fromByteCode
 

-instance toByteCode Bool where toByteCode b = {#'b',if b '\x01' '\0'}
+instance toByteCode Bool where toByteCode b = {'b',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',c}
 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',c}


@@ -160,11 +160,14 @@ instance fromByteCode MTaskInterval
                = OnInterrupt $ fromByteCode s bitand 127
 instance fromByteCode MTaskDeviceSpec where
        fromByteCode s = let c = toInt s.[0] in
                = OnInterrupt $ fromByteCode s bitand 127
 instance fromByteCode MTaskDeviceSpec where
        fromByteCode s = let c = toInt s.[0] in

-               {MTaskDeviceSpec
-               |haveLed=(c bitand 1) > 0
-               ,haveAio=(c bitand 2) > 0
-               ,haveDio=(c bitand 4) > 0
-               ,bytesMemory=from16bit $ s % (1,3)
+               { MTaskDeviceSpec
+               | haveLed     = (c bitand 1) > 0
+               , haveAio     = (c bitand 2) > 0
+               , haveDio     = (c bitand 4) > 0
+               , bytesMemory = from16bit $ s % (1,3)
+               , stackSize  = from16bit $ s % (3,5)
+               , aPins       = toInt s.[5]
+               , dPins       = toInt s.[6]

                }
 
 derive gPrint Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC, MTaskDeviceSpec
                }
 
 derive gPrint Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC, MTaskDeviceSpec


@@ -198,12 +201,13 @@ 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, MTaskDeviceSpec
 
 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec
 

-op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b Expr
+op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b p3

 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc]
 
 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc]
 

-op :: (ByteCode a p) BC -> ByteCode a Expr
+op :: (ByteCode a p) BC -> ByteCode b c

 op (BC x) bc = BC $ x >>| tell [bc]
 
 op (BC x) bc = BC $ x >>| tell [bc]
 

+tell` :: [BC] -> (ByteCode a p)

 tell` x = BC $ tell x
 
 instance arith ByteCode where
 tell` x = BC $ tell x
 
 instance arith ByteCode where


@@ -233,7 +237,7 @@ instance digitalIO ByteCode where
        digitalWrite p b = op b (BCDigitalWrite $ pin p)
 
 instance aIO ByteCode where
        digitalWrite p b = op b (BCDigitalWrite $ pin p)
 
 instance aIO ByteCode where

-       aIO p = undef
+       aIO p = tell` [BCAnalogRead $ pin p]

 
 instance dIO ByteCode where
        dIO p = tell` [BCDigitalRead $ pin p]
 
 instance dIO ByteCode where
        dIO p = tell` [BCDigitalRead $ pin p]


@@ -251,11 +255,12 @@ BCIfStmt (BC b) (BC t) (BC e) = BC $
        t >>| tell [BCJmp endif, BCLab else] >>|
        e >>| tell [BCLab endif]
 
        t >>| tell [BCJmp endif, BCLab else] >>|
        e >>| tell [BCLab endif]
 

-freshl = get >>= \st=:{freshl=[fr:frs]}->put {st & freshl=frs} >>| pure fr
-freshs = get >>= \st=:{freshs=[fr:frs]}->put {st & freshs=frs} >>| pure fr
+freshl = get >>= \st=:{freshl}->put ({st & freshl=freshl+1}) >>| pure freshl
+freshs = get >>= \st=:{freshs}->put ({st & freshs=freshs+1}) >>| pure freshs

 
 instance noOp ByteCode where noOp = tell` [BCNop]
 
 
 instance noOp ByteCode where noOp = tell` [BCNop]
 

+unBC :: (ByteCode a p) -> RWS () [BC] BCState ()

 unBC (BC x) = x
 
 instance sds ByteCode where
 unBC (BC x) = x
 
 instance sds ByteCode where


@@ -268,6 +273,8 @@ instance sds ByteCode where
                        addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
 
        con f = undef
                        addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
 
        con f = undef

+
+instance sdspub ByteCode where

        pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s]) x
 
 instance assign ByteCode where
        pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s]) x
 
 instance assign ByteCode where


@@ -290,14 +297,14 @@ instance serial ByteCode where
        serialParseInt = tell` [BCSerialParseInt]
 
 instance userLed ByteCode where
        serialParseInt = tell` [BCSerialParseInt]
 
 instance userLed ByteCode where

-       ledOn  (BC l) = BC $ l >>| tell [BCLedOn]
-       ledOff (BC l) = BC $ l >>| tell [BCLedOff]
+       ledOn  l = op l BCLedOn
+       ledOff l = op l BCLedOff

 
 instance retrn ByteCode where
   retrn = tell` [BCReturn]
 
 instance zero BCState where
 
 instance retrn ByteCode where
   retrn = tell` [BCReturn]
 
 instance zero BCState where

-       zero = {freshl=[1..], freshs=[1..], sdss=[]}
+       zero = {freshl=1, freshs=1, sdss=[]}

 
 toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)
 toRealByteCode x s
 
 toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)
 toRealByteCode x s


@@ -358,15 +365,21 @@ toMessages interval x s
 instance == BCShare where (==) a b = a.sdsi == b.sdsi
 
 //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero
 instance == BCShare where (==) a b = a.sdsi == b.sdsi
 
 //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero

-Start = fst $ toReadableByteCode (unMain $ countAndLed) zero
+Start = fst $ toReadableByteCode (unMain $ bc) zero

 //Start = fst $ toReadableByteCode (unMain $ blink LED1) zero
 //Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
 //             in (bcs, st.sdss)
        where
 //             bc = {main = ledOn (lit LED1)}
 //Start = fst $ toReadableByteCode (unMain $ blink LED1) zero
 //Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
 //             in (bcs, st.sdss)
        where
 //             bc = {main = ledOn (lit LED1)}

-               bc = sds \x=5 In 
-                       sds \y=4 In
-                       {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
+//             bc = sds \x=5 In 
+//                     sds \y=4 In
+//                     {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
+               bc  = {main =
+                       IF (analogRead A0 >. lit 50)
+                         ( digitalWrite D0 (lit True)  )
+                         ( digitalWrite D0 (lit False) )
+                       }
+

 
 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))
 
 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))