From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 21 Jun 2017 07:23:29 +0000 (+0200)
Subject: named sds's
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=3fe035b92e9bc0b745c57db64e78461b2f36b6d1;p=mTask.git

named sds's
---

diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl
index dc57231..5373d50 100644
--- a/Devices/mTaskTCP.icl
+++ b/Devices/mTaskTCP.icl
@@ -24,7 +24,8 @@ instance MTaskDuplex TCPSettings where
 				onConnect=onConnect,
 				onData=onData,
 				onShareChange=onShareChange,
-				onDisconnect=onDisconnect} >>= \_->viewInformation "done" [] "done" @! ()
+				onDisconnect=onDisconnect}
+				>>| throw "Device disconnected"
 		where
 			onConnect :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
 			onConnect acc (msgs,send,sendStopped)
diff --git a/Makefile b/Makefile
index f8054da..1a570a5 100644
--- a/Makefile
+++ b/Makefile
@@ -7,11 +7,13 @@ ifeq "$(GCCVERSIONGTEQ6)" "1"
 	override CLMFLAGS+=-l -no-pie
 endif
 
+ITASKS:=~/projects/iTasks-SDK/Libraries
+
 #	-I ~/projects/iTasks-SDK/Libraries
 CLMLIBS:=\
 	-I $(CLEAN_HOME)/lib/Platform\
 	-I $(CLEAN_HOME)/lib/Platform/Deprecated/StdLib\
-	-I ~/projects/iTasks-SDK/Libraries\
+	-I $(ITASKS)\
 	-I $(CLEAN_HOME)/lib/GraphCopy\
 	-I $(CLEAN_HOME)/lib/Sapl\
 	-I $(CLEAN_HOME)/lib/StdEnv\
@@ -24,7 +26,8 @@ BINARIES:= mTaskInterpret miTask # mTaskExamples
 
 all: CleanSerial/Clean\ System\ Files/TTY.o $(BINARIES) #client/mTaskSymbols.h
 	mkdir -p miTask-www
-	find ~/projects/iTasks-SDK/Libraries -path '*/WebPublic' -execdir sh -c 'cp -nvR WebPublic/* '"$$PWD"/miTask-www/ \;
+	find $(ITASKS) -path '*/WebPublic' -execdir sh -c 'cp -nvR WebPublic/* '"$$PWD"/miTask-www/ \;
+
 CleanSerial/Clean\ System\ Files/TTY.o:
 	make -C CleanSerial
 
@@ -35,7 +38,9 @@ client/mTaskSymbols.h: mTaskMakeSymbols
 %: %.icl $(wildcard */*.[id]cl *.[id]cl)
 	$(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@
 
-clean:
-	$(RM) -r $(BINARIES) Clean\ System\ Files miTask-data miTask-www
-	find . -type d -name 'Clean System Files' -print0 | xargs -r0 rm -r
+clean-%:
+	$(RM) -r $(addprefix $(@:clean-%=%),-data -www) $(@:clean-%=%)
+
+clean: $(addprefix clean-,$(BINARIES))
+	find . -type d -name 'Clean System Files' -print0 | xargs -r0 $(RM) -r
 	make -C CleanSerial clean
diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl
index 2ba97cb..6cd08a9 100644
--- a/Shares/mTaskShare.dcl
+++ b/Shares/mTaskShare.dcl
@@ -9,15 +9,16 @@ derive class iTask MTaskShare
 derive gPrint BCState
 
 :: MTaskShare =
-		{withTask :: [String]
-		,identifier :: Int
-		,value :: BCValue
+		{withTask  :: [String]
+		,identifier:: Int
+		,value     :: BCValue
+		,humanName :: String
 		}
 
 instance == MTaskShare
 
 //Constructor
-makeShare :: String Int BCValue -> MTaskShare
+makeShare :: String String Int BCValue -> MTaskShare
 
 //General viewing task
 manageShares :: Task [MTaskDevice]
diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index fda2a39..e8ed9a2 100644
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -60,11 +60,12 @@ updateShares dev tfun = upd (map upFun) (sdsFocus (Just (dev, -1)) deviceStore)
 //viewShare m = viewSharedInformation "" [] (getSDSShare m)
 //	<<@ Title ("SDS: " +++ toString m.identifier)
 
-makeShare :: String Int BCValue -> MTaskShare
-makeShare withTask identifier value = {MTaskShare
+makeShare :: String String Int BCValue -> MTaskShare
+makeShare withTask human identifier value = {MTaskShare
 		|withTask=[withTask]
 		,identifier=identifier
 		,value=value
+		,humanName=human
 		}
 
 import GenPrint, StdMisc, StdDebug, TTY
@@ -145,4 +146,4 @@ updateShareFromPublish dev ident val = set val
 	$ mapReadWriteError (deviceLens dev dummy)
 	$ deviceStoreNP
 where
-	dummy = {MTaskShare|value=BCValue 0,identifier=ident,withTask=[]}
+	dummy = {MTaskShare|humanName="",value=BCValue 0,identifier=ident,withTask=[]}
diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl
index c36d0d2..e828257 100644
--- a/Tasks/mTaskTask.icl
+++ b/Tasks/mTaskTask.icl
@@ -9,7 +9,7 @@ import iTasks._Framework.Serialization
 derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, RWST, Identity
 
 makeTask :: String Int -> Task MTaskTask
-makeTask name ident = get currentDateTime 
+makeTask name ident = get currentDateTime
 	@ \dt->{MTaskTask | name=name,ident=ident,dateAdded=dt}
 
 import StdDebug
@@ -17,9 +17,9 @@ import StdMisc
 sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task [MTaskDevice]
 sendTaskToDevice wta mTask (device, timeout)
 | not (trace_tn "compiling task") = undef
-# (msgs, newState) = toMessages timeout mTask device.deviceState
+# (msgs, newState=:{sdss}) = toMessages timeout mTask device.deviceState
 | not (trace_tn "Done compiling task") = undef
-# shares = [makeShare wta sdsi sdsval\\{sdsi,sdsval}<-newState.sdss, (MTSds sdsi` _)<-msgs | sdsi == sdsi`] 
+# shares = [makeShare wta "" sdsi sdsval\\{sdsi,sdsval}<-sdss, (MTSds sdsi` _)<-msgs | sdsi == sdsi`]
 = updateShares device ((++) shares)
 	>>| sendMessages msgs device
 	>>| makeTask wta -1
@@ -28,3 +28,9 @@ sendTaskToDevice wta mTask (device, timeout)
 		addTaskUpState :: BCState MTaskTask MTaskDevice -> MTaskDevice
 		addTaskUpState st task device = { MTaskDevice | device &
 			deviceState=st, deviceTasks=[task:device.deviceTasks]}
+
+//liftmTask :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task a
+//liftmTask wta mTask (device, timeout)
+//	= sendTaskToDevice wta mTask (device, timeout)
+//	>>| wait "waiting for task to return" $ sdsFocus
+//	>>| treturn 
diff --git a/client/task.c b/client/task.c
index 266029f..6e7ae0c 100644
--- a/client/task.c
+++ b/client/task.c
@@ -92,7 +92,7 @@ void task_delete(uint8_t c)
 		}
 		t = task_next(t);
 	}
-        //Write acknowledgement
+        //Write deletion spec
         write_byte('d');
         write16(c);
         write_byte('\n');
diff --git a/mTask.dcl b/mTask.dcl
index 955b28a..2a82679 100644
--- a/mTask.dcl
+++ b/mTask.dcl
@@ -90,6 +90,8 @@ class var2 v where
 class sds v where
   sds :: ((v t Upd)->In t (Main (v c s))) -> (Main (v c s)) | type, mTaskType, toCode t
   con :: ((v t Expr)  ->In t (Main (v c s))) -> (Main (v c s)) | type t
+class namedsds v where
+  namedsds :: ((v t Upd)->In (Named t String) (Main (v c s))) -> (Main (v c s)) | type, mTaskType, toCode t
 class sdspub v where
   pub :: (v t Upd) -> v t Expr | type t
 class seq v where
@@ -192,6 +194,7 @@ instance typeSelector Bool
 instance typeSelector a
 
 :: In a b = In infix 0 a b
+:: Named a b = Named infix 1 a b
 
 read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
 
diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 7e8d4b4..3e7513f 100644
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -118,9 +118,10 @@ derive gEq BCValue
 
 :: ByteCode a p = BC (RWS () [BC] BCState ())
 
-:: BCShare = {
-		sdsi :: Int,
-		sdsval :: BCValue
+:: BCShare =
+	{ sdsi :: Int
+	, sdsval :: BCValue
+	, sdsname :: String
 	}
 
 :: BCState = {
diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 3f82f97..164db5e 100644
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -265,15 +265,23 @@ unBC (BC x) = x
 
 instance sds ByteCode where
 	sds f = {main = BC $ freshs
-				>>= \sdsi->pure {BCShare | sdsi=sdsi,sdsval=BCValue 0}
-				>>= \sds->pure (f (tell` [BCSdsFetch sds]))
-				>>= \(v In bdy)->modify (addSDS sds v)
-				>>| unBC (unMain bdy)}
-		where
-			addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
-
+		>>= \sdsi->pure {BCShare | sdsname="", sdsi=sdsi, sdsval=BCValue 0}
+		>>= \sds ->pure (f $ tell` [BCSdsFetch sds])
+		>>= \(v In bdy)->modify (addSDS sds v)
+		>>| unBC (unMain bdy)}
+	where
+		addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}
 	con f = undef
 
+instance namedsds ByteCode where
+	namedsds f = {main = BC $ freshs
+		>>= \sdsi->pure {BCShare | sdsname="", sdsi=sdsi, sdsval=BCValue 0}
+		>>= \sds ->pure (f $ tell` [BCSdsFetch sds])
+		>>= \(v Named n In bdy)->modify (addSDS sds n v)
+		>>| unBC (unMain bdy)}
+	where
+		addSDS sds n v s = {s & sdss=[{sds & sdsname=n, sdsval=BCValue v}:s.sdss]}
+
 instance sdspub ByteCode where
 	pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s]) x
 
@@ -365,12 +373,14 @@ 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 $ p0) zero
-		,'Text'.concat $ compile p0
-		]
+//Start = [fst $ toReadableByteCode (unMain $ p0) zero
+//		,'Text'.concat $ compile p0
+//		]
+Start = toReadableByteCode (unMain $ p0) zero
 	where
-		p0 :: (Main (a Int Expr)) | assign a & arith a & sds a
-		p0 = sds \x = 6 In {main = x =. x *. lit 7}
+		p0 :: (Main (a Int Expr)) | assign, namedsds, sds, arith a
+//		p0 = sds \x = 6 In {main = x =. x *. lit 7}
+		p0 = namedsds \x = 6 Named "x" In {main = x =. x *. lit 7}
 
 		bc  = {main =
 			IF (analogRead A0 >. lit 50)