Page Numbers: Yes First Page: 1
Heading:
October 4, 1977 4:34 PM[IFS]<KRL>code>classes.bravo
Status: first pass
Class definitions for the KRL-1 matcher
There are four sets of classes, for Descriptors, Goals, GoalResultTypes, and Actions.
# # # # # # # # # # # # # # #
Goal type classes
[GoalClassPrototype ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP (* self is a the goal. value isn’t used)
(STARTUP (* self is the goal. Returns OK if initial descriptors are to be passed
through as NEWDESCRIPTOR, SKIP otherwise))
(NEWDESCRIPTOR
(* self is the goal. descriptor context world and fullContext are bound.
value isn’t used))
(NEWLINK (* self is the goal, link is bound Returns PASS if link is
to be passed down to subgoals, OK if link
is to be added to this goal only, SKIP otherwise))
(AFTERFIRST (* self is the goal))
(DESCRIBE (* self is goal. sent after first try, message is passed downward)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignAnchor ((self Goal)(message GoalMessage))
(* this is a function for a goal type -- goalargs used for map template if anchor is filler)
(SELECTQ message
(SETUP

(DPROG ((goal NIL Goal)
(meta (FetchMem self:goalDesc metaAnchor) (ONEOF Anchor NIL))
(doArg NIL (ONEOF BindingForm ActionForm))
(actions NIL (LISTP OF Action)))
(DECL ((alignEnvironment STACKP (BOUNDIN FullAlign))))

(self:goalType ← ’AlignAnchor)

(for descr fromField descrs ofHandle self:goalDesc
do (if self:suspended
then (RETURN)
else (goal ← (CREATE Goal
goalDesc ← descr
patternContext ← self:patternContext
datum ← self:datum
datumContext ← self:datumContext
parent ← self
resultType ← ’ConjunctiveSubgoal
links ← self:links
anchorPath ← self:anchorPath)
(* goalType will be filled in by SETUP action)
(SetUpGoalForDescriptor goal descr self)))

(if self:suspended then (RETURN))

(if meta
then (for metaDescriptor fromField descrs ofHandle meta
do (if self:suspended
then (RETURN)
elseif (OR (NEQ ’InterpretedMapD (TypeD metaDescriptor))
(NEQ ’Do (TypeI metaDescriptor))
(NOT (doArg ← (GetInterpretedArg metaDescriptor))))
then (MSignal UnknownMetaOnPatternAnchor
(OK (RETURN (* from loop through metadescriptors)))
(PROGN (GoalCompleted self ’FAILED)
(RETFROM AlignAnchor))))
(if (FMEMB doArg:1 ’(Bind BindElement))
then (goal ← (MakeNewFindGoal self doArg))
(SetUpGoal goal self)
else (PUSH actions (Create Action
actionForm ← doArg
actionBinding ← self:anchorPath))))
(if self:suspended
then (RETURN self)
elseif actions
then (self:immediateResults ←
(OR (for result in self:immediateResults
collect (CREATE Result
actions ← (if result:actions
then <! actions ! result:actions>
else actions)
bindings ← result:bindings))
<(CREATE Result actions ← actions)>)))

(if (NOT self:children)
then (self:results ← self:immediateResults)
(GoalDone self ’SUCCEEDED)))))

(STARTUP ’OK)
(AFTERFIRST ’OK)
(NEWDESCRIPTOR
(if (AND (EQ (TypeD descriptor) ’InterpretedMapD)
(EQ (TypeI descriptor) ’Not))
then (MSignal InvertingNotInDatum
(OK (* invert pattern and datum, and result sense)))))
(NEWLINK ’PASS)
(DESCRIBE (for child in self:children
do (SendMessage child:goalType child ’DESCRIBE)))
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignCoreference ((self Goal)(message GoalMessage))
(* this is a function for a goal type -- for non-POST coreferences )

(SELECTQ message
(SETUP
(if (for desc descriptorOf self:datum
thereis (AND (EQ (TypeD desc) ’Coreference)
(SameCoreference desc self:goalDesc)))
then (GoalDone self ’SUCCEEDED)))
(DESCRIBE
(AddAction self ’#AddToList (KrlCopy self:goalDesc) NIL ’AddDescriptor)
(GoalDone self ’SUCCEEDED)))
(STARTUP
(OR structuralMatch
(MSignal UsingCategoriesForPatternCoreference
(OK (self:patCategories ←
(GetCategories
(FetchMem self:goalDesc coref (ConstantHandle))))))
’OK)
(NEWDESCRIPTOR
(SELECTQ type
(Coreference (if (SameCoreference self:goalDesc descriptor)
then (GoalDone self ’SUCCEEDED)))
(InterpretedMapD
(CheckSimpleNot descriptor type self:goalDesc self))
NIL))
(AFTERFIRST
(if (NOT structuralMatch)
then (TriggerToFind self (CREATE Link
structure ← (FetchMem goal:goalDesc coref)
fullContext ←
(Create FullContext
world ← goal:patternContext:world
context ← NIL)))
(MSignal FollowingCoreferenceInPattern
(OK (DPROG((goal (CREATE Goal
goalType ← ’FindPost
resultType ← ’FindForCoreference
parent ← self
goalDesc ← NIL
datum ← (FetchMem self:goalDesc coref)
datumContext ← self:patternContext))
Goal))
(if (SetUpGoal goal self)
then (StartUpGoal goal))))))
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignContains ((self Goal)(message GoalMessage))
(* this is a function for a goal type -- it shoud be combined with the set and sequence stuff)
(SELECTQ message
(SETUP)
(STARTUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignContingency ((self Goal)(message GoalMessage))
(* this is a function for a goal type. It will never get set up for a structural match)
(SELECTQ message
(SETUP
(DPROG ((desc NIL Descriptor)
(newWorld
(SELECTQ (TypeI self:goalDesc)
(During (GetContingentWorld self:goalDesc
self:patternContext:world))
(KHelp UnknownContingencyType)))
Anchor)
(anchor (GetContingentDescription self:goalDesc) Anchor)
THEN (compatible (CompatibleWorld self:datumContext:world newWorld)
FLAG)
THEN (goal (CREATE Goal
goalType ← ’AlignAnchor
goalDesc ← anchor
patternContext ←
(CREATE FullContext
context ← self:patternContext:context
world ← newWorld)
datum ← (AND compatible self:datum)
datumContext ← self:datumContext
links ← (if (NOT compatible)
then <(CREATE Link
structure ← self:datum
fullContext ← self:datumContext)>)
anchorPath ← (AND compatible self:anchorPath)
parent ← self
resultType ← ’EquivalentGoal)
Goal))
(SetUpGoal goal self)))
(STARTUP ’SKIP)
(AFTERFIRST (self:goalStatus ← ’WAITING))
(NEWDESCRIPTOR (KHelp "Align contingency shouldn’t be ACTIVE" goal))
(NEWLINK ’PASS)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignMapDescMulti ((self Goal)(message GoalMessage))
(* this is a function for a goal type.. GoalArgs is a list of mapdescriptors which have been tried but set up no goal (either quick success or quick failure))
(SELECTQ message
(SETUP
(DPROG((type (TypeD self:goalDesc) (MEMQ MapDescriptor InterpretedMapD))
(patMapd (self:goalDesc) Descriptor))
(* MapDescriptor has already looked for quick reject and quick match if no slots are involved)
(for datDesc descriptorOf self:datum
when (AND (EQ (TypeD datDesc) type)
(SameFocusSlot datDesc patMapD))
do (if self:suspended then (RETURN))
(SetUpOneOf self (CopyHandle datDesc) NIL))
(STARTUP ’OK)
(DESCRIBE
(DPROG ((goal (for child in self:children
thereis (HasNoSlots child:goalArgs:1))
(ONEOF Goal NIL))
(desc NIL MapDescriptor))
(if (NOT goal)
then (desc ← (EmptyMapD self:goalDesc self:datum))
(SetUpOneOf self desc T)
(goal ← self:children:1)
(AddAction self ’#AddToList desc NIL ’AddDescriptor))
(SendMessage ’AlignMapDescOneOf goal ’DESCRIBE)))
(AFTERFIRST
(if (NOT structuralMatch)
then (TriggerToMatch self (AND (OR self:children self:goalArgs) T))))
(NEWDESCRIPTOR
(DPROG((patDesc self:goalDesc Descriptor) (goal NIL Goal))
(if (AND (NOT (KMemb descriptor self:goalArgs))
(EQ (TypeD descriptor) (TypeD patDesc))
(SameFocusSlot descriptor patDesc))
(NOT (for child in self:children
thereis (EQH child:datum descriptor))))
then (SetUpOneOf self descriptor T)
else (CheckSimpleNot descriptor type self:goalDesc self))))
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignMapDescOneOf ((self Goal)(message GoalMessage))
(* this is a function for a goal type -- goalArgs is CONS the specific datum mapD to align
with T if unique focus. anchorPath if present has a mapDescriptor on top)
(SELECTQ message
(SETUP
(DPROG((patMapD self:goalDesc MapDescriptor)
(datMapD self:goalArgs:1 MapDescriptor)
(goal NIL Goal)
THEN(focusSlot (FetchMem patMapD focusSlot (ConstantHandle)) SlotAnchor)
(prototype (FetchMem patMapD prototype) SlotAnchor)
THEN(unique (self:goalArgs::1) BOOL)
(fullContext
(CREATE FullContext
context ←
(CREATE Context
prototype ← prototype
instance ← (if (EQH focusSlot prototype)
then self:datum
else datMapD)
world ← self:datumContext:world)
FullContext))
(for pTemp fromField templateAnchors ofHandle patMapD
as pInst fromField instanceAnchors ofHandle patMapD
when (NOT self:suspended)
do (pTemp ← (CopyHandle pTemp))
(DPROG ((links
<(CREATE Link
structure ← pTemp
fullContext ← fullContext)>
(LST OF Link)
(* this is the link to get stuff from the prototype. also used for triggering)))
(if (EQH pTemp focusSlot)
then (* this is a case like "The x from a Foo with x =")
(PUSH links (CREATE Link
structure ← self:datum
context ← self:datumContext)))
(for dTemp fromField templateAnchors ofHandle datMapD
as dInst fromField instanceAnchors ofHandle datMapD
when (EQH dTemp pTemp)
do (SetUpAnchorGoal self
(CopyHandle pInst)
(CopyHandle dInst)
links
pTemp)
(RETURN (* from loop through datum pairs))
finally (* no pair was found in the datum)
(if canMatch
then (* just ignore this pattern slot and go on)
elseif (OR structuralMatch describe)
then (GoalDone self ’FAILED)
(RETFROM AlignMapDescOneOf)
else (SetUpAnchorGoal self (CopyHandle pInst) NIL links)))
(if (AND (NOT self:suspended) (NOT self:children))
then (self:results ← self:immediateResults)
(GoalDone self ’SUCCEEDED))))

(STARTUP (if self:goalArgs::1 then ’OK else ’SKIP))
(AFTERFIRST (self:goalStatus ←
(if self:goalArgs::1 then ’ACTIVE else ’WAITING)))
(NEWDESCRIPTOR
(DPROG((path self:anchorPath (LST OF DHandle))
(desc NIL Descriptor))
(if (NOT self:goalArgs::1)
then (KHelp "AlignMapDescOneOf shouldn’t be active" self)
elseif (AND (NOT (EQH descriptor self:goalArgs:1)
(EQ (TypeD descriptor) ’MapDescriptor)
(SameFocusSlot descriptor self:goalArgs:1))
then (path ← (AND path
(FindHandle descriptor path:2 descrs (ConstantHandle))
<descriptor ! path::1>))
(* This goal’s anchor path is set up by the first mapDescriptor found)
(for template fromField templateAnchors ofHandle descriptor
as instance fromField instanceAnchors ofHandle descriptor
do (for child in self:children
when (EQH template child:goalArgs)
do (if child:datum
then (AddLink child (CopyHandle instance)
fullContext)
else (child:datum ← (CopyHandle instance))
(child:datumContext ← fullContext)
(child:anchorPath ←
(AND path <child:datum ! path>))
(if (SetUpGoal child)
then (StartUpGoal child)))
(RETURN (* from loop through children for this slot))))
else (CheckSimpleNot descriptor type self:goalDesc self)))
(DESCRIBE
(DPROG((goal NIL goal) (anchor NIL Anchor)(path NIL (LISTP OF DHandle)))
(for child in self:children
when (NOT child:suspended)
do (if (path ← child:anchorPath)
then (goal ← child)
else (anchor ← (KrlCreate Anchor (SameSpace self:datum)))
(AddAction self ’#AddPair anchor NIL child:goalArgs)
(SetUpAnchorGoal self child:goalDesc anchor NIL)
(goal ← self:children:1)
(GoalDone child ’SUCCEEDED)
(* this is so the conjunction will succeed when the new ones are done))
(SendMessage ’AlignAnchor goal ’DESCRIBE)))
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignMapDescUnique ((self Goal)(message GoalMessage))
(* this is a function for a goal type == GoalArgs is a flag for whether descriptor has no slots
if there it is a handle for the focus slot)
(SELECTQ message
(SETUP
(if (HasNoSlots self:goalDesc)
then (self:goalArgs ← (FetchMem self:goalDesc focusSlot))
else (for descr fromField descrs ofHandle self:datum
when (AND (EQ (TypeD descr) ’MapDescriptor)
(SameFocusSlot descr self:goalDesc))
do (SetUpOneOf self (CopyHandle descr) NIL)
(* do this only for the first one)
(RETURN (* from loop through datum descriptors)))))
(STARTUP ’OK)
(NEWDESCRIPTOR
(if self:goalArgs
then (* pattern has no filler pairs)
(CheckCategoryStatus self self:goalArgs descriptor type T)
elseif (AND (EQ type ’MapDescriptor)
(SameFocusSlot descriptor self:goalDesc)
(NOT self:children))
then (SetUpOneOf self (CopyHandle descriptor) T)
(OR self:suspended (self:goalStatus ← ’WAITING))
(* a MatchMapDescOneOf goal is set up the first time a same-focus descriptor
is found, and it takes care of everything after that)
(DESCRIBE
(DPROG((goal NIL Goal) (desc NIL MapDescriptor)))
(if self:children then (goal ← self:children:1)
else (desc ← (EmptyMapD self:goalDesc self:datum))
(AddAction self ’#AddToList desc)
(SetUpOneOf goal desc T))
(SendMessage ’AlignMapDescOneOf goal ’DESCRIBE)))
(AFTERFIRST
(OR structuralMatch (TriggerToMatch self (AND self:children T)))
(if (AND (NOT self:suspended) self:children)
then (self:goalStatus ← ’WAITING))
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignMemberOf ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignNot ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP
(DPROG ((goal (CREATE Goal
goalType ← AlignAnchor
resultType ← ’InvertedGoal
parent ← self
anchorPath ← NIL
goalDesc ← (GetInterpretedArg self:goalDesc)
patternContext ← self:patternContext
datum ← self:datum
datumContext ← self:datumContext)
Goal))
(SetUpGoal goal self)))
(STARTUP (GoalWaiting self) ’SKIP)
(NEWDESCRIPTOR (KHelp "Shouldn’t be active" self))
(AFTERFIRST (KHelp "Shouldn’t be active" self))
(NEWLINK ’PASS)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignOr ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP
(for anchor fromField elements ofHandle (GetOrSequence self:goalDesc)
when (NOT self:suspended)
do (SetUpGoal (CREATE Goal
goalType ← ’AlignAnchor
goalDesc ← anchor
datum ← self:datum
anchorPath ← self:anchorPath
parent ← self
resultType ← ’DisjunctiveSubgoal
patternContext ← parent:patternContext
datumContext ← parent:datumContext
links ← self:links)
self)
finally (OR self:suspended self:children (GoalDone self ’FAILED))))
(STARTUP (GoalWaiting self) ’SKIP)
(NEWDESCRIPTOR (KHelp "shouldn’t be active" self))
(AFTERFIRST (KHelp "shouldn’t be active" self))
(NEWLINK ’PASS)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignPost ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP
(DPROG ((postDesc NIL Descriptor)
(category (SELECTQ (TypeD self:goalDesc)
((KrlPointer LispPointer)
(GetSystemCategory self:goalDesc))
NIL)
SlotAnchor)))
(for descr descriptorOf datum
do (if (IsPostDescriptor descr)
then (postDesc ← descr)(RETURN)
elseif (EQ (TypeD descr) ’MapDescriptor)
then (CheckCategoryStatus self
category descr ’MapDescriptor NIL)
else (CheckSimpleNot descr NIL self:goalDesc self))
(if postDesc
then (if (ComparePost postDesc self:goalDesc)
then (GoalDone self ’SUCCEEDED)
elseif (AND describe overWrite)
then (AddAction self ’#Clobber
(KrlCopy self:goalDesc) postDesc)
(GoalDone self ’SUCCEEDED)
else (GoalDone self ’FAILED)))
(KHelp))
elseif describe
then (AddAction self ’#AddToList (KrlCopy self:goalDesc))
(GoalDone self ’SUCCEEDED)
elseif canMatch
then (GoalDone self ’SUCCEEDED)
elseif structuralMatch
then (GoalDone self ’FAILED)
elseif category
then (self:patCategories ← <category>))))
(STARTUP
(if (EQ (TypeD self:goalDesc) ’Coreference)
then (MSignalC UsingCategoriesForPatternCoreference
(OK (self:patCategories ←
(GetCategories
(FetchMem self:goalDesc coref (ConstantHandle))))
’OK)
’SKIP)))
(NEWDESCRIPTOR
(if (IsPostDescriptor descriptor)
then (if (ComparePost descriptor self:goalDesc)
then (GoalDone self ’SUCCEEDED))
else (GoalDone self ’FAILED))))
(NEWLINK ’OK)
(AFTERFIRST
(if (AND (NOT structuralMatch)
(EQ (TypeD self:goalDesc) ’Coreference))
then (TriggerToMatch
self
(CREATE Link
structure ← (FetchMem self:goaldesc coref)
fullContext ← (CREATE Context
world ← self:patternContext:world)))))
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSequenceAny ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(STARTUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSequenceComplete ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSequenceEmpty ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSequenceMultiGap ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSequenceOf ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSequenceSingleGap ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSequenceSingleton ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSetAny ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSetComplete ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSetIncomplete ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSetNull ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSetOf ((self Goal)(message GoalMessage))
(* this is a function for a goal type -- goalArg = the argument)
(SELECTQ message
(NEW (self:goalArg ← (GetInterpretedArg self:goalDesc))
(NEWDESCRIPTOR
(SELECTQ type
(InterpretedMapD
(if (EQ ’SetOf (TypeI descriptor))
then (NewSubgoal goal ’AlignAnchor self:goalArg ’DisjunctiveSubgoal)))
(Set (* need stuff here which does enumerate and test))
NIL))
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignSetSingleton ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[AlignUsing ((self Goal)(message GoalMessage))
(* this is a function for a goal type)
(SELECTQ message
(SETUP)
(NEWDESCRIPTOR)
(AFTERFIRST)
(NEWLINK ’OK)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
# # # # # # # # # # # # # # #
[FindDescriptors ((self Goal)(message GoalMessage))
(* this is a function for a goal type: goalArgs is the test type, goalDesc the evaluated do form.)
(SELECTQ message
(SETUP
(DPROG ((test self:goalArgs)
(testType (TypeK test) LITATOM)
THEN(type (AND (EQ testType ’Descriptor)(TypeD test)) LITATOM))
(for descr descriptorOf datum
when (SELECTQ testType
(Descriptor
(AND (EQ (TypeD descr) type)
(Align (CopyHandle descr)
test (MatchTable ’SimpleStructuralMatch)))
(Lisp (OR (NULL test)(APPLY* test descr)))
(KHelp "illegal test for descriptor" test))
do (PUSH self:immediateResults (CopyHandleDescr))
(CheckCount self))
(if structuralMatch
then (CheckCount self T)))
(STARTUP ’SKIP)
(NEWDESCRIPTOR
(if (SELECTQ testType
(Descriptor
(AND (EQ (TypeD descr) type)
(Align (CopyHandle descr)
test (MatchTable ’SimpleStructuralMatch)))
(Lisp (OR (NULL test)(APPLY* test descr)))
(KHelp "illegal test for descriptor" test))
then (PUSH self:immediateResults (CopyHandleDescr))
(CheckCount self)))
(AFTERFIRST NIL)
(DESCRIBE (KHelp "can’t describe over a Find" self))
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[FindElements ((self Goal)(message GoalMessage))
(* this is a function for a goal type -- goalArgs is <variable type test count>. immediate results is used for a list of the elements found)
(SELECTQ message
(SETUP
(DPROG((count self:goalArgs:3)
(test self:goalArgs:4)
(results NIL LST))
(* datum has already been checked for CouldSatisfy)
(AND (NULL test)
(FIXP count)
(LESSP count 0)
(for anchor fromField elements ofHandle self:datum
as number from count
finally (count ← number)))
(for anchor fromField elements ofHandle self:datum
as number from 1
do (if (EQ (KrlType anchor) ’Ellipsis)
then (if (AND (FIXP count)(GREATERP count 0))
then (RETURN)
else (NCONC1 ’ELLIPSIS results))
elseif (AND (NULL test)(FIXP count)(NEQ number count))
then (NCONC1 ’IRRELEVANT results)
elseif (FMEMB self:goalArgs:2 ’(Element Anchor))
then (NCONC1 (CopyHandle anchor) results)
esle (NCONC1 ’UNKNOWN results)
(SetUpGoal
(CREATE Goal
goalType ← ’FindPost
goalDesc ← self:goalArgs
goalArgs ← number
patternContext ← self:patternContext
datum ← (CopyHandle anchor)
datumContext ← self:datumContext
anchorPath ← NIL
parent ← self
resultType ← ’FindElementForEnumeration)
self)
(AND(NULL test)(FIXP count)(RETURN))
finally (self:immediateResults ← results)
(CheckEnumerationSatisfied self))))
(STARTUP (GoalWaiting self) ’SKIP)
(NEWDESCRIPTOR (KHelp "shouldn’t be active" self))
(AFTERFIRST (KHelp "shouldn’t be active" self))
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[FindEnumeration ((self Goal)(message GoalMessage))
(* this is a function for a goal type. goalargs is variable, type, countSpec)
(SELECTQ message
(SETUP
(DPROG ((countSpec self:goalArgs:3 Count))
(for descr descriptorOf datum
do (SELECTQ (CouldSatisfyCount descr count)
(IMPOSSIBLE (GoalDone self ’FAILED))
(POSSIBLE (SetUpGoal
(CREATE Goal
goalType ← ’FindElements
goalDesc ← self:goalDesc
datum ← (CopyHandle descr)
resultType ← ’EquivalentGoal
parent ← self
goalArgs ← self:goalArgs
datumContext ← self:datumContext
links ← self:links)
self))
NIL)))
(STARTUP ’SKIP)
(NEWDESCRIPTOR
(SELECTQ (CouldSatisfyCount descr count)
(IMPOSSIBLE (GoalDone self ’FAILED))
(POSSIBLE (SetUpGoal
(CREATE Goal
goalType ← ’FindElements
goalDesc ← self:goalDesc
datum ← (CopyHandle descr)
resultType ← ’EquivalentGoal
parent ← self
goalArgs ← self:goalArgs
datumContext ← self:datumContext
links ← self:links)
self))
NIL))
(AFTERFIRST (OR structuralMatch
(for link in self:links do (TriggerToEnumerate self link)))
(NEWLINK (TriggerToEnumerate self link))
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
[FindPost ((self Goal)(message GoalMessage))
(* this is a function for a goal type -- goalDesc is binding spec -- GoalARgs isinteger for elements)
(SELECTQ message
(SETUP
(DPROG ((post NIL Descriptor))
(if (post ← (for descr descriptorOf self:datum
thereis (IsPostDescriptor descr)))
then (self:immediateResults ← (GetPost post selfgoalDesc:bindingType))
(OR self:goalArgs
(PUSH self:results
(CREATE Result
bindings ← <(CREATE Binding
variable ← self:goalDesc:bindingVariable
value ← (GetPost post spec:bindingType))>)))
(GoalDone self ’SUCCEEDED))
(STARTUP (OR structuralMatch
(for link in self:links do (TriggerToFind self link)))
’OK)
(NEWDESCRIPTOR
(DPROG((triggers NIL LST))
(if (IsPostDescriptor descriptor)
then (PUSH self:results
(CREATE Result
bindings ← <(CREATE Binding
variable ← self:goalDesc:bindingVariable
value ← (GetPost post spec:bindingType))>))
(GoalDone self ’SUCCEEDED))
elseif (AND (EQ (TypeK descriptor) ’MapDescriptor)
(triggers ←
(GetTriggers
(FetchMem descriptor focusSlot (ConstantHandle))))
then (TriggerToFind self triggers (FindSelfInstance descriptor)))))
(NEWLINK (TriggerToFind self link))
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #
Goal Result Classes
[ResultClassPrototype ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(SELECTQ message
(SUCCEEDED (* self is goal, this represents one-shot success))
(FAILED (* self is goal))
(ABORTED (* self is goal))
(PARTIALLY-SUCCEEDED (* self is goal, result is bound))
(COMPLETED (* self is goal, follows previous partial success))
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[ConjunctiveSubgoal ((self Goal)(message ResultMessage))
(* this is a function for a goal)
(DPROG((parent self:parent Goal) resultList partial? newResults)
(SELECTQ message
(SUCCEEDED
(if (for subgoal in parent:children
always (OR subgoal:results (EQ subgoal:goalStatus ’SUCCEEDED))
then (resultList ← parent:immediateResults)
(for subgoal in parent:children
when subgoal:results
do (if (NEQ subgoal:goalStatus ’SUCCEEDED)
then (partial? ← T))
(PUSH resultList subgoal:results))
(* in this case parent:results must be NIL, since one conjunct (this one) had never succeeded)
(if (NOT resultList)
then (GoalDone parent ’SUCCEEDED)
elseif (parent:results ← (IntersectResults resultList)))
then (if partial?
then (GoalPartiallySucceeded parent parent:results)
else (GoalDone parent ’SUCCEEDED))
else (GoalDone parent ’FAILED))))
(PARTIALLY-SUCCEEDED
(if (for subgoal in parent:children
always (OR subgoal:results (EQ subgoal:goalStatus ’SUCCEEDED))
then (resultList ← parent:immediateResults)
(for subgoal in parent:children
when (AND (NEQ subgoal self) subgoal:results)
do (PUSH resultList subgoal:results))
(if (newResults ← (IntersectResults <arg ! resultList>))
then (PUSHLIST parent:results newResults)
(GoalPartiallySucceeded parent newResults))))
(COMPLETED
(if (for subgoal in parent:children
always (EQ subgoal:goalStatus ’SUCCEEDED))
then (GoalDone parent ’SUCCEEDED)))
((FAILED ABORTED) (GoalDone parent ’FAILED))
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[DisjunctiveSubgoal ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(PROG((parent self:parent) resultList partial? newResults oldResults)
(SELECTQ message
(SUCCEEDED
(if self:results
then (AddResultsToOr parent self:results))
(* note that this means that if one branch of an or succeeds with no actions
or bindings, the others may not be tried (depending on the order of succcess))
else (GoalDone parent ’SUCCEEDED)))
((FAILED ABORTED) (CheckDisjunctCompletion parent))
(PARTIALLY-SUCCEEDED (AddResultsToOr parent result))
(COMPLETED (CheckDisjunctCompletion parent))
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[EquivalentGoal ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(PROG((parent self:parent))
(SELECTQ message
(SUCCEEDED (parent:results ← self:results) (GoalDone parent ’SUCCEEDED))
(FAILED (GoalDone parent ’FAILED))
(ABORTED)
(PARTIALLY-SUCCEEDED (GoalPartiallySucceeded parent result))
(COMPLETED (GoalDone parent ’COMPLETED))
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[FindElementForEnumeration ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(SELECTQ message
(SUCCEEDED
(RPLACA (NTH self:parent:immediateResults self:goalDesc)
self:immediateResults)
(CheckEnumerationSatisfied parent))
((FAILED ABORTED)
(RPLACA (NTH self:parent:immediateResults self:goalDesc)
’UNKNOWN)
(CheckEnumerationSatisfied parent))
((PARTIALLY-SUCCEEDED COMPLETED)
(KHelp "partial results to leaf on goal tree -- enumeration" goal))
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[FindForAction ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(SELECTQ message
(SUCCEEDED (PUSH self:results (MakeActionResult self result))
(SendMessage ’ConjunctiveSubgoal self ’SUCCEEDED))
((FAILED ABORTED) (SendMessage ’ConjunctiveSubgoal self message))
((PARTIALLY-SUCCEEDED COMPLETED)
(KHelp "partial results to leaf on goal tree -- action" goal))
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[FindForBinding ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(SELECTQ message
(SUCCEEDED
(self:results ← <(Create Result
bindings ← <<<self:goalDesc:1 . self:results>>>)>)
(PUSH self:completeBindings variable)
(SendMessage ’ConjunctiveSubgoal self ’SUCCEEDED))
((FAILED ABORTED) (SendMessage ’ConjunctiveSubgoal self message))
((PARTIALLY-SUCCEEDED COMPLETED)
(KHelp "partial results to leaf on goal tree -- binding" goal))
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[FindForCoreference ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(SELECTQ message
(SUCCEEDED (NewSubgoal self:parent ’AlignPost ??? ’EqivalentGoal)
(FAILED )
(ABORTED)
(PARTIALLY-SUCCEEDED)
(COMPLETED)
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[InvertedGoal ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(PROG((parent self:parent))
(SELECTQ message
(SUCCEEDED (GoalDone parent ’FAILED))
(FAILED (GoalDone parent ’SUCCEEDED))
(ABORTED)
(PARTIALLY-SUCCEEDED (GoalDone parent ’FAILED))
(COMPLETED (KHelp "partial success should have killed me" goal))
(HELP "bad message to goal result function")]
# # # # # # # # # # # # # # #
[TopLevelGoal ((self Goal)(message ResultMessage))
(* this is a function for a goal result)
(SELECTQ message
(SUCCEEDED (if self:results then (SuccessfulResults self:results))
(AlignCompleted ’SUCCEED))
(FAILED (AlignCompleted ’FAIL))
(PARTIALLY-SUCCEEDED (SuccessfulResults results))
(COMPLETED (AlignCompleted ’SUCCEED))
(ABORTED (AlignCompleted ’ABORT)]
# # # # # # # # # # # # # # #
DescriptorType Class
[DescriptorClassPrototype ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP (* self is a descriptor, goal is bound))
(ADDLINK (* self is descriptor, fullContext and goal are bound))
(TRY (* self is descriptor. fullContext, and goal are bound
returns OK if descriptor is to be used, SKIP otherwise))
(HELP "bad message to descriptor type function")]
# # # # # # # # # # # # # # #
[Coreference ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP
(goal:goalType ← (if (IsPrimaryCoreference self)
then ’AlignPost else ’AlignCoreference))
(SetUpGoal goal)))
(ADDLINK
(MSignal FollowingCoreference
(OK (AddLink goal (FetchMem self coref) NIL)))
(TRY ’OK)
(HELP "bad message to descriptor type function")]
[InterpretedMapD ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP
(if structuralMatch
then (SetUpGoalForDescriptor goal self ’MapDescriptor)
else (goal:goalType ←
(SELECTQ (TypeI self)
(During ’AlignContingency)
(Contains ’AlignContains)
(MemberOf ’AlignMemberOf)
(Not ’AlignNot)
(Or ’AlignOr)
(SequenceOf ’AlignSequenceOf)
(SetOf ’AlignSetOf)
(Using ’AlignUsing)
NIL))
(OR goal:goalType
(MSignalC UnknownInterpretedMapDInPattern
(OK T)
(SUCCEED (GoalDone goal ’SUCCEEDED))
(FAIL (GoalDone goal ’SUCCEEDED))
(AlignDone ’ABORT)))
(SetUpGoal goal))
(ADDLINK NIL)
(TRY
(DPROG((type (TypeI self) LITATOM))
(SELECTQ type
(During
(TryAnchor
(GetContingentDescription self)
self
(CREATE FullContext
context ← context
world ← (GetContingentWorld self)))
’SKIP)
(Default
(MSignal UsingDefault
(OK (TryAnchor (GetInterpretedArg descriptor) self fullContext))))
((Contains MemberOf Not Or SequenceOf SetOf Using)
(* these probably need to get filled in, at least some of them.
for the moment, they get passed on directly so that goals who
recognize them can use them.))
(MSignal UnknownInterpretedMapDInDatum)))
(HELP "bad message to descriptor type function")]
[KrlPointer ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP (goal:goalType ← ’AlignPost) (SetUpGoal goal))
(ADDLINK (* we might want to link to a generated desription of the object))
(TRY ’OK)
(HELP "bad message to descriptor type function")]
[LispPointer ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP (goal:goalType ← ’AlignPost) (SetUpGoal goal))
(ADDLINK (* we might want to link to a generated desription of the object))
(TRY ’OK)
(HELP "bad message to descriptor type function")]
[MapDescriptor ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP
(DPROG((focusFound NIL BOOL)
THEN (type (TypeD self) (ONEOF Descriptor InterpretedMapD)
(* this function is used by interpretedMapD in the structural case))
(dType NIL LITATOM)
(noSlots (HasNoSlots self) FLAG)
(category (FetchMem self focusSlot) (ONEOF Anchor NIL)))
(* first it does a quick check for category conflict or satisfaction of a no-slot map descriptor.
These are shared by unique and non-unique. Then it splits up those two cases.)
(category ← (AND (HasCategories category) category)
(for desc descriptorOf goal:datum
do (dType ← (TypeD desc))
(if (FMEMB dType ’(MapDescriptor LispPointer KrlPointer))
then (CheckCategoryStatus goal category desc dType T))
(if (AND (EQ type dType) (SameFocusSlot self desc))
then (if noSlots
then (GoalDone goal ’SUCCEEDED)
(RETFROM MapDescriptor))
else (focusFound ← T))))
(if focusFound
then NIL
elseif canMatch
then (GoalDone goal ’SUCCEEDED)
(RETFROM MapDescriptor)
elseif structuralMatch
then (GoalDone goal ’FAILED)
(RETFROM MapDescriptor))
(goal:goalType ← (if (HasUniqueFocus goal:goalDesc)
then ’AlignMapDescUnique
else ’AlignMapDescMulti))
(SetUpGoal goal)))
(ADDLINK
(DPROG((focusSlot (FetchMem descriptor focusSlot (ConstantHandle))
SlotAnchor)
(prototype (FetchMem descriptor prototype (ConstantHandle))
SlotAnchor))
(for template fromField templateAnchors ofHandle descriptor)
as instance fromField instanceAnchors ofHandle descriptor
when (EQH template focusSlot)
do (AddLink self (copyHandle instance) fullContext)
(RETURN (* from loop through slots))
(MSignal LinkingToPrototype
(OK(AddLink
self
(CopyHandle focusSlot)
(CREATE FullContext
context ←
(CREATE Context
prototype ← (CopyHandle prototype)
instance ←
(CREATE Link
structure ← (if (EQH focusSlot prototype)
then self:datum
else (CopyHandle descriptor))
fullContext ← self:datumContext)))))))
(MSignal FollowingMapLink
(OK (* "this looks in the slots of the mapD to see if they can be
inverted. e.g. if the mapD is \The x from a y thatis z/
then it looks in anchor z for \a y with x = .../ and creates
a link to the x filler anchor")
(HELP "not written")))
(TRY ’OK)
(HELP "bad message to descriptor type function")]
[Reflexive ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP (KHelp "ReflexiveInPattern"
(* this needs to be handled by the appropriate use of context, but it is
sufficiently rare that I haven’t bothered yet)))
(ADDLINK (KHelp "reflexive should be converted by TRY"))
(TRY
(if (NOT context)
then (KHelp "Reflexive out of context" descriptor)
else (MSignal ConvertingReflexiveInDatum
(OK (DPROG ((descriptor NIL MapDescriptor)
(prototype context:prototype SlotAnchor)
(instance context:instance Link)
(focusSlot (FetchMem self template (ConstantHandle))))
(SELECTQ (TypeK instance:structure)
(Anchor
(descriptor ← (KrlCreate MapDescriptor))
(StoreMem descriptor focusSlot focusSlot)
(StoreMem descriptor prototype prototype)
(IncludeHandle prototype descriptor templateAnchors)
(IncludeHandle instance:structure descriptor
instanceAnchors))
(MapDescriptor
(descriptor ← (KrlCopyAll instance:structure))
(StoreMem descriptor focusSlot focusSlot))
(KHelp "illegal link structure" instance))
(TryDescriptor descriptor goal instance:fullContext:context
fullContext:world))))
’SKIP)
(HELP "bad message to descriptor type function")]
[Sequence ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP
(DPROG ((count 0 FIXP) (gap NIL BOOL) (multiGaps NIL BOOL))
(for anchor fromField elements ofHandle self
do (if (NOT (EQ ’Ellipsis (KrlType anchor)))
then (count ← (count + 1))
elseif gap
then (multiGaps ← T)
else (gap ← T))
finally (goal:goalType ←
(if (EQ count 0) then (if gap then ’AlignSequenceAny
else ’AlignSequenceEmpty))
elseif multiGaps then (if (EQ count 1)
then ’AlignSequenceSingleton
else ’AlignSequenceMultiGap)
elseif gap then ’AlignSequenceSingleGap
else ’AlignSequenceComplete))
(SetUpGoal goal)))
(ADDLINK T)
(TRY ’OK)
(HELP "bad message to descriptor type function")]
[Set ((self Descriptor)(message DescriptorMessage))
(* this is a function for a descriptor type)
(SELECTQ message
(SETUP
(DPROG ((count 0 FIXP) (incomplete NIL BOOL))
(for anchor fromField elements ofHandle self
do (if (EQ ’Ellipsis (KrlType anchor))
then (incomplete ← T)
else (count ← (count + 1)))
finally (goal:goalType ←
(SELECTQ count
(0 (if incomplete then ’AlignSetAny else ’AlignSetNull))
(1 ’AlignSetSingleton)
(if incomplete
then ’AlignSetIncomplete else ’AlignSetComplete)))
(SetUpGoal goal))))
(ADDLINK T)
(TRY ’OK)
(HELP "bad message to descriptor type function")]
# # # # # # # # # # # # # # #
User Actions
[ActionClassPrototype (self message)
(* this is a function for an action type. In order to avoid name conflicts, those action types
which correspond to the top-level functions are prefixed with #.)
(SELECTQ message
(EXPAND (* self is the action for all of these. result, bindings,
newActions, unexpandedActions completedActions and
noEffectActions are all bound. Returns non-NIL if the
action has an effect (either direct or by subactions))
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#AddPair ((self Action)(message ActionMessage))
(* this is a function for an action type. arg is instance to be added to top element of binding, test is template)
(SELECTQ message
(EXPAND NIL)
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#AddToList ((self Action)(message ActionMessage))
(* this is a function for an action type. arg is thing to be added to top element of binding, test is type
of add -- (ONEOF AddDescriptor))
(SELECTQ message
(EXPAND NIL)
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#ChangeElement ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND
(DPROG ((spec self:actionSpec ActionForm)
(path NIL (LISTP OF DHandle))
(anchor NIL Anchor)
(actionType self:actionForm:actionType LITATOM)
THEN (types (SELECTQ actiontype
((AddBefore AddAfter) ’(Sequence))
’(Sequence Set))
(LISTP OF (ONEOF Set Sequence))))
(if (EQ spec:actionTest ’ME)
then (if (AND (FMEMB (KrlType spec:actionBinding:2) types)
(FMEMB spec:actionCount ’(NIL 1 ALL)))
then (path ← self:actionBindings)
else (KHelp "illegal use of ME in Action" self:actionForm))
elseif (NOT (path ← (RunGoal (MakeNewFindGoal NIL self))))
then (KHelp "element not found" self))
(anchor ← (KrlCreate Anchor (SameSpace path:1)))
(if (EQ actionType ’SubstituteElement)
then (AddSubAction self ’#Clobber anchor path)
else (AddSubAction self ’#AddToList anchor path actionType))
(AddSubAction self
’#AddDescription
spec:actionArg
<anchor ! (if (EQ actionType ’AddElement)
then path else path::1)>)))
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#ChangeDescriptor ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND
(DPROG ((spec self:actionSpec ActionForm)
(path NIL (LISTP OF DHandle))
THEN (arg spec:actionArg (ONEOF Anchor Descriptor))
(actionType self:actionForm:actionType LITATOM))
(if (EQ spec:actionTest ’ME)
then (if (AND (EQ (TypeK spec:actionBinding:2) ’Descriptor)
(FMEMB spec:actionCount ’(NIL 1 ALL)))
then (path ← self:actionBindings)
else (KHelp "illegal use of ME in Action" self:actionForm))
elseif (NOT (path ← (RunGoal (MakeNewFindGoal NIL self))))
then (KHelp "descriptor not found" self))
(arg ←
(SELECTQ (TypeK arg)
(Descriptor arg)
(Anchor (if (HasSingleDescriptor arg)
then (NthHandle arg descrs 1 (ConstantHandle))
else (KHelp "Descriptor action - arg not descriptor" self)))
(KHelp "Descriptor action with arg not descriptor" self)))
(arg ← (KrlCopy arg (SameSpace path:1)))
(if (EQ actionType ’SubstituteDescriptor)
then (AddSubAction self ’#Clobber descriptor path)
else (AddSubAction self ’#AddToList descriptor path actionType)))
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#Clobber ((self Action)(message ActionMessage))
(* this is a class for an action type.. arg is object to replace one at top of bindings)
(SELECTQ message
(EXPAND T)
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#Describe ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND
(DPROG ((spec self:actionSpec ActionForm)
(describe T BOOL)
(overWrite T BOOL)
THEN (actions
(RunGoal (Create Goal
goalType ← ’AlignAnchor
goalDesc ← spec:actionArg
datum ← self:actionBinding:1
anchorPath ← self:actionBinding
resultType ← ’AlignForDescribe)
(LISTP OF Action)))
(for action in actions
do (action:actionParent ← self)
(PUSH expandedActions action)))
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#MetaDescribe ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND (SubAction self
’#Describe
self:actionArgValue
(GetMetaAnchor self:actionBinding:1)
T))
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#Substitute ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND (SubAction self
’#Describe
self:actionArgValue
(GetMetaAnchor self:actionBinding:1)
T))
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
[#SubstituteDescriptor ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(bind ((path self:actionBinding)
(test self:actionArgValue)
(structuralMatch T)
(canMatch NIL)
(found NIL)
(apply (SELECTQ (TypeK self:actionArgValue))
(Descriptor NIL)
(Lisp T)
(KHELP "illegal test for descriptor" test))))
for descr fromField descrs ofHandle path:1
when (if apply
then (APPLY* test descr)
else (EQ ’SAME (CAR (SetupAnchorMatch test descriptor)))))
do (PUSH found copyHandle descr)
finally (RETURN (AND found (SubAction self ’RemD found)))))
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
??[#RemoveDescriptor ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND
(bind ((count (OR self:actionArg2Value 1))(test self:actionArgValue))
for descr fromField descrs ofHandle self:actionBinding:1
when (TestDescriptor descr test)
do (if (EQ count 1)
then (RETURN (SubAction self ’RemD (CopyHandle descr)))
else (count ← (SUB1 count)))
finally (* descriptor not found)
(KHELP "descriptor to be removed not found" self:actionForm)
(RETURN NIL)))
(BEFORE)
(DO)
(WHEN)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #