Changed storage and evaluation of parallel tasks. Improves performance, but less than hoped for

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2406 63da3aa8-80fd-4f01-9db8-e6ea747a3da2

Server/API/Core/CoreCombinators.dcl

@@ -130,3 +130,8 @@ class tune b :: !b !(Task a) -> Task a
 instance tune	SetLayout				//Set layout algorithm
 instance tune	AfterLayout				//Apply a modification after a layout has been run
 instance tune	ModifyLayout			//Modify the existing layout
+
+/**
+*  Fine tune evaluation behaviour
+*/
+instance tune	LazyRefresh

Server/API/Core/CoreCombinators.icl

@@ -222,11 +222,12 @@ where
 						# rep				= parallelRep desc taskId repOpts entries
 						# values			= map (toValueAndTime o fst) entries 
 						# stable			= all (isStable o snd) values
+						# refreshSensitive	= foldr (\(e,_) s -> s || refreshSensitive e) False entries
 						# ts				= foldr max 0 [ts:map fst values]
 						# ts				= case event of
 							(FocusEvent focusId)	= if (focusId == taskId) taskTime ts
 							_						= ts
-						= (ValueResult (Value values stable) {TaskInfo|lastEvent=ts} (finalizeRep repOpts rep) (TCParallel taskId ts),{iworld & localLists = 'Map'.put taskId (map fst entries) localLists})
+						= (ValueResult (Value values stable) {TaskInfo|lastEvent=ts,refreshSensitive=refreshSensitive} (finalizeRep repOpts rep) (TCParallel taskId ts),{iworld & localLists = 'Map'.put taskId (map fst entries) localLists})
 	//Cleanup
 	eval event repOpts (TCDestroy (TCParallel taskId ts)) iworld=:{localLists}
 		# entries = fromMaybe [] ('Map'.get taskId localLists)
@@ -239,56 +240,76 @@ where
 		= (exception "Corrupt task state in parallel", iworld)
 	
 	evalParTasks :: !TaskId !Event !*IWorld -> (!Maybe (TaskResult [(TaskTime,TaskValue a)]),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a
-	evalParTasks taskId event iworld=:{localLists}
-		= evalFrom 0 [] (fromMaybe [] ('Map'.get taskId localLists)) iworld
+	evalParTasks taskId event iworld=:{localLists,eventRoute}
+		= evalFrom 0 [] (fromMaybe [] ('Map'.get taskId localLists)) ('Map'.get taskId eventRoute) iworld
 	where
-		evalFrom n acc list iworld = case foldl (evalParTask taskId event) (Nothing,acc,iworld) (drop n list) of
+		evalFrom n acc list mbEventIndex iworld = case foldl (evalParTask taskId event mbEventIndex) (Nothing,acc,iworld) [(i,e) \\ e <- drop n list & i <- [n..]]  of
 			(Just (ExceptionResult e str),acc,iworld)	= (Just (ExceptionResult e str),acc,iworld)
 			(Nothing,acc,iworld=:{localLists})			
 				# nlist = fromMaybe [] ('Map'.get taskId localLists)
-				| length nlist > length list	= evalFrom (length list) acc nlist iworld	//Extra branches were added -> evaluate these as well 
-												= (Nothing,acc,iworld)					//Done
-			//IMPORTANT: This last rule should never match, but it helps to solve overloading solves overloading
+				# lenlist = length list
+				| length nlist > lenlist	= evalFrom lenlist acc nlist Nothing iworld	//Extra branches were added -> evaluate these as well 
+											= (Nothing,acc,iworld)						//Done
+			//IMPORTANT: This last rule should never match, but it helps to solve overloading 
 			(Just (ValueResult val info=:{TaskInfo|lastEvent} rep tree),acc,iworld) = (Just (ValueResult (Value [(lastEvent,val)] False) info rep tree),acc,iworld)
 	
-	evalParTask :: !TaskId !Event !(!Maybe (TaskResult a),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) !TaskListEntry -> (!Maybe (TaskResult a),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a
+	evalParTask :: !TaskId !Event !(Maybe Int) !(!Maybe (TaskResult a),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) !(!Int,!TaskListEntry) -> (!Maybe (TaskResult a),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a
 	//Evaluate embedded tasks
-	evalParTask taskId event (Nothing,acc,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree, removed=False}
-		# (result,iworld) = evala event {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=False} tree iworld
-		= case result of
-			ExceptionResult _ _
-				= (Just result,acc,iworld)	
-			ValueResult val ts rep tree
-				# (entry,iworld)	= updateListEntryEmbeddedResult taskId entryId result iworld
-				= (Nothing, acc++[(entry,Just rep)],iworld)
+	evalParTask taskId event mbEventIndex (Nothing,acc,iworld=:{localTasks}) (index,{TaskListEntry|entryId,state=EmbeddedState,lastEval=ValueResult jsonval info rep tree, removed=False})
+		# evalNeeded = case mbEventIndex of
+			Nothing	= True//We don't know the event index, so we just have to try
+			Just eventIndex
+				| eventIndex == index	= True								//The event is targeted at this branch, we evaluate
+										= info.TaskInfo.refreshSensitive	//Also evaluate if the branch is refresh sensitive
+		| evalNeeded
+			//Evaluate the branch
+			= case 'Map'.get entryId localTasks of
+				Just (Task evala :: Task a^)
+					# (result,iworld) = evala event {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=False} tree iworld
+					= case result of
+						ExceptionResult _ _
+							= (Just result,acc,iworld)	
+						ValueResult val info rep tree
+							# (entry,iworld)	= updateListEntryEmbeddedResult taskId entryId result iworld
+							= (Nothing, acc++[(entry,Just rep)],iworld)
+
+				_
+					= (Nothing,acc,iworld)	
+		| otherwise
+			# (entry,iworld)	= updateListEntryEmbeddedResult taskId entryId (ValueResult jsonval info rep tree) iworld
+			= (Nothing, acc++[(entry,Just rep)],iworld)
 					
 	//Copy the last stored result of detached tasks
-	evalParTask taskId event (Nothing,acc,iworld) {TaskListEntry|entryId,state=DetachedState instanceNo _ _,removed=False}
+	evalParTask taskId event mbEventIndex (Nothing,acc,iworld) (index,{TaskListEntry|entryId,state=DetachedState instanceNo _ _,removed=False})
 		# (mbMeta,iworld)	= read (taskInstanceMeta instanceNo) iworld
 		# (mbResult,iworld)	= read (taskInstanceResult instanceNo) iworld
 		= case (mbMeta,mbResult) of
-			(Ok meta,Ok res)
-				# (entry,iworld) = updateListEntryDetachedResult taskId entryId res meta.TIMeta.progress meta.TIMeta.management iworld
+			(Ok meta,Ok result)
+				# (entry,iworld) = updateListEntryDetachedResult taskId entryId result meta.TIMeta.progress meta.TIMeta.management iworld
 				= (Nothing,acc++[(entry,Nothing)],iworld)
 			_	= (Nothing,acc,iworld)	//TODO: remove from parallel if it can't be loaded (now it simply keeps the last known result)
 
 	//Do nothing if an exeption occurred or marked as removed
-	evalParTask taskId event (result,acc,iworld) entry = (result,acc,iworld) 
+	evalParTask taskId event mbEventIndex (result,acc,iworld) (index,entry) = (result,acc,iworld) 
 
 	destroyParTask :: (!Maybe (TaskResult a),!*IWorld) !TaskListEntry -> (!Maybe (TaskResult a),!*IWorld) | iTask a
 	//Destroy embedded tasks
-	destroyParTask (_,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree}
-		# (result,iworld) = evala RefreshEvent {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=False} (TCDestroy tree) iworld
-		= case result of
-			DestroyedResult		= (Nothing,iworld)
-			_					= (Just result,iworld)
+	destroyParTask (_,iworld=:{localTasks}) {TaskListEntry|entryId,state=EmbeddedState,lastEval=ValueResult _ _ _ tree}
+		= case 'Map'.get entryId localTasks of
+			Just (Task evala :: Task a^)
+				# (result,iworld) = evala RefreshEvent {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=False} (TCDestroy tree) iworld
+				= case result of
+					DestroyedResult		= (Nothing,iworld)
+					_					= (Just result,iworld)
+			_
+				= (Nothing,iworld)
 	
 	//Destroy detached tasks (Just delete the instance)
 	destroyParTask (_,iworld) {TaskListEntry|entryId,state=DetachedState instanceNo _ _}
 		= (Nothing,deleteInstance instanceNo iworld)
 		
 	toValueAndTime :: !TaskListEntry -> (!TaskTime,TaskValue a) | iTask a
-	toValueAndTime {TaskListEntry|result=TIValue val _,lastEvent}	= (lastEvent,deserialize val)	
+	toValueAndTime {TaskListEntry|lastEval=ValueResult val _ _ _,lastEvent}	= (lastEvent,deserialize val)	
 	where
 		deserialize (Value json stable) = case fromJSON json of
 			Nothing = NoValue
@@ -302,11 +323,14 @@ where
 		# after			= afterLayout repOpts
 		# listId		= toString taskId
 		# parts = [(uiDefSetAttribute LAST_EVENT_ATTRIBUTE (toString lastEvent) (uiDefSetAttribute CREATED_AT_ATTRIBUTE (toString createdAt) (uiDefSetAttribute TASK_ATTRIBUTE (toString entryId) def)))
-					 \\ ({TaskListEntry|entryId,state=EmbeddedState _ _,result=TIValue val _,createdAt,lastEvent,removed=False},Just (TaskRep def _)) <- entries | not (isStable val)]	
+					 \\ ({TaskListEntry|entryId,state=EmbeddedState,lastEval=ValueResult val _ _ _,createdAt,lastEvent,removed=False},Just (TaskRep def _)) <- entries | not (isStable val)]	
 		= TaskRep (after (layout.Layout.parallel (toPrompt desc) parts)) []
 
 	isStable (Value _ stable) 	= stable
 	isStable _					= False
+
+	refreshSensitive {TaskListEntry|lastEval=ValueResult _ {TaskInfo|refreshSensitive} _ _} = refreshSensitive
+	refreshSensitive _ = True
 	
 	//Helper function to help type inferencing a little
 	fixOverloading :: (TaskResult a) [(!ParallelTaskType,!ParallelTask a)] !b -> b
@@ -314,46 +338,43 @@ where
 							
 //SHARED HELPER FUNCTIONS
 appendTaskToList :: !TaskId !(!ParallelTaskType,!ParallelTask a) !*IWorld -> (!TaskId,!*IWorld) | iTask a
-appendTaskToList taskId=:(TaskId parent _) (parType,parTask) iworld=:{taskTime,currentUser,currentDateTime}
+appendTaskToList taskId=:(TaskId parent _) (parType,parTask) iworld=:{taskTime,currentUser,currentDateTime,localTasks}
 	# (list,iworld) = loadTaskList taskId iworld 
 	# (taskIda,state,iworld) = case parType of
 		Embedded
 			# (taskIda,iworld)	= getNextTaskId iworld
 			# task		= parTask (parListShare taskId)
-			= (taskIda, EmbeddedState (dynamic task :: Task a^) (TCInit taskIda taskTime),iworld)
+			= (taskIda, EmbeddedState, {iworld & localTasks = 'Map'.put taskIda (dynamic task :: Task a^) localTasks})
 		Detached management
 			# task									= parTask (parListShare taskId)
 			# progress								= {issuedAt=currentDateTime,issuedBy=currentUser,stable=True,firstEvent=Nothing,latestEvent=Nothing,latestAttributes='Map'.newMap}
 			# (taskIda=:TaskId instanceNo _,iworld)	= createTopTaskInstance task management currentUser parent iworld
 			= (taskIda,DetachedState instanceNo progress management, iworld)
-	# result	= TIValue NoValue taskTime
-	# entry		= {entryId = taskIda, state = state, result = result, attributes = 'Map'.newMap, createdAt = taskTime, lastEvent = taskTime, removed = False}
+	# lastEval	= ValueResult NoValue {TaskInfo|lastEvent=taskTime,refreshSensitive=True} noRep (TCInit taskIda taskTime)
+	# entry		= {entryId = taskIda, state = state, lastEval = lastEval, attributes = 'Map'.newMap, createdAt = taskTime, lastEvent = taskTime, removed = False}
 	# iworld	= storeTaskList taskId (list ++ [entry]) iworld
 	= (taskIda, iworld)		
 
 updateListEntryEmbeddedResult :: !TaskId !TaskId (TaskResult a) !*IWorld -> (!TaskListEntry,!*IWorld) | iTask a
 updateListEntryEmbeddedResult listId entryId result iworld
 	= updateListEntry listId entryId (\e=:{TaskListEntry|state,lastEvent} ->
-		{TaskListEntry|e & state = newTree state result, result = serialize result, attributes = newAttr result, lastEvent = maxTime lastEvent result}) iworld
+		{TaskListEntry|e & lastEval= wrap result, attributes = newAttr result, lastEvent = maxTime lastEvent result}) iworld
 where
-	serialize (ValueResult val {TaskInfo|lastEvent} _ _) 		= TIValue (fmap toJSON val) lastEvent
-	serialize (ExceptionResult e str)							= TIException e str
+	wrap (ValueResult val info rep tree)	= ValueResult (fmap toJSON val) info rep tree
+	wrap (ExceptionResult e str)			= ExceptionResult e str
 
-	newTree (EmbeddedState task _) (ValueResult _ _ _ tree)		= EmbeddedState task tree
-	newTree cur _												= cur
-	
 	newAttr (ValueResult _ _ (TaskRep def _) _)					= uiDefAttributes def
 	newAttr _													= 'Map'.newMap
 	
 	maxTime cur (ValueResult _ {TaskInfo|lastEvent} _ _)		= max cur lastEvent
 	maxTime cur _												= cur
 
-updateListEntryDetachedResult :: !TaskId !TaskId TIResult !ProgressMeta !ManagementMeta !*IWorld -> (!TaskListEntry,!*IWorld)
-updateListEntryDetachedResult listId entryId result progress management iworld
+updateListEntryDetachedResult :: !TaskId !TaskId (TaskResult JSONNode) !ProgressMeta !ManagementMeta !*IWorld -> (!TaskListEntry,!*IWorld)
+updateListEntryDetachedResult listId entryId lastEval progress management iworld
 	= updateListEntry listId entryId update iworld
 where
 	update e=:{TaskListEntry|state=DetachedState no _ _}
-		= {TaskListEntry| e & state = DetachedState no progress management,result = result, attributes = progress.latestAttributes}
+		= {TaskListEntry| e & state = DetachedState no progress management, lastEval = lastEval, attributes = progress.latestAttributes}
 	update e = e
 
 markListEntryRemoved :: !TaskId !TaskId !*IWorld -> *IWorld
@@ -457,22 +478,21 @@ where
 		//Load instance
 		# (meta,iworld)		= readRegister currentInstance (taskInstanceMeta instanceNo) iworld
 		# (result,iworld)	= readRegister currentInstance (taskInstanceResult instanceNo) iworld
-		# (rep,iworld)		= readRegister currentInstance (taskInstanceRep instanceNo) iworld
 		# layout			= repLayout repOpts
-		= case (meta,result,rep) of
-			(_,Ok (TIValue (Value _ True) _),_)
-				= (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts} (finalizeRep repOpts noRep) tree, iworld)
-			(_,Ok (TIException _ _),_)
-				= (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts} (finalizeRep repOpts noRep) tree, iworld)
-			(Ok meta=:{TIMeta|worker=Just worker},_,Ok (TaskRep def parts))
+		= case (meta,result) of
+			(_,Ok (ValueResult (Value _ True) _ _ _))
+				= (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts noRep) tree, iworld)
+			(_,Ok (ExceptionResult _ _))
+				= (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts noRep) tree, iworld)
+			(Ok meta=:{TIMeta|worker=Just worker},Ok (ValueResult _ _ (TaskRep def parts) _))
 				| worker == currentUser
 					# rep = finalizeRep repOpts (TaskRep (layout.Layout.workOn def meta) parts)
-					= (ValueResult (Value WOActive False) {TaskInfo|lastEvent=ts} rep tree, iworld)
+					= (ValueResult (Value WOActive False) {TaskInfo|lastEvent=ts,refreshSensitive=True} rep tree, iworld)
 				| otherwise
 					# rep = finalizeRep repOpts (TaskRep (layout.Layout.workOn (inUseDef worker) meta) parts)
-					= (ValueResult (Value (WOInUse worker) False) {TaskInfo|lastEvent=ts} rep tree, iworld)		
+					= (ValueResult (Value (WOInUse worker) False) {TaskInfo|lastEvent=ts,refreshSensitive=False} rep tree, iworld)		
 			_
-				= (ValueResult (Value WODeleted True) {TaskInfo|lastEvent=ts} (finalizeRep repOpts noRep) tree, iworld)
+				= (ValueResult (Value WODeleted True) {TaskInfo|lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts noRep) tree, iworld)
 
 	eval event repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld=:{currentInstance}
 		= (DestroyedResult,iworld)
@@ -553,3 +573,11 @@ where
 		eval` event repOpts=:{modLayout=Just g} state iworld
 			= eval event {TaskRepOpts|repOpts & modLayout = Just (g o f)} state iworld 	
 	
+instance tune LazyRefresh
+where
+	tune _ (Task eval) = Task eval`
+	where
+		eval` event repOpts state iworld
+			= case (eval event repOpts state iworld) of
+				(ValueResult value info rep tree,iworld) = (ValueResult value {TaskInfo|info&refreshSensitive=False} rep tree, iworld)
+				(res,iworld) = (res,iworld)

Server/API/Core/CoreTasks.icl

@@ -55,7 +55,8 @@ where
 	eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
 		# (val,iworld)	= 'SharedDataSource'.readRegister instanceNo shared iworld
 		# res = case val of
-			Ok val		= ValueResult (Value val False) {TaskInfo|lastEvent=ts} (finalizeRep repOpts (TaskRep (UIControlSequence {UIControlSequence|attributes=newMap,controls=[],direction=Vertical}) [])) (TCInit taskId ts)
+			Ok val		= ValueResult (Value val False) {TaskInfo|lastEvent=ts,refreshSensitive=True}
+				(finalizeRep repOpts (TaskRep (UIControlSequence {UIControlSequence|attributes=newMap,controls=[],direction=Vertical}) [])) (TCInit taskId ts)
 			Error e		= exception (SharedException e)
 		= (res,iworld)
 	eval event repAs (TCDestroy _) iworld = (DestroyedResult,iworld)
@@ -80,7 +81,7 @@ where
 		# (nv,nmask,nts,iworld) = matchAndApplyEvent event taskId taskTime v mask ts iworld
 		//Load next r from shared value
 		# (mbr,iworld) 			= 'SharedDataSource'.readRegister instanceNo shared iworld
-		| isError mbr			= (exception (fromError mbr),iworld)//could_not_read_shared_in_interact_exception iworld
+		| isError mbr			= (exception (fromError mbr),iworld)
 		# nr					= fromOk mbr
 		//Apply refresh function if r or v changed
 		# changed				= (nts =!= ts) || (nr =!= r) 
@@ -90,7 +91,8 @@ where
 		# validity				= verifyMaskedValue nv nmask
 		# (rep,iworld) 			= visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
 		# value 				= if (isValidMask validity) (Value nl False) NoValue
-		= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract taskId nts (toJSON nl) (toJSON nr) (toJSON nv) nmask), iworld)
+		= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=True} (finalizeRep repOpts rep)
+			(TCInteract taskId nts (toJSON nl) (toJSON nr) (toJSON nv) nmask), iworld)
 
 	eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
 

Server/API/Core/IntegrationTasks.icl

@@ -63,7 +63,7 @@ where
 	//Check for its result
 	eval event repOpts state=:(TCBasic taskId lastEvent encv stable) iworld=:{world}
 		| stable
-			= (ValueResult (Value (fromJust (fromJSON encv)) True) {TaskInfo|lastEvent=lastEvent} (TaskRep (UIControlSequence {UIControlSequence|attributes='Map'.newMap,controls=[],direction=Vertical}) []) state, iworld)
+			= (ValueResult (Value (fromJust (fromJSON encv)) True) {TaskInfo|lastEvent=lastEvent,refreshSensitive=False} (TaskRep (UIControlSequence {UIControlSequence|attributes='Map'.newMap,controls=[],direction=Vertical}) []) state, iworld)
 		| otherwise
 			= case fromJSON encv of
 				Just (Right outfile)
@@ -78,7 +78,7 @@ where
 						# prompt			= toPrompt desc
 						# editor			= {UIControlSequence| attributes = 'Map'.newMap, controls = controls, direction = Vertical}
 						# rep				= TaskRep (UIControlSequence (layout.Layout.interact prompt editor)) []
-						= (ValueResult (Value status False) {TaskInfo|lastEvent=lastEvent} rep state,iworld)
+						= (ValueResult (Value status False) {TaskInfo|lastEvent=lastEvent,refreshSensitive=True} rep state,iworld)
 					# (res, world) = 'File'.readFile outfile world
 					| isError res
 						//Failed to read file
@@ -90,7 +90,9 @@ where
 						Just async	
 							| async.AsyncResult.success
 								# result = CompletedProcess async.AsyncResult.exitcode 
-								= (ValueResult (Value result True) {TaskInfo|lastEvent=lastEvent} (TaskRep (UIControlSequence {UIControlSequence|attributes = 'Map'.newMap,controls = [],direction = Vertical}) []) (TCBasic taskId lastEvent (toJSON result) True), {IWorld|iworld & world = world})
+								= (ValueResult (Value result True) {TaskInfo|lastEvent=lastEvent,refreshSensitive=False}
+									(TaskRep (UIControlSequence {UIControlSequence|attributes = 'Map'.newMap,controls = [],direction = Vertical}) [])
+									(TCBasic taskId lastEvent (toJSON result) True), {IWorld|iworld & world = world})
 							| otherwise
 								= (exception (CallFailed (async.AsyncResult.exitcode,"callProcess: " +++ async.AsyncResult.message)), {IWorld|iworld & world = world})
 				//Error during initialization

Server/API/Core/OptimizedCoreTasks.icl

@@ -42,7 +42,7 @@ where
 		# validity				= verifyMaskedValue nv nmask
 		# (rep,iworld) 			= visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
 		# value 				= if (isValidMask validity) (Value nl False) NoValue
-		= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
+		= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=True} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
 	eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
 
 	refresh_fun l nr nv nmask valid
@@ -84,7 +84,7 @@ where
 		# validity				= verifyMaskedValue nv nmask
 		# (rep,iworld) 			= visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
 		# value 				= if (isValidMask validity) (Value nl False) NoValue
-		= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
+		= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=True} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
 	eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
 
 	refresh_fun l nr nv nmask valid
@@ -123,7 +123,7 @@ where
 		# validity				= verifyMaskedValue nv nmask
 		# (rep,iworld) 			= visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
 		# value 				= if (isValidMask validity) (Value nl False) NoValue
-		= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
+		= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=True} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
 	eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
 
 	refresh_fun r
@@ -151,7 +151,7 @@ where
 		# validity				= verifyMaskedValue nv nmask
 		# (rep,iworld) 			= visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
 		# value 				= if (isValidMask validity) (Value nl False) NoValue
-		= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nv) nmask), iworld)
+		= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=False} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nv) nmask), iworld)
 	eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
 
 	refresh_fun l v m ok
@@ -181,7 +181,7 @@ where
 		# validity				= verifyMaskedValue nv nmask
 		# (rep,iworld) 			= visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
 		# value 				= if (isValidMask validity) (Value nl False) NoValue
-		= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
+		= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=False} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
 	eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
 
 	refresh_fun l v m ok
@@ -210,7 +210,7 @@ where
 		# validity				= verifyMaskedValue nv nmask
 		# (rep,iworld) 			= visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
 		# value 				= if (isValidMask validity) (Value nl False) NoValue
-		= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
+		= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=False} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
 	eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
 
 matchAndApplyEvent (EditEvent taskId name value) matchId taskTime v mask ts iworld

Server/API/Core/SystemTypes.dcl

@@ -703,6 +703,10 @@ instance descr Attribute
 instance descr Att
 instance descr [d] | descr d
 
+
+//Task evaluation tuning directives, for increasing performance
+:: LazyRefresh = LazyRefresh //If you tune a task in a parallel set with this directive, it not be evaluated unless its focused
+
 //****************************************************************************//
 // Generic instances for common library types
 //****************************************************************************//

Server/Framework/Engine.icl

@@ -54,6 +54,8 @@ initIWorld sdkPath world
 	  ,nextTaskNo			= 0
 	  ,localShares			= newMap
 	  ,localLists			= newMap
+	  ,localTasks			= newMap
+      ,eventRoute			= newMap
 	  ,readShares			= []
 	  ,sessions				= newMap
 	  ,uis					= newMap

Server/Framework/IWorld.dcl

@@ -27,6 +27,8 @@ from HttpServer			import class HttpEnv
 					, nextTaskNo			:: !TaskNo									// The next task number to assign
 					, localShares			:: !Map TaskId JSONNode						// The set of locally shared values
 					, localLists			:: !Map TaskId [TaskListEntry]				// The set of local parallel task lists
+					, localTasks			:: !Map TaskId Dynamic						// The set of local parallel tasks
+					, eventRoute			:: !Map TaskId Int							// Index of parallel branches the event is targeted at
 					, readShares			:: ![String]								// The IDs of shares from which was read
 					, sessions				:: !Map SessionId InstanceNo				// Index of sessions to instance numbers
 					, uis					:: !Map SessionId (!Int,!UIDef)				// Previous ui versions to optimize output sent to clients

Server/Framework/Task.dcl

@@ -7,6 +7,7 @@ definition module Task
 import SystemTypes, HTTP, GenVisualize, iTaskClass, GenRecord
 from TaskState			import :: TaskTree
 from LayoutCombinators	import :: Layout
+from Map				import :: Map
 
 derive JSONEncode		Task
 derive JSONDecode		Task
@@ -35,8 +36,8 @@ derive gPutRecordFields	Task
 					| DestroyedResult																	//If a task finalizes and cleaned up it gives this result
 
 :: TaskInfo =
-	{ lastEvent			:: TaskTime		//When was the last edit, action or focus event in this task
-//	, lastValueChange	:: TaskTime 	//When was the last time this task's value changed
+	{ lastEvent			:: !TaskTime		//When was the last edit, action or focus event in this task
+	, refreshSensitive	:: !Bool			//Can refresh events change the value or ui of this task (e.g. because shared data is read)
 	}
 
 :: TaskRepOpts	=

Server/Framework/Task.icl

@@ -10,11 +10,11 @@ mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -
 mkInstantTask iworldfun = Task (evalOnce iworldfun)
 where
 	evalOnce f _ repOpts (TCInit taskId ts) iworld = case f taskId iworld of	
-		(Ok a,iworld)							= (ValueResult (Value a True) {lastEvent=ts} (finalizeRep repOpts rep) (TCStable taskId ts (DeferredJSON a)), iworld)
+		(Ok a,iworld)							= (ValueResult (Value a True) {lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts rep) (TCStable taskId ts (DeferredJSON a)), iworld)
 		(Error (e,s), iworld)					= (ExceptionResult e s, iworld)
 
 	evalOnce f _ repOpts state=:(TCStable taskId ts enc) iworld = case fromJSONOfDeferredJSON enc of
-		Just a	= (ValueResult (Value a True) {lastEvent=ts} (finalizeRep repOpts rep) state, iworld)
+		Just a	= (ValueResult (Value a True) {lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts rep) state, iworld)
 		Nothing	= (exception "Corrupt task result", iworld)
 
 	evalOnce f _ _ (TCDestroy _) iworld	= (DestroyedResult,iworld)

Server/Framework/TaskEval.icl

@@ -22,8 +22,7 @@ createSessionTaskInstance task event iworld=:{currentDateTime,taskTime}
 	# meta					= createMeta instanceNo (Just sessionId) 0 (Just worker) mmeta pmeta
 	# (_,iworld)			= 'SharedDataSource'.write meta (taskInstanceMeta instanceNo) iworld
 	# (_,iworld)			= 'SharedDataSource'.write (createReduct instanceNo task taskTime) (taskInstanceReduct instanceNo) iworld
-	# (_,iworld)			= 'SharedDataSource'.write (createResult taskTime) (taskInstanceResult instanceNo) iworld
-	# (_,iworld)			= 'SharedDataSource'.write (createRep) (taskInstanceRep instanceNo) iworld
+	# (_,iworld)			= 'SharedDataSource'.write (createResult instanceNo taskTime) (taskInstanceResult instanceNo) iworld
 	//Register the sessionId -> instanceNo relation
 	# iworld				= registerSession sessionId instanceNo iworld
 	//Evaluate once
@@ -42,8 +41,7 @@ createTopTaskInstance  task mmeta issuer parent iworld=:{currentDateTime,taskTim
 	# meta					= createMeta instanceNo Nothing parent Nothing mmeta pmeta
 	# (_,iworld)			= 'SharedDataSource'.write meta (taskInstanceMeta instanceNo) iworld
 	# (_,iworld)			= 'SharedDataSource'.write (createReduct instanceNo task taskTime) (taskInstanceReduct instanceNo) iworld
-	# (_,iworld)			= 'SharedDataSource'.write (createResult taskTime) (taskInstanceResult instanceNo) iworld
-	# (_,iworld)			= 'SharedDataSource'.write (createRep) (taskInstanceRep instanceNo) iworld
+	# (_,iworld)			= 'SharedDataSource'.write (createResult instanceNo taskTime) (taskInstanceResult instanceNo) iworld
 	= (TaskId instanceNo 0, iworld)
 
 createMeta :: !InstanceNo (Maybe SessionId) InstanceNo !(Maybe User) !ManagementMeta !ProgressMeta  -> TIMeta
@@ -52,7 +50,7 @@ createMeta instanceNo sessionId parent worker mmeta pmeta
 
 createReduct :: !InstanceNo !(Task a) !TaskTime -> TIReduct | iTask a
 createReduct instanceNo task taskTime
-	= {TIReduct|task=toJSONTask task,nextTaskNo=2,nextTaskTime=1,tree=(TCInit (TaskId instanceNo 0) 1),shares = 'Map'.newMap, lists = 'Map'.newMap}
+	= {TIReduct|task=toJSONTask task,nextTaskNo=2,nextTaskTime=1,shares = 'Map'.newMap, lists = 'Map'.newMap, tasks= 'Map'.newMap}
 where
 	toJSONTask (Task eval) = Task eval`
 	where
@@ -60,11 +58,8 @@ where
 			(ValueResult val ts rep tree,iworld)	= (ValueResult (fmap toJSON val) ts rep tree, iworld)
 			(ExceptionResult e str,iworld)			= (ExceptionResult e str,iworld)
 
-createResult :: TaskTime -> TIResult
-createResult taskTime = TIValue NoValue taskTime
-
-createRep :: TIRep
-createRep = TaskRep (UIControlGroup {UIControlGroup|attributes='Map'.newMap, controls=[],direction = Vertical,actions = []}) []
+createResult :: !InstanceNo !TaskTime -> TaskResult JSONNode
+createResult instanceNo taskTime = ValueResult NoValue {TaskInfo|lastEvent=taskTime,refreshSensitive=True} (TaskRep (UIControlGroup {UIControlGroup|attributes='Map'.newMap, controls=[],direction = Vertical,actions = []}) []) (TCInit (TaskId instanceNo 0) 1)
 
 //Evaluate a session task instance when a new event is received from a client
 evalSessionTaskInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
@@ -128,22 +123,26 @@ evalTaskInstance event instanceNo iworld=:{currentDateTime,currentUser,currentIn
 	# meta=:{TIMeta|sessionId,parent,worker=Just worker,progress} = fromOk meta
 	# (reduct, iworld)			= 'SharedDataSource'.read (taskInstanceReduct instanceNo) iworld
 	| isError reduct			= (liftError reduct, iworld)
-	# reduct=:{TIReduct|task=Task eval,nextTaskNo=curNextTaskNo,nextTaskTime,tree,shares,lists} = fromOk reduct
+	# reduct=:{TIReduct|task=Task eval,nextTaskNo=curNextTaskNo,nextTaskTime,shares,lists,tasks} = fromOk reduct
 	# (result, iworld)			= 'SharedDataSource'.read (taskInstanceResult instanceNo) iworld
 	| isError result			= (liftError result, iworld)
 	= case fromOk result of
-		(TIException e msg)		= (Ok (ExceptionResult e msg), iworld)
-		(TIValue val _)
+		(ExceptionResult e msg)		= (Ok (ExceptionResult e msg), iworld)
+		(ValueResult val _ _ tree)
 			//Eval instance
 			# repAs						= {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=isJust sessionId}
 			//Update current process id & eval stack in iworld
 			# taskId					= TaskId instanceNo 0
+			# eventRoute				= determineEventRoute event lists
 			# iworld					= {iworld & currentInstance = instanceNo
 												  , currentUser = worker
 												  , nextTaskNo = reduct.TIReduct.nextTaskNo
 												  , taskTime = reduct.TIReduct.nextTaskTime
 												  , localShares = shares
-												  , localLists = lists} 
+												  , localLists = lists
+												  , localTasks = tasks
+												  , eventRoute = eventRoute
+												  } 
 			//Clear the instance's registrations for share changes
 			# iworld					= clearShareRegistrations instanceNo iworld
 			//Apply task's eval function and take updated nextTaskId from iworld
@@ -158,18 +157,18 @@ evalTaskInstance event instanceNo iworld=:{currentDateTime,currentUser,currentIn
 			# (nextTaskNo,iworld)		= getNextTaskNo iworld
 			# (shares,iworld)			= getLocalShares iworld
 			# (lists,iworld)			= getLocalLists iworld
-			# reduct					= {TIReduct|reduct & nextTaskNo = nextTaskNo, nextTaskTime = nextTaskTime + 1, tree = tasktree result, shares = shares, lists = lists}
+			# (tasks,iworld)			= getLocalTasks iworld
+			# reduct					= {TIReduct|reduct & nextTaskNo = nextTaskNo, nextTaskTime = nextTaskTime + 1, shares = shares, lists = lists, tasks = tasks}
 			# (_,iworld)				= 'SharedDataSource'.writeFilterMsg reduct ((<>) instanceNo) (taskInstanceReduct instanceNo) iworld //TODO Check error
 			//Store the result
-			# (_,iworld)				= 'SharedDataSource'.writeFilterMsg (taskres result) ((<>) instanceNo) (taskInstanceResult instanceNo) iworld //TODO Check error
-			//Store the representation
-			# (_,iworld)				= 'SharedDataSource'.writeFilterMsg (taskrep result) ((<>) instanceNo) (taskInstanceRep instanceNo) iworld //TODO Check error
+			# (_,iworld)				= 'SharedDataSource'.writeFilterMsg result ((<>) instanceNo) (taskInstanceResult instanceNo) iworld //TODO Check error
 			//Return the result
 			= (Ok result, iworld)
 where
 	getNextTaskNo iworld=:{IWorld|nextTaskNo}	= (nextTaskNo,iworld)
 	getLocalShares iworld=:{IWorld|localShares}	= (localShares,iworld)
 	getLocalLists iworld=:{IWorld|localLists}	= (localLists,iworld)
+	getLocalTasks iworld=:{IWorld|localTasks}	= (localTasks,iworld)
 
 	updateProgress now result progress
 		# progress = {progress & firstEvent = Just (fromMaybe now progress.firstEvent), latestEvent = Just now}
@@ -179,15 +178,41 @@ where
 			(ValueResult _ _ (TaskRep ui _) _)	= {progress & stable = False, latestAttributes = uiDefAttributes ui}
 			_									= {progress & stable = False}
 
-	tasktree (ValueResult _ _ _ tree)	= tree
-	tasktree (ExceptionResult _ _)		= TCNop
-	
-	taskres (ValueResult val {TaskInfo|lastEvent