[Indigo]<KRL>code>descriptorClasses.bravo!1

[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")]

[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")]