[Indigo]<KRL>code>align.bravo!23

[AddLink ((goal Goal) (structure DHandle) (fullContext FullContext)
(RETURNS Irrelevant))
(DPROG((context fullContext:context (ONEOF Context NIL))
(world fullContext:world ANY))
(if (NOT (for link in goal:links
thereis (AND (EQH structure link:structure)
(SameWorld world link:world)
(OR (EQ context link:context)
(AND context
link:context
(EQH link:context:prototype context:prototype)
(EQH link:context:instance context:instance))))))
then (DPROG((link (Create Link structure ← structure
fullContext ← fullContext)
Link))
(SELECTQ (SendMessage goal:goalType goal ’NEWLINK)
(PASS (PUSH goal:links link)
(for child in goal:children
when (FMEMB child:goalStatus ’(ACTIVE WAITING))
do (* this happens even to suspended goals, so the info is there in
case they get resumed)
(AddLink child link)))
(OK (PUSH goal:links link))
(SKIP NIL)
(KHelp "illegal value for NEWLINK message" goal:goalType]

[CheckCategoryStatus ((goal Goal) (oldCategory Anchor) (descriptor Descriptor)
(type LITATOM) (quickSucceed BOOL)
(RETURNS Irrelevant))
(DPROG((category (SELECTQ type
(MapDescriptor
(FetchMem descriptor focusSlot (ConstantHandle)))
((KrlPointer LispPointer) (GetSystemCategory descriptor))
NIL)
(ONEOF NIL Anchor)))
(if category
then (SELECTQ (TreeRelation oldCategory category)
(CONFLICT (GoalDone self ’FAILED))
((SAME ABOVE)
(if quickSucceed then (GoalDone self ’SUCCEEDED))
((BELOW NONE) T)
(KHelp "Illegal tree relation")]

[CheckDescriptorMeta ((goal Goal) (descriptor Descriptor)(RETURNS Irrelevant))
(DPROG((meta (GetMetaDescription goal:goalDesc) Anchor)
(doArg NIL (ONEOF ActionForm BindingForm))
(variable NIL ANY)
(type NIL ANY))
(if meta
then (for metaDescriptor fromField descrs ofHandle meta
do (if (OR (NEQ ’InterpretedMapD (TypeD metaDescriptor))
(NEQ ’Do (TypeI metaDescriptor))
(NOT (doArg ← (GetInterpretedArg metaDescriptor))))
then (MSignal UnknownMetaOnPatternDescriptor
(OK (RETURN (* from loop through metadescriptors)))
(PROGN (GoalDone self ’FAILED)
(RETFROM AlignAnchor))))
(SELECTQ doArg:actionType
(Bind (OR (AND (EQ (AtomEval doArg:valueType) ’Descriptor)
(EQ doArg:bindingTest ’ME))
(KHelp "illegal binding type on descriptor" doArg))
(goal:results ←
<(CREATE Result
bindings ← <(Create Binding
bindingVariable ←
(AtomEval doArg:variableSpec)
bindingValue ← descriptor)>)>))
(SubstituteDescriptor
(if (NEQ doArg:bindingTest ’ME)
then (KHelp "illegal action type on descriptor" doArg))
(OR goal:anchorPath
(KHelp "action on ungrounded descriptor" doArg))
(goal:results ←
<(CREATE Result
actions ← <(Create Action
actionBinding ←
<descriptor ! goal:anchorPath>
actionForm ← doArg)>)>))
(KHelp "illegal action on descriptor" doArg))]

[CheckEnumerationSatisfied ((goal Goal)(RETURNS Irrelevant))
(* this could be written to be more efficient for special cases)
(DPROG((items goal:immediateResults LST))
(test goal:goalDesc:actionTest)
(count goal:goalDesc:actionCount)
(satisfiedCount 0 FIXP))
(if (NULL items)
then (RETURN)

elseif (AND (FIXP count)(MINUSP count))
then (count ← (MINUS count))
(items ← (REVERSE items))
(* I know this is horribly inefficient but I’m too tired to worry about it now. It can be patched by using DREVERSE or keeping things in reverse order from the beginning, which means modifying the FindElement goal type class))
(if (FMEMB count ’(ALL COMPLETE))
then (if (for item in items always (NEQ item ’UNKNOWN))
then (self:immediateResults ←
(for item in items
when (AND (NOT (FMEMB item
’(ELLIPSIS IRRELEVANT)))
(PassesTest item test))
collect item)))
else (for itemPos on items
do (SELECTQ itemPos:1
((ELLIPSIS FAILED IRRELEVANT))
(UNKNOWN (RETURN))
(SATISFIED (satisfiedCount ← (ADD1 satisfiedCount)))
(if (PassesTest itemPos:1 test)
then (if (EQ count(satisfiedCount ← (ADD1 satisfiedCount)))
then (goal:immediateResults ← itemPos:1)
(GoalDone goal ’SUCCEEDED)
else (itemPos:1 ← ’SATISFIED))
else (itemPos:1 ← ’FAILED)))
finally (* reached the end without finding it, and without passing any unknowns)
(GoalDone self ’FAILED)]

[NoDescriptorMeta ((goal Goal)(RETURNS Irrelevant))
(DPROG((meta (GetMetaDescription goal:goalDesc) Anchor)
(doArg NIL (ONEOF ActionForm BindingForm)))
(if meta
then (for metaDescriptor fromField descrs ofHandle meta
do (if (OR (NEQ ’InterpretedMapD (TypeD metaDescriptor))
(NEQ ’Do (TypeI metaDescriptor))
(NOT (doArg ← (GetInterpretedArg metaDescriptor))))
then (MSignal UnknownMetaOnPatternDescriptor
(OK (RETURN (* from loop through metadescriptors)))
(PROGN (GoalDone self ’FAILED)
(RETFROM AlignAnchor)))
else (KHelp "action on descriptor not found" doArg]

[SetUpAction ((actionType ActionType (USEDIN signals))
(doArg ActionForm (USEDIN signals))
(goal Goal (USEDIN signals))
(RETURNS Irrelevant))
(HELP "this needs to be combined with AddAction and both of them fixed")
(DPROG((action NIL Action))
(OR goal:anchorPath
(MSignalC UngroundedAction
(OK (RETFROM SetUpAction T))
(AlignCompleted ’ABORT)))
(action ← (Create Action actionForm ← doArg
actionSpec ← <actionType>
actionBinding ← goal:anchorPath)
(if goal:immediateResults
then (for result in goal:immediateResults
do (PUSH result:actions action))
else (PUSH goal:immediateResults
(Create Result actions ← <action>)]

[TriggerToEnumerate ((goal Goal (USEDIN function))(link Link) (RETURNS Irrelevant))
(DPROG ((TYPE goal:goalArgs:2 LITATOM
(USEDIN triggers and traps and in function)))
(DoProcedures link
’ToEnumerate
(FUNCTION
(LAMBDA (triggerForm)
(DPROG ((result (EVAL triggerForm)))
(DECL ((goal Goal (BOUNDIN TriggerToEnumerate)))
(if (EQ result ’NOTFOUND)
then (RETURN NIL)
elseif (TryElementBinding goal result)
then (RETFROM ’TriggerToEnumerate)
else (KHelp "illegal result returned for ToFind" result))))]

[TriggerToFind ((goal Goal (USEDIN function)
(SATISFIES (FMEMB goal:resultType
’(FindforBinding FindForAction))))
((link Link) (RETURNS Irrelevant))
(DPROG ((TYPE goal:goalArgs:2 LITATOM
(USEDIN triggers and traps and in function)))
(DoProcedures link
’ToFind
(FUNCTION
(LAMBDA (triggerForm)
(DPROG ((result (EVAL triggerForm)))
(DECL ((goal Goal (BOUNDIN TriggerToFind)))
(if (EQ result ’NOTFOUND)
then (RETURN NIL)
elseif (SELECTQ (TypeK result)
(Anchor (AND (FMEMB TYPE ’(Post Primary))
(IsPrimaryAnchor result)))
(Lisp (FMEMB TYPE ’(Post Lisp)))
(Descriptor
(AND (EQ (Dtype result) ’KrlPointer)
(OR (EQ TYPE ’Post)
(AND (EQ TYPE ’Hook)
(result ←
(GetDirectPointer result))))))
NIL)
then (goal:immediateResults ← result)
(GoalDone goal ’SUCCEEDED)
(RETFROM ’TriggerToFind)
else (KHelp "illegal result returned for ToFind" result)]

[TriggerToMatch ((goal Goal)
(link Link)
(FOCUSMATCHED BOOL
(USEDIN triggers, traps, and function))
(RETURNS Irrelevant))
(DPROG (((PATTERNDESCRIPTOR goal:goalDesc MapDescriptor
(USEDIN triggers, traps, and function)))
(DoProcedures link
’ToMatch
(FUNCTION
(LAMBDA (triggerForm)
(DPROG ((result (EVAL triggerForm)))
(SELECTQ result
(OK (if (NOT FOCUSMATCHED)
then (desc ← (KrlCreate MapDescriptor scratchSpace))
(StoreMem desc focusSlot
(FetchMem PATTERNDESCRIPTOR
focusSlot (ConstantHandle)))
(StoreMem desc prototype
(FetchMem PATTERNDESCRIPTOR
prototype (ConstantHandle)))
(SetUpOneOf goal desc T)
(FOCUSMATCHED ← T))
(ALLOK (GoalDone goal ’SUCCEEDED))
(FAIL (GoalDone goal ’FAILED))
(SKIP (RETURN NIL))
(KHelp "bad value for ToMatch" result)))))))
else (KHelp "illegal result returned for ToFind" result))]