Commit 06b527d1 authored by Bas Lijnse's avatar Bas Lijnse

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
parent c158703f
...@@ -130,3 +130,8 @@ class tune b :: !b !(Task a) -> Task a ...@@ -130,3 +130,8 @@ class tune b :: !b !(Task a) -> Task a
instance tune SetLayout //Set layout algorithm instance tune SetLayout //Set layout algorithm
instance tune AfterLayout //Apply a modification after a layout has been run instance tune AfterLayout //Apply a modification after a layout has been run
instance tune ModifyLayout //Modify the existing layout instance tune ModifyLayout //Modify the existing layout
/**
* Fine tune evaluation behaviour
*/
instance tune LazyRefresh
...@@ -222,11 +222,12 @@ where ...@@ -222,11 +222,12 @@ where
# rep = parallelRep desc taskId repOpts entries # rep = parallelRep desc taskId repOpts entries
# values = map (toValueAndTime o fst) entries # values = map (toValueAndTime o fst) entries
# stable = all (isStable o snd) values # stable = all (isStable o snd) values
# refreshSensitive = foldr (\(e,_) s -> s || refreshSensitive e) False entries
# ts = foldr max 0 [ts:map fst values] # ts = foldr max 0 [ts:map fst values]
# ts = case event of # ts = case event of
(FocusEvent focusId) = if (focusId == taskId) taskTime ts (FocusEvent focusId) = if (focusId == taskId) taskTime ts
_ = 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 //Cleanup
eval event repOpts (TCDestroy (TCParallel taskId ts)) iworld=:{localLists} eval event repOpts (TCDestroy (TCParallel taskId ts)) iworld=:{localLists}
# entries = fromMaybe [] ('Map'.get taskId localLists) # entries = fromMaybe [] ('Map'.get taskId localLists)
...@@ -239,56 +240,76 @@ where ...@@ -239,56 +240,76 @@ where
= (exception "Corrupt task state in parallel", iworld) = (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 -> (!Maybe (TaskResult [(TaskTime,TaskValue a)]),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a
evalParTasks taskId event iworld=:{localLists} evalParTasks taskId event iworld=:{localLists,eventRoute}
= evalFrom 0 [] (fromMaybe [] ('Map'.get taskId localLists)) iworld = evalFrom 0 [] (fromMaybe [] ('Map'.get taskId localLists)) ('Map'.get taskId eventRoute) iworld
where 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) (Just (ExceptionResult e str),acc,iworld) = (Just (ExceptionResult e str),acc,iworld)
(Nothing,acc,iworld=:{localLists}) (Nothing,acc,iworld=:{localLists})
# nlist = fromMaybe [] ('Map'.get taskId 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 # lenlist = length list
= (Nothing,acc,iworld) //Done | length nlist > lenlist = evalFrom lenlist acc nlist Nothing iworld //Extra branches were added -> evaluate these as well
//IMPORTANT: This last rule should never match, but it helps to solve overloading solves overloading = (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) (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 //Evaluate embedded tasks
evalParTask taskId event (Nothing,acc,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree, removed=False} evalParTask taskId event mbEventIndex (Nothing,acc,iworld=:{localTasks}) (index,{TaskListEntry|entryId,state=EmbeddedState,lastEval=ValueResult jsonval info rep tree, removed=False})
# (result,iworld) = evala event {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=False} tree iworld # evalNeeded = case mbEventIndex of
= case result of Nothing = True//We don't know the event index, so we just have to try
ExceptionResult _ _ Just eventIndex
= (Just result,acc,iworld) | eventIndex == index = True //The event is targeted at this branch, we evaluate
ValueResult val ts rep tree = info.TaskInfo.refreshSensitive //Also evaluate if the branch is refresh sensitive
# (entry,iworld) = updateListEntryEmbeddedResult taskId entryId result iworld | evalNeeded
= (Nothing, acc++[(entry,Just rep)],iworld) //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 //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 # (mbMeta,iworld) = read (taskInstanceMeta instanceNo) iworld
# (mbResult,iworld) = read (taskInstanceResult instanceNo) iworld # (mbResult,iworld) = read (taskInstanceResult instanceNo) iworld
= case (mbMeta,mbResult) of = case (mbMeta,mbResult) of
(Ok meta,Ok res) (Ok meta,Ok result)
# (entry,iworld) = updateListEntryDetachedResult taskId entryId res meta.TIMeta.progress meta.TIMeta.management iworld # (entry,iworld) = updateListEntryDetachedResult taskId entryId result meta.TIMeta.progress meta.TIMeta.management iworld
= (Nothing,acc++[(entry,Nothing)],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) _ = (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 //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 destroyParTask :: (!Maybe (TaskResult a),!*IWorld) !TaskListEntry -> (!Maybe (TaskResult a),!*IWorld) | iTask a
//Destroy embedded tasks //Destroy embedded tasks
destroyParTask (_,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree} destroyParTask (_,iworld=:{localTasks}) {TaskListEntry|entryId,state=EmbeddedState,lastEval=ValueResult _ _ _ tree}
# (result,iworld) = evala RefreshEvent {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=False} (TCDestroy tree) iworld = case 'Map'.get entryId localTasks of
= case result of Just (Task evala :: Task a^)
DestroyedResult = (Nothing,iworld) # (result,iworld) = evala RefreshEvent {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=False} (TCDestroy tree) iworld
_ = (Just result,iworld) = case result of
DestroyedResult = (Nothing,iworld)
_ = (Just result,iworld)
_
= (Nothing,iworld)
//Destroy detached tasks (Just delete the instance) //Destroy detached tasks (Just delete the instance)
destroyParTask (_,iworld) {TaskListEntry|entryId,state=DetachedState instanceNo _ _} destroyParTask (_,iworld) {TaskListEntry|entryId,state=DetachedState instanceNo _ _}
= (Nothing,deleteInstance instanceNo iworld) = (Nothing,deleteInstance instanceNo iworld)
toValueAndTime :: !TaskListEntry -> (!TaskTime,TaskValue a) | iTask a 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 where
deserialize (Value json stable) = case fromJSON json of deserialize (Value json stable) = case fromJSON json of
Nothing = NoValue Nothing = NoValue
...@@ -302,11 +323,14 @@ where ...@@ -302,11 +323,14 @@ where
# after = afterLayout repOpts # after = afterLayout repOpts
# listId = toString taskId # listId = toString taskId
# parts = [(uiDefSetAttribute LAST_EVENT_ATTRIBUTE (toString lastEvent) (uiDefSetAttribute CREATED_AT_ATTRIBUTE (toString createdAt) (uiDefSetAttribute TASK_ATTRIBUTE (toString entryId) def))) # 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)) [] = TaskRep (after (layout.Layout.parallel (toPrompt desc) parts)) []
isStable (Value _ stable) = stable isStable (Value _ stable) = stable
isStable _ = False isStable _ = False
refreshSensitive {TaskListEntry|lastEval=ValueResult _ {TaskInfo|refreshSensitive} _ _} = refreshSensitive
refreshSensitive _ = True
//Helper function to help type inferencing a little //Helper function to help type inferencing a little
fixOverloading :: (TaskResult a) [(!ParallelTaskType,!ParallelTask a)] !b -> b fixOverloading :: (TaskResult a) [(!ParallelTaskType,!ParallelTask a)] !b -> b
...@@ -314,46 +338,43 @@ where ...@@ -314,46 +338,43 @@ where
//SHARED HELPER FUNCTIONS //SHARED HELPER FUNCTIONS
appendTaskToList :: !TaskId !(!ParallelTaskType,!ParallelTask a) !*IWorld -> (!TaskId,!*IWorld) | iTask a 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 # (list,iworld) = loadTaskList taskId iworld
# (taskIda,state,iworld) = case parType of # (taskIda,state,iworld) = case parType of
Embedded Embedded
# (taskIda,iworld) = getNextTaskId iworld # (taskIda,iworld) = getNextTaskId iworld
# task = parTask (parListShare taskId) # 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 Detached management
# task = parTask (parListShare taskId) # task = parTask (parListShare taskId)
# progress = {issuedAt=currentDateTime,issuedBy=currentUser,stable=True,firstEvent=Nothing,latestEvent=Nothing,latestAttributes='Map'.newMap} # 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=:TaskId instanceNo _,iworld) = createTopTaskInstance task management currentUser parent iworld
= (taskIda,DetachedState instanceNo progress management, iworld) = (taskIda,DetachedState instanceNo progress management, iworld)
# result = TIValue NoValue taskTime # lastEval = ValueResult NoValue {TaskInfo|lastEvent=taskTime,refreshSensitive=True} noRep (TCInit taskIda taskTime)
# entry = {entryId = taskIda, state = state, result = result, attributes = 'Map'.newMap, createdAt = taskTime, lastEvent = taskTime, removed = False} # entry = {entryId = taskIda, state = state, lastEval = lastEval, attributes = 'Map'.newMap, createdAt = taskTime, lastEvent = taskTime, removed = False}
# iworld = storeTaskList taskId (list ++ [entry]) iworld # iworld = storeTaskList taskId (list ++ [entry]) iworld
= (taskIda, iworld) = (taskIda, iworld)
updateListEntryEmbeddedResult :: !TaskId !TaskId (TaskResult a) !*IWorld -> (!TaskListEntry,!*IWorld) | iTask a updateListEntryEmbeddedResult :: !TaskId !TaskId (TaskResult a) !*IWorld -> (!TaskListEntry,!*IWorld) | iTask a
updateListEntryEmbeddedResult listId entryId result iworld updateListEntryEmbeddedResult listId entryId result iworld
= updateListEntry listId entryId (\e=:{TaskListEntry|state,lastEvent} -> = 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 where
serialize (ValueResult val {TaskInfo|lastEvent} _ _) = TIValue (fmap toJSON val) lastEvent wrap (ValueResult val info rep tree) = ValueResult (fmap toJSON val) info rep tree
serialize (ExceptionResult e str) = TIException e str 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 (ValueResult _ _ (TaskRep def _) _) = uiDefAttributes def
newAttr _ = 'Map'.newMap newAttr _ = 'Map'.newMap
maxTime cur (ValueResult _ {TaskInfo|lastEvent} _ _) = max cur lastEvent maxTime cur (ValueResult _ {TaskInfo|lastEvent} _ _) = max cur lastEvent
maxTime cur _ = cur maxTime cur _ = cur
updateListEntryDetachedResult :: !TaskId !TaskId TIResult !ProgressMeta !ManagementMeta !*IWorld -> (!TaskListEntry,!*IWorld) updateListEntryDetachedResult :: !TaskId !TaskId (TaskResult JSONNode) !ProgressMeta !ManagementMeta !*IWorld -> (!TaskListEntry,!*IWorld)
updateListEntryDetachedResult listId entryId result progress management iworld updateListEntryDetachedResult listId entryId lastEval progress management iworld
= updateListEntry listId entryId update iworld = updateListEntry listId entryId update iworld
where where
update e=:{TaskListEntry|state=DetachedState no _ _} 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 update e = e
markListEntryRemoved :: !TaskId !TaskId !*IWorld -> *IWorld markListEntryRemoved :: !TaskId !TaskId !*IWorld -> *IWorld
...@@ -457,22 +478,21 @@ where ...@@ -457,22 +478,21 @@ where
//Load instance //Load instance
# (meta,iworld) = readRegister currentInstance (taskInstanceMeta instanceNo) iworld # (meta,iworld) = readRegister currentInstance (taskInstanceMeta instanceNo) iworld
# (result,iworld) = readRegister currentInstance (taskInstanceResult instanceNo) iworld # (result,iworld) = readRegister currentInstance (taskInstanceResult instanceNo) iworld
# (rep,iworld) = readRegister currentInstance (taskInstanceRep instanceNo) iworld
# layout = repLayout repOpts # layout = repLayout repOpts
= case (meta,result,rep) of = case (meta,result) of
(_,Ok (TIValue (Value _ True) _),_) (_,Ok (ValueResult (Value _ True) _ _ _))
= (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts} (finalizeRep repOpts noRep) tree, iworld) = (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts noRep) tree, iworld)
(_,Ok (TIException _ _),_) (_,Ok (ExceptionResult _ _))
= (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts} (finalizeRep repOpts noRep) tree, iworld) = (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts noRep) tree, iworld)
(Ok meta=:{TIMeta|worker=Just worker},_,Ok (TaskRep def parts)) (Ok meta=:{TIMeta|worker=Just worker},Ok (ValueResult _ _ (TaskRep def parts) _))
| worker == currentUser | worker == currentUser
# rep = finalizeRep repOpts (TaskRep (layout.Layout.workOn def meta) parts) # 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 | otherwise
# rep = finalizeRep repOpts (TaskRep (layout.Layout.workOn (inUseDef worker) meta) parts) # 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} eval event repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld=:{currentInstance}
= (DestroyedResult,iworld) = (DestroyedResult,iworld)
...@@ -553,3 +573,11 @@ where ...@@ -553,3 +573,11 @@ where
eval` event repOpts=:{modLayout=Just g} state iworld eval` event repOpts=:{modLayout=Just g} state iworld
= eval event {TaskRepOpts|repOpts & modLayout = Just (g o f)} 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)
...@@ -55,7 +55,8 @@ where ...@@ -55,7 +55,8 @@ where
eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# (val,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld # (val,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld
# res = case val of # 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) Error e = exception (SharedException e)
= (res,iworld) = (res,iworld)
eval event repAs (TCDestroy _) iworld = (DestroyedResult,iworld) eval event repAs (TCDestroy _) iworld = (DestroyedResult,iworld)
...@@ -80,7 +81,7 @@ where ...@@ -80,7 +81,7 @@ where
# (nv,nmask,nts,iworld) = matchAndApplyEvent event taskId taskTime v mask ts iworld # (nv,nmask,nts,iworld) = matchAndApplyEvent event taskId taskTime v mask ts iworld
//Load next r from shared value //Load next r from shared value
# (mbr,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld # (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 # nr = fromOk mbr
//Apply refresh function if r or v changed //Apply refresh function if r or v changed
# changed = (nts =!= ts) || (nr =!= r) # changed = (nts =!= ts) || (nr =!= r)
...@@ -90,7 +91,8 @@ where ...@@ -90,7 +91,8 @@ where
# validity = verifyMaskedValue nv nmask # validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld # (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue # 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) eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......
...@@ -63,7 +63,7 @@ where ...@@ -63,7 +63,7 @@ where
//Check for its result //Check for its result
eval event repOpts state=:(TCBasic taskId lastEvent encv stable) iworld=:{world} eval event repOpts state=:(TCBasic taskId lastEvent encv stable) iworld=:{world}
| stable | 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 | otherwise
= case fromJSON encv of = case fromJSON encv of
Just (Right outfile) Just (Right outfile)
...@@ -78,7 +78,7 @@ where ...@@ -78,7 +78,7 @@ where
# prompt = toPrompt desc # prompt = toPrompt desc
# editor = {UIControlSequence| attributes = 'Map'.newMap, controls = controls, direction = Vertical} # editor = {UIControlSequence| attributes = 'Map'.newMap, controls = controls, direction = Vertical}
# rep = TaskRep (UIControlSequence (layout.Layout.interact prompt editor)) [] # 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 # (res, world) = 'File'.readFile outfile world
| isError res | isError res
//Failed to read file //Failed to read file
...@@ -90,7 +90,9 @@ where ...@@ -90,7 +90,9 @@ where
Just async Just async
| async.AsyncResult.success | async.AsyncResult.success
# result = CompletedProcess async.AsyncResult.exitcode # 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 | otherwise
= (exception (CallFailed (async.AsyncResult.exitcode,"callProcess: " +++ async.AsyncResult.message)), {IWorld|iworld & world = world}) = (exception (CallFailed (async.AsyncResult.exitcode,"callProcess: " +++ async.AsyncResult.message)), {IWorld|iworld & world = world})
//Error during initialization //Error during initialization
......
...@@ -42,7 +42,7 @@ where ...@@ -42,7 +42,7 @@ where
# validity = verifyMaskedValue nv nmask # validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld # (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue # 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) eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l nr nv nmask valid refresh_fun l nr nv nmask valid
...@@ -84,7 +84,7 @@ where ...@@ -84,7 +84,7 @@ where
# validity = verifyMaskedValue nv nmask # validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld # (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue # 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) eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l nr nv nmask valid refresh_fun l nr nv nmask valid
...@@ -123,7 +123,7 @@ where ...@@ -123,7 +123,7 @@ where
# validity = verifyMaskedValue nv nmask # validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld # (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue # 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) eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun r refresh_fun r
...@@ -151,7 +151,7 @@ where ...@@ -151,7 +151,7 @@ where
# validity = verifyMaskedValue nv nmask # validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld # (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue # 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) eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l v m ok refresh_fun l v m ok
...@@ -181,7 +181,7 @@ where ...@@ -181,7 +181,7 @@ where
# validity = verifyMaskedValue nv nmask # validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld # (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue # 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) eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l v m ok refresh_fun l v m ok
...@@ -210,7 +210,7 @@ where ...@@ -210,7 +210,7 @@ where
# validity = verifyMaskedValue nv nmask # validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld # (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue # 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) eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
matchAndApplyEvent (EditEvent taskId name value) matchId taskTime v mask ts iworld matchAndApplyEvent (EditEvent taskId name value) matchId taskTime v mask ts iworld
......
...@@ -703,6 +703,10 @@ instance descr Attribute ...@@ -703,6 +703,10 @@ instance descr Attribute
instance descr Att instance descr Att
instance descr [d] | descr d 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 // Generic instances for common library types
//****************************************************************************// //****************************************************************************//
......
...@@ -54,6 +54,8 @@ initIWorld sdkPath world ...@@ -54,6 +54,8 @@ initIWorld sdkPath world
,nextTaskNo = 0 ,nextTaskNo = 0
,localShares = newMap ,localShares = newMap
,localLists = newMap ,localLists = newMap
,localTasks = newMap
,eventRoute = newMap
,readShares = [] ,readShares = []
,sessions = newMap ,sessions = newMap
,uis = newMap ,uis = newMap
......