Commit 8e60f6fc authored by Bas Lijnse's avatar Bas Lijnse

Removed forced evaluation of dynamics hack. Caused weird bugs when storing parallel tasks

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@710 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 7d2b7438
......@@ -6,7 +6,7 @@ import Text
defaultValue :: !*World -> (!a,!*World) | gUpdate{|*|} a
defaultValue world
# (a,ust=:{world}) = gUpdate{|*|} undef {USt|mode = UDCreate, searchPath = [], currentPath = [], consPath = [], update = "", mask = [], world = world}
# (a,ust=:{world}) = gUpdate{|*|} (abort "gUpdate accessed value during create") {USt|mode = UDCreate, searchPath = [], currentPath = [], consPath = [], update = "", mask = [], world = world}
= (a,world)
defaultMask :: a !*World -> (DataMask,*World) | gUpdate{|*|} a
......@@ -35,8 +35,8 @@ gUpdate{|UNIT|} _ ust=:{mode=UDCreate} = (UNIT, ust)
gUpdate{|UNIT|} u ust = (u, ust)
gUpdate{|PAIR|} fx fy _ ust=:{mode=UDCreate}
# (nx,ust) = fx undef ust
# (ny,ust) = fy undef ust
# (nx,ust) = fx (abort "PAIR create with undef") ust
# (ny,ust) = fy (abort "PAIR create with undef") ust
= (PAIR nx ny, ust)
gUpdate{|PAIR|} fx fy p ust=:{mode=UDSearch}
......@@ -58,13 +58,13 @@ gUpdate{|PAIR|} fx fy p ust = (p, ust)
gUpdate{|EITHER|} fx fy _ ust=:{mode=UDCreate,consPath}
= case consPath of
[ConsLeft:cl]
# (nx,ust) = fx undef {ust & consPath = cl}
# (nx,ust) = fx (abort "EITHER create with undef") {ust & consPath = cl}
= (LEFT nx, ust)
[ConsRight:cl]
# (ny,ust) = fy undef {ust & consPath = cl}
# (ny,ust) = fy (abort "EITHER create with undef") {ust & consPath = cl}
= (RIGHT ny, ust)
[]
# (nx,ust) = fx undef ust
# (nx,ust) = fx (abort "EITHER create with undef") ust
= (LEFT nx, ust)
gUpdate{|EITHER|} fx fy e ust=:{mode=UDSearch}
......@@ -88,7 +88,7 @@ gUpdate{|EITHER|} fx fy e ust=:{mode=UDMask}
gUpdate{|EITHER|} fx fy e ust = (e, ust)
gUpdate{|CONS|} fx _ ust=:{mode=UDCreate}
# (nx,ust) = fx undef ust
# (nx,ust) = fx (abort "CONS create with undef") ust
= (CONS nx, ust)
gUpdate{|CONS|} fx c ust=:{mode=UDSearch}
......@@ -106,12 +106,12 @@ where
gUpdate{|CONS|} fx c ust = (c, ust)
gUpdate{|OBJECT|} fx _ ust=:{mode=UDCreate}
# (nx,ust) = fx undef ust
# (nx,ust) = fx (abort "OBJECT create with undef") ust
= (OBJECT nx, ust)
gUpdate{|OBJECT of d|} fx o ust=:{mode=UDSearch,searchPath,currentPath,update}
| currentPath == searchPath
# (nx,ust) = fx undef {USt|ust & mode = UDCreate, consPath = path}
# (nx,ust) = fx (abort "OBJECT create with undef") {USt|ust & mode = UDCreate, consPath = path}
= (OBJECT nx, toggleMask {USt|ust & mode = UDDone})
| otherwise
# (nx,ust) = fx x {USt|ust & currentPath = shiftDataPath currentPath}
......@@ -132,7 +132,7 @@ where
gUpdate{|OBJECT|} fx o ust = (o, ust)
gUpdate{|FIELD|} fx _ ust=:{mode=UDCreate}
# (nx,ust) = fx undef ust
# (nx,ust) = fx (abort "FIELD create with undef") ust
= (FIELD nx, ust)
gUpdate{|FIELD|} fx f ust=:{mode=UDSearch}
......@@ -214,7 +214,7 @@ where
gUpdateList fx [] ust=:{USt|currentPath,searchPath,update}
| currentPath == searchPath
| update == "_Cons"
# (a,ust) = fx undef {ust& mode = UDCreate}
# (a,ust) = fx (abort "List create with undef") {ust& mode = UDCreate}
= ([a], toggleMask {USt|ust & mode = UDDone})
| otherwise
= ([], toggleMask {USt |ust & mode = UDDone})
......@@ -251,7 +251,7 @@ gUpdate{|Maybe|} fx m ust=:{USt|mode=UDSearch,currentPath,searchPath,update}
| otherwise
= case m of
Nothing
# (x,ust) = fx undef {ust & mode = UDCreate} //Create an empty value to update
# (x,ust) = fx (abort "Maybe create with undef") {ust & mode = UDCreate} //Create an empty value to update
# (x,ust=:{mode,currentPath}) = fx x {ust & mode = UDSearch,currentPath = currentPath, searchPath = searchPath,update = update}
= case mode of
UDDone = (Just x,ust) //Only switch keep newly created value if a field was updated
......
......@@ -12,9 +12,6 @@ import dynamic_string
from JSON import JSONDecode, fromJSON
import code from "copy_graph_to_string.obj";
import code from "copy_graph_to_string_interface.obj";
:: TaskState = TSNew | TSActive | TSDone
:: RPCMessage =
......@@ -225,28 +222,16 @@ where
executeTaskThread tst=:{taskNr}
# (thread, tst) = loadTaskThread (taskNrFromString processId) tst
# (result, tst) = thread tst
# result = evalDynamicResult result
= (result,tst)
/**
* This forces evaluation of the dynamic to normal form before we encode it
*/
evalDynamicResult :: !Dynamic -> Dynamic
evalDynamicResult d = code {
push_a 0
.d 1 0
jsr _eval_to_nf
.o 0 0
}
createTaskThread :: !(Task a) -> (*TSt -> *(!Dynamic,!*TSt)) | iTask a
createTaskThread task = createTaskThread` task
where
createTaskThread` :: !(Task a) !*TSt -> *(!Dynamic, !*TSt) | iTask a
createTaskThread` task tst
# (a, tst) = applyTask task tst
# dyn = evalDynamicResult (dynamic a)
# dyn = (dynamic a)
= (dyn,tst)
......@@ -398,7 +383,7 @@ mkMainTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkMainTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkMainTask`
where
mkMainTask` tst=:{taskNr,taskInfo}
= taskfun {tst & tree = TTMainTask taskInfo undef []}
= taskfun {tst & tree = TTMainTask taskInfo (abort "Executed undefined maintask") []}
applyTask :: !(Task a) !*TSt -> (!a,!*TSt) | iTask a
applyTask (Task desc mbCxt taskfun) tst=:{taskNr,tree=tree,options,activated,dataStore,world}
......
......@@ -78,7 +78,7 @@ gVisualize{|Task|} fx (VValue (Task desc _ _) _) _ vst = ([TextFragment desc.Tas
gVisualize{|Task|} fx _ _ vst = ([],vst)
gUpdate{|Task|} fx _ ust=:{mode=UDCreate}
# (a,ust) = fx undef ust
# (a,ust) = fx (abort "Task create with undef") ust
= (Task {TaskDescription|title = "return", description = Note ""} Nothing (\tst -> (a,tst)), ust)
gUpdate{|Task|} fx x ust = (x,ust)
......
......@@ -24,28 +24,28 @@ derive gParse Either
//Task composition
(-||-) infixr 3 :: !(Task a) !(Task a) -> (Task a) | iTask a
(-||-) taska taskb
= parallel "-||-" (\list -> length list >= 1) (\[x:_] -> case x of (Left a) = a; (Right b) = b) undef
= parallel "-||-" (\list -> length list >= 1) (\[x:_] -> case x of (Left a) = a; (Right b) = b) (abort "-||- both parts finished??")
[taska >>= \a -> return (Left a)
,taskb >>= \b -> return (Right b)
]
(-&&-) infixr 4 :: !(Task a) !(Task b) -> (Task (a,b)) | iTask a & iTask b
(-&&-) taska taskb
= parallel "-&&-" (\_ -> False) undef (\[Left a, Right b] -> (a,b))
= parallel "-&&-" (\_ -> False) (abort "-&&- predicate became true??") (\[Left a, Right b] -> (a,b))
[taska >>= \a -> return (Left a)
,taskb >>= \b -> return (Right b)
]
anyTask :: ![Task a] -> Task a | iTask a
anyTask [] = getDefaultValue
anyTask tasks = parallel "any" (\list -> length list >= 1) hd undef tasks
anyTask tasks = parallel "any" (\list -> length list >= 1) hd (abort "anyTask all parts finished??") tasks
allTasks :: ![Task a] -> Task [a] | iTask a
allTasks tasks = parallel "all" (\_ -> False) undef id tasks
allTasks tasks = parallel "all" (\_ -> False) (abort "allTasks predicate became true") id tasks
eitherTask :: !(Task a) !(Task b) -> Task (Either a b) | iTask a & iTask b
eitherTask taska taskb
= parallel "eitherTask" (\list -> length list > 0) hd undef
= parallel "eitherTask" (\list -> length list > 0) hd (abort "eitherTask all parts finished??")
[ (taska >>= \a -> return (Left a)) <<@ "Left"
, (taskb >>= \b -> return (Right b)) <<@ "Right"
]
......
......@@ -64,6 +64,7 @@ where
| not adone = (reverse accu, tst)
| otherwise = doseqTasks ts [a:accu] tst
// Parallel composition
parallel :: !String !([a] -> Bool) ([a] -> b) ([a] -> b) ![Task a] -> Task b | iTask a & iTask b
parallel label pred combinePred combineAll tasks
......@@ -75,8 +76,8 @@ where
| isJust exception
= accWorldTSt defaultValue {tst & activated = False}// stop, an exception occurred in one of the branches
| pred alist
= (combinePred alist,{tst & activated = True}) // stop, all work done so far satisfies predicate
| length alist == length tasks // all tasks are done
= (combinePred alist,{tst & activated = True}) // stop, all work done so far satisfies predicate
| length alist == length tasks // all tasks are done
= (combineAll alist,{tst & activated = True})
| otherwise
= accWorldTSt defaultValue {tst & activated = False}// show all subtasks using the displayOption function
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment