where
sharename i = device.deviceChannels +++ "-" +++ toString i
toSDSRecords st = [{MTaskShare |
- initValue=toInt (sdsval!!0)*265 + toInt (sdsval!!1),
withTask=wta,
identifier=sdsi,
//We skip the only/local shares
realShare="mTaskSDS-" +++ toString sdsi}
\\{sdsi,sdspub,sdsval}<-st.sdss | sdspub]
- makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
+
+ makeShares :: ([MTaskShare] -> Task ())
+ makeShares = undef //foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
addTask :: MTaskTask MTaskDevice -> MTaskDevice
addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
ARDSL project
*/
+from Data.Maybe import :: Maybe
import StdGeneric
+class gCons a | conses{|*|}, consName{|*|}, consIndex{|*|} a
+
+consByName :: String -> Maybe a | conses{|*|}, consName{|*|} a
+
generic consName a :: a -> String
derive consName CONS of {gcd_name},UNIT,PAIR,EITHER,OBJECT,FIELD,RECORD,Int,Bool,Char,Real,String,(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),{},{!},[],[! ],[ !],[!!]
*/
import StdEnv, StdGeneric, GenBimap, _SystemStrictLists
+import Data.Functor
import Data.List
+import Data.Maybe
+
+consByName :: String -> Maybe a | conses{|*|}, consName{|*|} a
+consByName a = let cs = conses{|*|}
+ in ((!!) cs) <$> elemIndex a (map consName{|*|} cs)
+
generic consName a :: a -> String
consName{|CONS of {gcd_name}|} f x = gcd_name
import iTasks
:: MTaskShare = {
- initValue :: Int,
withTask :: String,
identifier :: Int,
realShare :: String
) @! ()
-updateShare :: MTaskShare a -> Task MTaskShare | toByteCode a
+updateShare :: MTaskShare a -> Task MTaskShare | toByteCode, iTask a
updateShare sh=:{withTask,identifier} a = getDeviceByName withTask
>>= sendMessages [MTUpd identifier $ toString $ toByteCode a]
>>| treturn sh
viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal @! ()
viewShare :: MTaskShare -> Task ()
-viewShare m = viewSharedInformation "" [] (getSDSStore m)
- <<@ Title ("SDS: " +++ toString m.identifier) @! ()
+viewShare m = treturn ()//viewSharedInformation "" [] (getSDSStore m)
+ //<<@ Title ("SDS: " +++ toString m.identifier) @! ()
instance zero MTaskShare where
- zero = {initValue=0,withTask="",identifier=0,realShare=""}
+ zero = {withTask="",identifier=0,realShare=""}
import iTasks._Framework.Serialization
-derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState
+derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, UserLED
makeTask :: String Int -> Task MTaskTask
makeTask name ident = get currentDateTime
bcStateStore :: Shared BCState
mTaskTaskStore :: Shared [String]
-getSDSStore :: MTaskShare -> Shared Int
+getSDSStore :: MTaskShare -> Shared a | iTask, mTaskType a
getSDSRecord :: Int -> Task MTaskShare
mTaskTaskStore :: Shared [String]
mTaskTaskStore = memoryShare "mTaskTasks" $ 'DM'.keys allmTasks
-getSDSStore :: MTaskShare -> Shared Int
-getSDSStore sh = memoryShare sh.realShare 0
+getSDSStore :: MTaskShare -> Shared a | iTask, mTaskType a
+getSDSStore sh = memoryShare sh.realShare zero
getSDSRecord :: Int -> Task MTaskShare
getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]
imporove setp: >>*.
*/
+import GenPrint
import Generics.gCons
import Generics.gdynamic
// ----- tools ----- //
-derive consName DigitalPin, AnalogPin, PinMode
+derive gPrint Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
+derive class gCons Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
instance == DigitalPin
instance == AnalogPin
-derive consIndex DigitalPin, AnalogPin
-
tab =: toString (repeatn tabSize ' ')
tabSize :== 2
import Generics.gdynamic
import iTasks
-import GenEq, StdMisc, StdArray
+import GenEq, StdMisc, StdArray, GenBimap
import mTaskCode
import mTaskSerial, mTaskLCD
instance == DigitalPin where (==) x y = x === y
instance == AnalogPin where (==) x y = x === y
-derive consName DigitalPin, AnalogPin, PinMode
-derive consIndex DigitalPin, AnalogPin
+derive gPrint Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
+derive class gCons Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
+
tab =: toString (repeatn tabSize ' ')
tabSize :== 2
:: BC
= BCNop
| BCLab Int
- | BCPush [Char]
+// | E.e: BCPush e & toByteCode e
+ | BCPush String
| BCPop
//SDS functions
| BCSdsStore Int
| BCJmpT Int
| BCJmpF Int
//UserLED
- | BCLedOn [Char]
- | BCLedOff [Char]
+ | BCLedOn UserLED
+ | BCLedOff UserLED
//Serial
| BCSerialAvail
| BCSerialPrint
| BCDigitalWrite Pin
| BCTest AnalogPin
+derive gPrint BC
+derive class gCons BC
+
:: ByteCode a p = BC (BCState -> ([BC], BCState))
instance Semigroup (ByteCode a p)
instance Monoid (ByteCode a p)
:: BCShare = {
sdsi :: Int,
sdspub :: Bool,
- sdsval :: [Char]
+ sdsval :: String
}
:: BCState = {
}
instance zero BCState
-class toByteCode a :: a -> [Char]
-instance toByteCode Int
-instance toByteCode Bool
-instance toByteCode Char
-instance toByteCode String
-instance toByteCode Long
-instance toByteCode Button
-instance toByteCode UserLED
-//instance toByteCode MTaskInterval
+class toByteCode a :: a -> String
+class fromByteCode a :: String -> a
+class mTaskType a | toByteCode, fromByteCode, zero a
+
+instance toByteCode Int, Bool, Char, Long, String, Button, UserLED
+instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED
+instance toByteCode MTaskInterval
+instance fromByteCode MTaskInterval
instance toChar Pin
instance arith ByteCode
instance analogIO ByteCode
instance digitalIO ByteCode
instance userLed ByteCode
-//instance If ByteCode Stmt Stmt Stmt
-//instance If ByteCode e Stmt Stmt
-//instance If ByteCode Stmt e Stmt
+instance If ByteCode Stmt Stmt Stmt
+instance If ByteCode e Stmt Stmt
+instance If ByteCode Stmt e Stmt
instance If ByteCode x y Stmt
instance IF ByteCode
instance noOp ByteCode
toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState)
toSDSUpdate :: Int Int -> [MTaskMSGSend]
-toByteVal :: BC -> [Char]
+toByteVal :: BC -> String
toReadableByteCode :: (ByteCode a b) -> (String, BCState)
toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)
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
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)
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]
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=[]}
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)
import GenEq, StdMisc, StdArray
import mTask
-derive consIndex Button
derive toGenDynamic LCD
derive fromGenDynamic LCD
import GenEq, StdMisc, StdArray, GenBimap
import GenPrint
import mTask
+import mTaskInterpret
import StdEnum
import StdFile
import Data.List
from Text import class Text(join,toUpperCase), instance Text String
-derive consIndex BC, Pin
-derive consName BC, Pin
-derive conses BC, AnalogPin, DigitalPin, Pin
-
(<+) infixr 5 :: a b -> String | toString a & toString b
(<+) a b = toString a +++ toString b
repositories / mTask.git / commitdiff