From b845b58e2d90207476029812179f81968cd45108 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 6 Jun 2017 18:17:45 +0200 Subject: [PATCH] updates --- Devices/mTaskDevice.dcl | 12 ++++++------ Devices/mTaskDevice.icl | 35 ++++++++++++++++++++++------------- mTaskInterpret.icl | 28 ++++++++++++++++++---------- miTask.icl | 2 +- 4 files changed, 47 insertions(+), 30 deletions(-) diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl index b1c7acc..dc097f5 100644 --- a/Devices/mTaskDevice.dcl +++ b/Devices/mTaskDevice.dcl @@ -36,18 +36,18 @@ instance == MTaskDevice class MTaskDuplex a where synFun :: a (Shared Channels) -> Task () -withDevice :: (MTaskDevice -> Task a) String -> Task a | iTask a +withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task [MTaskDevice] +//withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () startupDevices :: Task [MTaskDevice] -connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task () +connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task () sendMessages :: [MTaskMSGSend] MTaskDevice -> Task Channels sendMessagesIW :: [MTaskMSGSend] MTaskDevice *IWorld -> *(MaybeError TaskException (), *IWorld) -withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () deviceTaskDelete :: MTaskDevice MTaskTask -> Task () -deviceTaskAcked :: MTaskDevice Int Int -> Task () -deviceTaskDeleteAcked :: MTaskDevice Int -> Task () -deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task () +deviceTaskAcked :: MTaskDevice Int Int -> Task [MTaskDevice] +deviceTaskDeleteAcked :: MTaskDevice Int -> Task [MTaskDevice] +deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task [MTaskDevice] diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 378a5e3..0116b57 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -69,14 +69,23 @@ addDevice devices processFun deviceTypes :: [MTaskResource] deviceTypes = conses{|*|} -connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task () -connectDevice pf d = let ch = channels d in appendTopLevelTask 'DM'.newMap True - (pf d ch -||- catchAll (getSynFun d.deviceData ch) errorHandle) - >>= \tid->withDevices d (\d->{d&deviceTask=Just tid,deviceError=Nothing}) - >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch - @! () +//connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task () +//connectDevice pf d = let ch = channels d in appendTopLevelTask 'DM'.newMap True +// (pf d ch -||- catchAll (getSynFun d.deviceData ch) errorHandle) +// >>= \tid->withDevices d (\d->{d&deviceTask=Just tid,deviceError=Nothing}) +// >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch +// @! () +// where +// errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e}) @! () +connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels +connectDevice procFun device = let ch = channels device + in appendTopLevelTask 'DM'.newMap True + ( procFun device ch + -||- catchAll (getSynFun device.deviceData ch) errHdl) + >>= \tid->withDevices device (\d->{d&deviceTask=Just tid,deviceError=Nothing}) + >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch where - errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e}) + errHdl e = withDevices device (\d->{d & deviceTask=Nothing, deviceError=Just e}) @! () manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task () manageDevices processFun ds = anyTask [ @@ -96,7 +105,7 @@ viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask ] <<@ ArrangeHorizontal >>* [OnAction (Action "Delete Device") (always $ deleteDevice d): if (isJust d.deviceTask) [] - [OnAction (Action "Connect") (always $ connectDevice pf d)]] + [OnAction (Action "Connect") (always $ connectDevice pf d @! ())]] where dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) @@ -119,10 +128,10 @@ sendMessagesIW msgs dev iworld realMessageSend :: [MTaskMSGSend] Channels -> Channels realMessageSend msgs (r,s,ss) = (r,msgs++s,ss) -withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () -withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! () +withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task [MTaskDevice] +withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore -deviceTaskAcked :: MTaskDevice Int Int -> Task () +deviceTaskAcked :: MTaskDevice Int Int -> Task [MTaskDevice] deviceTaskAcked dev i mem = withDevices dev (\d->{d &deviceTasks=ackFirst d.deviceTasks @@ -136,10 +145,10 @@ deviceTaskAcked dev i mem deviceTaskDelete :: MTaskDevice MTaskTask -> Task () deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! () -deviceTaskDeleteAcked :: MTaskDevice Int -> Task () +deviceTaskDeleteAcked :: MTaskDevice Int -> Task [MTaskDevice] deviceTaskDeleteAcked d i = cleanSharesTask i d >>| withDevices d deleteTask where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]} -deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task () +deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task [MTaskDevice] deviceAddSpec d s = withDevices d $ \r->{MTaskDevice | r & deviceSpec=Just s} diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 5504a21..f1eeedc 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -126,7 +126,7 @@ parseBCValue c s = case c of 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} @@ -198,12 +198,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 -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] -op :: (ByteCode a p) BC -> ByteCode a Expr +op :: (ByteCode a p) BC -> ByteCode b c op (BC x) bc = BC $ x >>| tell [bc] +tell` :: [BC] -> (ByteCode a p) tell` x = BC $ tell x instance arith ByteCode where @@ -233,7 +234,7 @@ instance digitalIO 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] @@ -256,6 +257,7 @@ freshs = get >>= \st=:{freshs=[fr:frs]}->put {st & freshs=frs} >>| pure fr instance noOp ByteCode where noOp = tell` [BCNop] +unBC :: (ByteCode a p) -> RWS () [BC] BCState () unBC (BC x) = x instance sds ByteCode where @@ -290,8 +292,8 @@ instance serial 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] @@ -358,15 +360,21 @@ toMessages interval x s 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)} - 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)) diff --git a/miTask.icl b/miTask.icl index f044e36..558462c 100644 --- a/miTask.icl +++ b/miTask.icl @@ -85,7 +85,7 @@ mTaskManager = (>>|) startupDevices $ // MTSDSAck i = traceValue (toString m) @! () // MTSDSDelAck i = traceValue (toString m) @! () MTPub i val = updateShareFromPublish device i val @! () - MTTaskAck i mem = deviceTaskAcked device i mem + MTTaskAck i mem = deviceTaskAcked device i mem @! () MTTaskDelAck i = deviceTaskDeleteAcked device i @! () MTDevSpec s = deviceAddSpec device s @! () _ = treturn () -- 2.20.1