Page Numbers: Yes First Page: 1
Heading:
October 6, 1977 12:23 AM[IFS]<KRL>code>alignGoal.bravo
# # # # # # # # # # # # # # #
[AddResultsToOr ((parent Goal) (newResults (LISTP OF Result)) (RETURNS Irrelevant))
(DPROG((results
(if parent:results
then (for result in newResults
when (NOT (for res in parent:results
thereis (SameResult result res)))
collect result)
else newResults)
(LISTP OF Result)
(USEDIN (message PARTIALLY-SUCCEEDED)))
(if results
then (PUSHLIST parent:results results)
(SendMessage parent:resultType parent ’PARTIALLY-SUCCEDED)
(CheckDisjunctCompletion parent newResults)]
# # # # # # # # # # # # # # #
[CheckDisjunctCompletion ((goal Goal) (suspend FLAG)(RETURNS Irrelevant))
(if (OR (EQ goal:goalStatus ’ACTIVE)
(for subgoal in goal:children
thereis (FMEMB subgoal:goalStatus
’(NEW AFTERFIRST ACTIVE WAITING)))))
then (if suspend
then (MSignal SuspendAfterResult (OK (GoalSuspended goal))))
elseif goal:results
then (GoalDone goal ’COMPLETED)
else (GoalDone goal ’FAILED)))
(* once again, this depends on the fact that a disjunct receiving a success with
no results succeeds immediately)]
# # # # # # # # # # # # # # #
[GetFreeGoal ((RETURNS Goal))
(DPROGN ((freeGoal (ONEOF Goal NIL)))
(* used in the CREATE form for GOAL)
(if freeGoal
then (PROG1 freeGoal freeGoal ← freeGoal:parent)
else (NCREATE ’Goal)]
# # # # # # # # # # # # # # #
[GoalDone ((goal Goal)
(status (MEMQ ABORTED COMPLETED FAILED SUCCEEDED))
(RETURNS Irrelevant))
(goal:goalStatus ← status)
(goal:suspended ← T)
(SendMessage goal:resultType goal status)
(KillChildren goal)]
# # # # # # # # # # # # # # #
[GoalPartiallySucceeded ((goal Goal (USEDIN signals))
(results (LISTP OF Result) (USEDIN signals and message))
(RETURNS Irrelevant))
(if results
then (SendMessage goal:resultType goal ’PARTIALLY-SUCCEEDED)
else (KHelp "PartialSuccessWithoutResults")
(* there should always be results, or there is no reason to partially succeed.
other parts of the code depend on the fact that a partial success will always
have results)
(MSignal PartialResultFound (STOP (GoalSuspended goal)))]
# # # # # # # # # # # # # # #
[GoalResumed ((goal Goal)(RETURNS Irrelevant))
(if (FMEMB goal:goalStatus ’(NEW AFTERFIRST ACTIVE WAITING))
then (goal:suspended ← NIL)
(for child in goal:children do (GoalResumed child))]
# # # # # # # # # # # # # # #
[GoalSuspended ((goal Goal)(RETURNS Irrelevant))
(* this does not remove the goal from the activeGoals list -- that is one reason why all
functions check status immediately before using one)
(if (FMEMB goal:goalStatus ’(NEW AFTERFIRST ACTIVE WAITING))
then (goal:suspended ← T)
(for subgoal in goal:children do (GoalSuspended subgoal)]
# # # # # # # # # # # # # # #
[GoalWaiting ((goal Goal)(RETURNS Irrelevant))
(goal:goalStatus ← ’WAITING)]
# # # # # # # # # # # # # # #
[KillChildren ((goal Goal)(RETURNS Irrelevant))
(for subgoal in goal:children
when (NOT(FMEMB subgoal:goalStatus ’(SUCCEEDED FAILED ABORTED)))
do (GoalDone subgoal ’ABORTED)))]
# # # # # # # # # # # # # # #
[NewSubGoal ((parent Goal) (child Goal) (RETURNS Irrelevant))
(child:parent ← parent)
(PUSH parent:children child)
(StartUpGoal child)]
# # # # # # # # # # # # # # #
[ReleaseGoal ((goal Goal) (RETURNS Irrelevant))
(DPROG()
(DECL ((freeGoal (BOUNDIN globally)))
(if (EQ goal:goalNumber ’FREE)
then (RETURN)
else (goal:goalNumber ← ’FREE))
(for child in goal:children do (ReleaseGoal child))
(goal:goalDesc ← goal:patternContext ← goal:datum ← goal:datumContext ←
goal:anchorPath ← goal:goalArgs ← goal:links ← goal:oldLinks ← goal:results ←
goal:immediateResults ← goal:completeBindings ← goal:children ← NIL)
(* fields whose contents are atoms don’t need clearing to release storage)
(goal:parent ← freeGoal)
(freeGoal ← goal]