September 17, 1976 2:08 PM[IVY]<KRL>document>ex-crypt-old
NewUnit takes only one arg which is the name
Need MakeKrlSequence -- takes LISP list of individuals, produces sequence description
ItSequence is like It, but returns list of individuals
AddBindings is a description of a match
Elimination set -- innitial,filter
EnumerateAndTest \\ a seek which expects an IN in its description -- returns a sequence
(RPAQQ CRYPTFNSFNS (AddendType AlsoDescribe Assign CallIfNeeded CheckAppearances
CheckIfDone CheckSEA Compute DOP1 DescribeColumn DoWhenKnown GetDigit GetLetters
GetValue GiveAnswer GoFill IQUOTIENT InitializeDigits MakeCharacterUnit MakeXorDescr
MarkImpossible OneAddend OnesDigit Parity PossibleLetterValues ProcessBothKnown
ProcessColumn ProcessColumn2 ProcessNeitherKnown ProcessOneBlank
ProcessRelatedPair ProcessSumEq ProcessTwin Propagate PushGlobalSignalPath
RemoveActionFromTrap ReportImpossibleProblem SetUpProblem ShortestArgList
TestCases TestMagnitudeDescription TryCasesForLetter TryElimination TryToFSP
TryToFSP2 TryToMatch UpEval UseList))
(DEFINEQ
(CallIfNeeded
[LAMBDA (priorityLevel processName processArgs) (* Issues a call if one
is not already on the
agenda.)
(if (for call in (AgendaLevel priorityLevel)
never (AND (EQUAL call:lispFunction processName)
(EQUAL call:lispArguments processArgs)))
then (Call priorityLevel processName processArgs])
(GetDigit
[LAMBDA (INT) (* Returns a single
digit)
(Item \(NTH @(ADD1 INT) AllDigits])
(GetValue
[LAMBDA (column slotName) (* just to avoid
repeating this sequence)
(FindItem (FindItem column ’Column slotName)
’Digit ’integer])
(InitializeDigits
[LAMBDA NIL
(* Creates the units for the digits.
Must be run after the unit for "Digit" is defined and before
any units that use digits in their definitions are loaded or
created.)
(PushSignalPath ReplaceOldUnitsSignalTable T)
AllDigits←(for digit
in ’(Zero One Two Three Four Five Six Seven Eight Nine)
as int from 0
collect [Describe (NewUnit ’Individual digit)
(MakeKrl ’(# (a Digit with integer =(#
(@ int]
(GU digit))
(PopSignalPath])
(MarkImpossible
[NLAMBDA (hypothesis) (* used in testing cases.
A signal catcher calls
this when a conflict is
noted.)
[Describe hypothesis (MakeKrl ’(a Hypothesis with status =(# Impossible]
’NOTOK])
(OneAddend
[LAMBDA (column knownDigit mysteryLetter)
(* Called when only one Addend is known)
(PROG (diff diffDescr carryIn knownInteger column total knownDigit mysteryLetter
carryOut columnNowDescr topDigit bottomDigit)
[Describe columnNow
(MakeKrl ’(a OneAddendKnown with mysteryLetter =(#
(@ mysteryLetter))
knownDigit =(# (@ knownDigit]
(carryIn←(Item (the carryIn from (a Column whichIs @column))))
(if total←(Item (the sum from (a Column whichIs @column)))
then (diff←(KMinus total knownInteger)
[Describe \(the value from (a Letter whichIs @mysteryLetter))
(if carryIn
then (GetDigit (KMinus diff carryIn))
else \(Or \(# (@(GetDigit diff)))
\(# (@(GetDigit (KMinus diff 1)]
elseif carryOut←(Item (the carryOut from (a Column whichIs @column)))
then
[Describe
mysteryLetter
(if carryOut =0
then \(a Letter with value =
(AtMost @(GetDigit (KMinus 9
(KPlus knownDigit
(OR carryIn 0))))))
else\(a Letter with value =
(AtLeast @(GetDigit (KMinus 10
(KPlus knownDigit
(OR carryIn 1]
(Describe
(Item (the sumLetter from (a Column whichIs @column)))
(if carryOut =0
then \(a Letter with value =
(AtLeast @(GetDigit (KPlus knownDigit
(OR (KPlus 1 carryIn) 1)))))))
else\(a Letter with value =
(AtMost @(GetDigit (KMinus knownDigit 1])
(OnesDigit
[LAMBDA (integer) (* gets the low order
digit and finds the
corresponding unit.
The ADD1 is because Zero
comes first in AllDigits)
(CAR (NTH AllDigits (REMAINDER integer 10)+ 1])
(ProcessBothKnown
[LAMBDA (column)
(* if both addends are known but the neither the sum nor the
carryin is known. First checks whether the need for this
still exists since it is scheduled very low priority.
Then makes a few vagues assertions about the sumletter and
hopes that TryElimination has some luck.)
(PROG (column carryIn topDigit bottomDigit carryOut sumDigit minimumSum sum)
(topDigit←(Item (the topDigit from (a Column whichIs @column)))))
(bottomDigit←(Item (the bottomDigit from (a Column whichIs @column)))))
(minimumSum←(KPlus topDigit bottomDigit)
(if carryIn
then (DescribeColumn column ’sum (KPlus minimumSum carryIn))
(* This should fire off
ProcessColumn to spread
the goodies)
elseif (AND carryOut (KEqual minimumSum 9))
then (if carryOut=0
then (DescribeColumn column ’sum 9)
else (DescribeColumn column ’sum 10))
else
(Describe
(Item (the sumLetter from (a Column whichIs @column)))
\(a Letter with value =
(Or \@(GetDigit (KTensDigit minimumSum))
\@(GetDigit (KTensDigit (KPlus minimumSum 1)])
(ProcessColumn
[LAMBDA NIL
(* called by a WhenKnown whenever a new value or carry is
known for a column. UNIT is the Column SLOTNAME is the slot
which was just filled. Basic strategy is to finda ll known
numbers, then compute new values for ones which the new
addition might affect, then check to see if any of the new
results are incompatible (which might happen in
hypotheticals) or previously unknown
(in which case it is added, triggering yet another round).
Finally if nothing new happened a low priority call to
ProcessColumn2 is put on (unless there is already one there)
to try some other strategies.)
(PROG (carryIn carryOut sum topDigit bottomDigit sumDigit newCarryIn
newCarryOut newSum newTopDigit newBottomDigit newSumDigit
newValue oldValue newInfo) (* get previous values
(indluding the one just
added))
(for slot in ’(carryIn carryOut sum topDigit bottomDigit sumDigit)
do (SET slot (Item (the @slot from (a Column whichIs @column)))))
(for pair in ’((carryIn ’(KMinus sum (KPlus topDigit bottomDigit)))
(carryOut ’(KTensDigit sum))
(sum ’(OR (KPlus topDigit (KPlus bottomDigit carryIn))
(KConcat carryOut sumDigit)))
(sumDigit ’(KOnesDigit sum))
(topDigit ’(KMinus sum (KPlus bottomDigit carryIn)))
(bottomDigit ’(KMinus sum (KPlus topDigit carryIn))))
do (if (newValue ← (EVAL pair:2))
then (if (oldValue ← (EVAL pair:1))
then (if (NOT (KEqual oldValue newValue))
then (Signal ’Contradiction))
else (SET pair:1 newValue)
(Call 1 ’Describe
<\(the @pair:1 from (a Column whichIS column))
(SELECTQ pair:1
((carryIn carryOut sum) newValue)
(GetDigit newValue))>])
(ProcessColumn2
[LAMBDA (UNIT)
(* tries to analyze column as one of a standard set of types
for which further inferences can be made.
Uses a manifestation to represent the state of knowledge
about this column at the current time.
The initial check is in case something new was learned after
this was scheduled, but before it got run.)
(if ~(OR (for name in ’(carryIn topDigit bottomDigit)
always (FindItem UNIT ’Column name))
(for letter in ’(topLetter bottomLetter)
thereis (MakeKrl ’Blank)=(FindItem UNIT ’Column letter)))
then (TryToFSP (NewManifestation UNIT)
’(OneAddendKnown BothAddendsKnown NeitherAddendKnown)
’(IF (FindItem (GetDescription UNIT (QUOTE SELF))
(QUOTE Column)
(QUOTE topDigit))
THEN (IF (FindItem (GetDescription UNIT
(QUOTE SELF))
(QUOTE Column)
(QUOTE bottomDigit))
THEN (LIST (QUOTE BothAddendsKnown))
ELSE (LIST (QUOTE OneAddendKnown)))
ELSE (IF (FindItem (GetDescription UNIT (QUOTE SELF))
(QUOTE Column)
(QUOTE bottomDigit))
THEN (LIST (QUOTE OneAddendKnown))
ELSE (LIST (QUOTE NeitherAddendKnown])
(ProcessNeitherKnown
[LAMBDA (manifestation)
(* Attempts to bound the sumLetter and carryOut for this
column. A fairly weak process, which should only be used at
low priority. First checks whether it is still appropriate
to current state of this column. If not, it schedules a
reclassification of the column.)
(PROG (column topLetter bottomLetter sumLetter carryIn carryOut parityTest
minSum maxSum fixLetter possTopValues possBotValues tPar bPar
sPar)
(column←(FindDescriptor manifestation ’Individual))
(if (OR (FindItem column ’Column ’topDigit)
(FindItem column ’Column ’bottomDigit))
then (CallIfNeeded 4 ’ProcessColumn2 <column>)
(RETURN))
(for let in ’(topLetter bottomLetter sumLetter)
do (SET let (FindItem column ’Column let)))
(carryIn←(FindItem column ’Column ’carryIn))
(possTopValues←(for desc in (PossibleLetterValues topLetter)
collect (FindItem desc ’Digit ’integer)))
(possBotValues←(for desc in (PossibleLetterValues bottomLetter)
collect (FindItem desc ’Digit ’integer)))
(if parityTest←[Compute (IPLUS (SETQ tPar (Parity possTopValues))
(SETQ bPar (Parity possBotValues]
then (if carryIn
then (parityTest←parityTest+carryIn)
(fixLetter←sumLetter))
elseif parityTest←(Compute
(IPLUS [SETQ sPar
(Parity (for dig
in (PossibleLetterValues sumLetter)
collect (FindItem dig (QUOTE Digit)
(QUOTE integer]
carryIn))
then (if (AND tPar ~bPar)
then (fixLetter←bottomLetter)
(parityTest←parityTest+tPar)
elseif (AND bPar ~tPar)
then (fixLetter←topLetter)
(parityTest←parityTest+bPar))
elseif parityTest←(Compute (IPLUS sPar bPar tPar))
then (DescribeColumn column ’carryIn (IREMAINDER parityTest 2)))
[if fixLetter
then (Describe fixLetter
(MakeKrl ’(a Letter with value =(#
(@(if (EQ 1
(IREMAINDER parityTest 2))
then (QUOTE (an OddDigit))
else (QUOTE (an EvenDigit]
(maxSum←(EVAL <’MAX ! possTopValues>)+(EVAL <’MAX ! possBotValues>)+(
OR carryIn 1))
(minSum←(EVAL <’MIN ! possTopValues>)+(EVAL <’MIN ! possBotValues>)+(
OR carryIn 0))
(if ~ carryOut
then (if maxSum LT 10
then (DescribeColumn column ’carryOut 0)
(carryOut←0)
elseif minSum GT 9
then (DescribeColumn column ’carryOut 1)
(carryOut←1)))
[if maxSum LT 9
then (Describe sumLetter
(MakeKrl ’(a Letter with value =(#
(someOne AtMost
(# (@(GetDigit maxSum]
(SELECTQ
carryOut
[0 (Describe sumLetter
(MakeKrl ’(a Letter with value =(#
(someOne AtLeast
(# (@(GetDigit minSum]
[1
(Describe
sumLetter
(MakeKrl
’(a Letter with value =(#
(someOne AtMost
(# (@(GetDigit (IDIFFERENCE maxSum 10]
NIL])
(ProcessOneBlank
[LAMBDA (column)
(PROG (loneLetter sumLetter loneValue sumValue) (* Figures out the
carryIn and fills in the
values of the two letters
if one is known.)
[if ~(loneLetter←(FindItem column ’OneBlank ’loneLetter))
then (OR loneLetter←(FindItem column ’Column ’topLetter)~=(GU
’Blank)
loneLetter←(FindItem column ’Column ’bottomLetter))
(Describe column (MakeKrl ’(a OneBlank with loneLetter =(#
(@ loneLetter]
[Describe loneLetter (MakeKrl ’(a Letter with value =(#
(someOne AtLeast (# One]
(if (EQUAL loneLetter sumLetter←(FindItem column ’Column ’sumLetter))
then (DescribeColumn column ’carryIn 0)
else
(DescribeColumn column ’carryIn 1)
(if loneValue←(FindItem loneLetter ’Letter ’value)
then
[if ~(FindItem sumLetter ’Letter ’value)
then
(Describe
sumLetter
(MakeKrl
’(a
Letter with value =(#
(@(GetDigit (IPLUS 1 (FindItem loneValue
(QUOTE Digit)
(QUOTE integer]
elseif sumValue←(FindItem sumLetter ’Letter ’value)
then
[Describe
loneLetter
(MakeKrl
’(a
Letter with value =(#
(@(GetDigit (IDIFFERENCE (FindItem sumValue
(QUOTE Digit)
(QUOTE integer))
1]
else (* Don’t know either one,
but know that sum is one
more than lone.)
(Call 5 ’ProcessRelatedPair
<loneLetter sumLetter ’ADD1 ’SUB1 >])
(ProcessRelatedPair
[LAMBDA (firstLetter secondLetter operation inverse)
(* Assigns the unknown if the other letter in pair is known,
else eliminates the possibilities for each based on
constraints on the other. If there is a computable inverse
of the relation, it is supplied as inverse, else it is NIL.)
(PROG (fVals sVals newFVals newSVals)
(fVals←(FindItem firstLetter ’Letter ’value))
(sVals←(FindItem secondLetter ’Letter ’value))
(if fVals
then
[RETURN
(OR
sVals
(Describe
secondLetter
(MakeKrl
’(a
Letter with value =(#
(@(GetDigit (EVAL (LIST operation
(FindItem fVals
(QUOTE Digit)
(QUOTE integer]
elseif sVals
then (if inverse
then (RETURN (ProcessRelatedPair secondLetter
firstLetter inverse))
else sVals← <(FindItem sVals ’Digit ’integer)>)
else sVals←(for v in (PossibleLetterValues secondLetter)
collect (FindItem v ’Digit ’integer)))
(* All the easy ways out have been taken;
now must try constraining each letter based on the relation
of its possible values to the possible values of the other
letter.)
(fVals←(for v in (PossibleLetterValues firstLetter)
collect (FindItem v ’Digit ’integer)))
(newSVals←(for f bind s in fVals when (MEMB s←(EVAL
<operation f>)
sVals)
collect s))
(newFVals←(if inverse
then (for s bind f in newSVals
when (MEMB f←(EVAL <inverse s>)
fVals)
collect f)
else (for f in fVals when (MEMB (EVAL <operation f>)
newSVals)
collect f)))
(for newVal in <newFVals newSVals> as oldVal in <fVals sVals>
as let in <firstLetter secondLetter>
do
(RemoveActionFromTrap let ’SELF ’WhenDescribed
<’CallIfNeeded 5 ’(QUOTE ProcessRelatedPair)
(KWOTE
<firstLetter secondLetter operation
inverse>)>)
(if ~(newVal::1)
then [Describe let (MakeKrl ’(a Letter with value =(#
(@(GetDigit newVal:1]
elseif (LESSP (LENGTH newVal)
(LENGTH oldVal))
then
[Describe
let
(MakeKrl
’(a
Letter with value =(#
(@*(MakeXorDescr
(for dig in newVal
collect
(MakeKrl (QUOTE (# (@(GetDigit dig]
(AddTrap let ’SELF
<’WhenDescribed
<’CallIfNeeded 5 ’(QUOTE ProcessRelatedPair)
(KWOTE <firstLetter secondLetter operation
inverse>)>>])
(ProcessSumEq
[LAMBDA (column)
(* Called when sum digit is the same as one of the addends.
Low priority since it is not based on the assumption that
anything is known. If choice can’t be made, it leaves a trap
calling for reprocessing any time anything in this column is
changed. Tests whether more has been found out since it was
scheduled; exits quietly if no longer needed.)
(PROG (loneLet loneDig carry)
(RemoveActionFromTrap column ’SELF ’WhenDescribed ’(CallIfNeeded
4
(QUOTE ProcessSumEq)
(LIST UNIT)))
(loneLet←(GetItem column ’SumEqualsAddend ’loneLetter))
[if (OR loneDig←(FindItem loneLet ’Letter ’value)
carry←(OR (FindItem column ’Column ’carryOut)
(FindItem column ’Column ’carryIn)))
then (Describe column (MakeKrl
’(a SumEqualsAddend with loneValue =(#
(@(OR loneDig (SETQ loneDig
(if (EQ carry 0)
then (GU (QUOTE Zero))
else (GU (QUOTE Nine]
(if (EQUAL (Match (MakeKrl ’(a SEA9))
column KnownToMatchTable)
’SAME)
then (Describe column (MakeKrl ’(a SEA9)))
elseif (EQUAL (Match (MakeKrl ’(a SEA0))
column KnownToMatchTable)
’SAME)
then (Describe column (MakeKrl ’(a SEA0)))
else [Describe loneLet (MakeKrl ’(a Letter with value =(#
(XOR (# Zero)
(# Nine]
(AddTrap column ’SELF ’(WhenDescribed
(CallIfNeeded 4 (QUOTE ProcessSumEq)
(LIST UNIT])
(ProcessTwin
[LAMBDA (column) (* column has same digit
on top and bottom.)
(PROG (letter sumValue sumDigit carryOut)
(RemoveActionFromTrap column ’SELF ’WhenDescribed ’(CallIfNeeded
4
(QUOTE ProcessTwin)
(LIST UNIT)))
(if (FindItem column ’Column ’topDigit)
then (RETURN))
[if sumValue ←(FindItem column ’Column ’sum)
then (DescribeColumn column ’carryIn (REMAINDER sumValue 2))
(DescribeColumn column ’topDigit (GetDigit (IQUOTIENT sumValue 2]
(if carryOut←(FindItem column ’Column ’carryOut)
then (Call 1 ’Describe
<(FindItem column ’Column ’topLetter)
[MakeKrl ’(a Letter with value =(#
(@(if carryOut =0
then ’(someOne AtMost (# Four))
else (QUOTE (someOne AtLeast
(# Five]>))
[if (FindItem column ’Column ’sumDigit)
then
(sumDigit←(GetValue column ’sumDigit))
(if ~(FindItem column ’Column ’carryIn)
then (DescribeColumn column ’carryIn (REMAINDER sumDigit 2)))
(Describe
(FindItem column ’Column ’topLetter)
(MakeKrl
’(a Letter with value =(#
(XOR [# (@(GetDigit (IQUOTIENT sumDigit 2]
(# (@(GetDigit (IQUOTIENT (IPLUS sumDigit 10)
2]
[if (FindItem column ’Column ’carryIn)
then
(Describe (FindItem column ’Column ’sumLetter)
(MakeKrl ’(# (a Letter with value =(#
(@(if (FindItem column
(QUOTE Column)
(QUOTE carryIn))=0
then (QUOTE (an EvenDigit))
else (QUOTE (an OddDigit]
(AddTrap column ’SELF ’(WhenDescribed (CallIfNeeded 4
(QUOTE
ProcessTwin)
<UNIT>])
(Propagate
[LAMBDA (feature) (* called in a WhenKnown
indicating that the
indicated descriptor is
to be added to the
description of the newly
known individual)
(Call 1 ’Describe <INDIVIDUAL:dBody (FindDescriptor (GetDescription
PROTOTYPE
SLOTNAME)
’Feature feature)
<<THISONEDESCR:TOPVAL (UnitDesc UNIT)>>>])
(PushGlobalSignalPath
[LAMBDA (NewSignalTable) (* Pushes a signal path
that stays independent of
the current call)
GLOBALSIGNALPATH:TOPVAL←(NewSignalPath NewSignalTable])
(RemoveActionFromTrap
[LAMBDA (unit slot typeTrap action) (* Searches the actions
on a particular trap for
an occurrance of action.
Restores all traps except
action to their original
from.)
(PROG (oldTraps newTraps)
(if oldTraps←(RemoveTrap unit slot typeTrap)
then (if newTraps←(for act in oldTraps::1
when ~(EQUAL act action) collect act)
then (AddTrap unit slot <typeTrap newTraps>])
(ReportImpossibleProblem
[LAMBDA NIL (* Called whenever
conflicting assignments
are made in the real
world as opposed to in
hypothetical worlds.)
(printout NIL (PPU CurrentProblem)
T "This problem is not well-formed." T
"Abandoning problem and returning to listening" T])
(ShortestArgList
[LAMBDA (XORlists) (* takes a set of XOR
descriptors and returns
the argument list of the
shortest)
(for descriptor in XORlists bind minLength←10
minList newLength
do (if (LESSP newLength←(LENGTH descriptor:booleanArgs)
minLength)
then (minLength←newLength)
(minList←descriptor:booleanArgs))
finally (RETURN minList])
(TestCases
[LAMBDA (unit descriptionList)
(* for each description in descriptionList, a hypothetical
world is created, and the description is added to unit as a
contingency. This is done with a limit on the priority level
of calls which propagate from it, so it goes on for a short
time finding implications. It is also done with a signal
catcher which converts all contradictions into a top level
rejection of the hypothesis. If all but the last one are
rejected, it is returned as the value.
If more than one is asserted without contradiction,
TestCases returns NIL.)
(PROG (descPlace desc restOfList world possibilities)
(RETURN
(for descPlace on descriptionList
do (desc←descPlace:1)
(restOfList←descPlace::1)
(world←(NewUnit ’Individual (GENSYM "H")))
(Describe world (MakeKrl ’(a Hypothesis)))
(SetWorld
world
(Call 2 ’Describe <unit desc> NIL
(NewSignalPath
<’ACTIONTABLE
’SIGNALS <’AddingConflictingIndividual
<’MarkImpossible world>>
’(AddingIndividual OK)
’(AddingDescriptor NOTOK)
’(AddingNewPerspective NOTOK)
’(AddingNewNormalPerspective NOTOK)
’(AddingNewPerspectiveForFeatures NOTOK)
’[AddingCallToAgenda (COND
((GREATERP (fetch priority
of call)
2)
(QUOTE NOTOK))
(T (QUOTE OK]>)))
(RescheduleMe 3)
(* this causes the Current call to be suspended and its
continuation put at Level 3 on the agenda, so it will not be
called until all of the level 1 and 2 propagation is
completed)
(if ~(GetPairFiller ’status
(GetDescriptor world ’Contingency world T)
)
then possibilities← <desc ! possibilities>)
(* if an inconsistency was found, the hypothesis will have
had its status slot filled with the unit Impossible.
If none was found, it will not be filled)
(SELECTQ (LENGTH possibilities)
(0 (if ~ restOfList::1
then (RETURN restOfList:1)))
(1 (if ~restOfList
then (RETURN possibilities:1)))
(RETURN NIL])
(TestMagnitudeDescription
[LAMBDA (perspective) (* Used by matcher to
determine whether a view
of something as a
magnitude relation is
correct.)
(PROG (greaterOne lesserOne)
(RETURN (if (AND greaterOne←(FindItem (GetPairFiller ’higher
perspective)
’Digit ’integer)
lesserOne←(FindItem (GetPairFiller ’lower
perspective)
’Digit ’integer))
then (if greaterOne LT lesserOne
then ’DIFFERENT
else ’SAME)
else ’NIL])
(TryCasesForLetter
[LAMBDA (letter cases)
(* used when there are only two alternatives for a letter.
sets up alternative worlds in which the letters have the
given values and looks for contradictions.
First tests for letter being solved between time it was
scheduled and the time it is actually executed.)
(PROG (goodGuy)
(if ~(Find1FromFiller (GetDescription letter ’SELF)
’Letter ’value ’Individual)
then (if goodGuy ←[TestCases letter
(for case in cases:booleanArgs
collect (MakeKrl ’(# (a Letter
with
value =(@
case]
then (Describe letter goodGuy])
(TryElimination
[LAMBDA NIL
(* called when a new descriptor is added to the filler of
value for a letter. UNIT is the letter, DESCRIPTION is the
description after adding. NEWDESCRIPTOR is the new
descriptor)
(PROG (possibilities oldList newList newLength (oldLength 10))
(if ~(FindIndividual DESCRIPTION)
then
(if (AND (KrlType NEWDESCRIPTOR)=’BOOLEAN
NEWDESCRIPTOR:connective=’XOR ~(
NEWDESCRIPTOR:booleanArgs::2))
then (CallIfNeeded 6 ’TryCasesForLetter
<UNIT NEWDESCRIPTOR>))
(if possibilities ←(FindDescriptors DESCRIPTION ’Form ’XOR)
then
(oldLength←(LENGTH oldList←(ShortestArgList possibilities)))
(newList←(for descr in oldList
when (AND ~(FindItem descr ’Digit ’symbol)
’SAME =(Match NEWDESCRIPTOR descr
KnownToMatchTable))
collect descr))
(if ~(EQUAL oldList newList)
then
(if newList::1
then
(Call 1 ’Describe
<UNIT
[MakeKrl ’(#
(a Letter with value =(#
(@(MakeXorDescr newList]>)
else (Call 1 ’Describe
<UNIT [MakeKrl ’(# (a Letter with value =(
@ newList:1]>)))
else [newList←(for dig in AllDigits
when (AND ~(FindItem dig ’Digit ’symbol)
(EQUAL ’SAME
(Match DESCRIPTION dig
KnownToMatchTable)))
collect (MakeKrl ’(# (@ dig]
(SELECTQ (newLength←(LENGTH newList))
(0 (Signal ’ElimiminatedAllPossibilities))
(1 (Call 1 ’Describe
<UNIT [MakeKrl ’(# (a Letter with value
=(# (@ newList:1]
>))
((2 3)
(Call 1 ’Describe
<UNIT
[MakeKrl
’(# (a Letter with value =(#
(@(MakeXorDescr newList]>))
NIL])
(TryToFSP
[LAMBDA (unit unitList differential)
(* Called in TRIGGER to further categorize UNIT.
unitList is a list of possible categories.
differential is a discriminator that will try to help sort
them out. It is code written to work on the possibilities in
the variable CANDIDATES (which starts out as a copy of
unitlist). The discriminator always returns a list of the
CANDIDATES that it cannot rule out. Thus, a non-existent
discriminator simply returns CANDIDATE, while a successful
one returns a list of one winner from CANDIDATES and a
mediocre discriminator returns a reduced version of
CANDIDATES. The lists here mentioned are lists of unit names
(atoms) rather than units themselves.
The unit being considered is really a unit.)
(PROG ((candidates unitList)
(choices (EVAL differential)))
(if choices
then (if choices::1
then (Call 2 ’TryToFSP2 <unit choices>)
else (Call 2 ’Describe <unit (MakeKrl ’(a (@ choices:1)))>]
)
(TryToFSP2
[LAMBDA (unit unitList) (* tries a simple match
assuming only one will
fit.)
(PROG (possibilities)
(possibilities←(for candidate in unitList bind descriptor
when (TryToMatch descriptor←(MakeKrl ’(a (@
candidate)))
unit)
collect descriptor))
(if possibilities
then (if possibilities::1
then (Signal ’FSPNotUnique)
else (Describe unit possibilities:1))
else (Signal ’FSPNoneMatch])
(TryToMatch
[LAMBDA (x y)
(PROG (PRINTOUT NIL T)
(EQUAL (Match x y KnownToMatchTable)
’SAME])
(UpEval
[LAMBDA (form)
(* Was used by TryToFSP, now here only in case of dire need;
seems to do bad things to the stack in some versions of
InterLisp and not in others.)
(STKEVAL (STKNTH -2 ’UpEval)
form T])
(UseList
[LAMBDA (feature) (* used for quick reject
in matching. descriptor
must be an XOR each
argument of which
contains an individual)
(if (for desc in (fetch booleanArgs
of (FindDescriptor (GetDescription UNIT SLOTNAME)
’Feature feature))
thereis (Match desc DATUM))
then ’SAME
else ’DIFFERENT])
)
(PRETTYCOMPRINT (V: CRYPTFNSVARS))
(RPAQQ CRYPTFNSVARS (CryptSignalTable QUICKFIND ReplaceOldUnitsSignalTable
InhibitCryptEliminationTable))
(DEFINEV
(CryptSignalTable (ACTIONTABLE SIGNALS (GoFillNotFound NOTOK)
(TrapAlreadyExists OK)
(TriggerAlreadyExists OK)
(CantRemoveTrap OK)
(CantRemoveTrigger OK)
(AddingConflictingIndividual
(ReportImpossibleProblem))
(Contradiction (ReportImpossibleProblem))
(TryingElimination OK)
(FollowingSpecificationIntoPrototype OK)
(FollowingSpecificationDeeper OK)))
(QUICKFIND (ACTIONTABLE SIGNALS (SearchingForIndividual NOTOK)
(CannotFindIndividual OK)))
(ReplaceOldUnitsSignalTable (ACTIONTABLE SIGNALS (UnitNameConflict OK)))
(InhibitCryptEliminationTable (ACTIONTABLE SIGNALS (TryingElimination NOTOK)))
)
(SETPROPLIST (QUOTE sum))
(SETPROPLIST (QUOTE SUM))
(PushSignalPath CryptSignalTable T)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML MarkImpossible DoWhenKnown Compute)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1849 44658 (AddendType 1861 . 2365) (AlsoDescribe 2369 . 2805)
(Assign 2809 . 3415) (CallIfNeeded 3419 . 3780) (CheckAppearances 3784 . 4604)
(CheckIfDone 4608 . 5682) (CheckSEA 5686 . 6494) (Compute 6498 . 7034) (DOP1
7038 . 7274) (DescribeColumn 7278 . 7577) (DoWhenKnown 7581 . 8980) (GetDigit
8984 . 9176) (GetLetters 9180 . 9820) (GetValue 9824 . 10022) (GiveAnswer
10026 . 10360) (GoFill 10364 . 11198) (IQUOTIENT 11202 . 11320) (InitializeDigits
11324 . 11864) (MakeCharacterUnit 11868 . 12209) (MakeXorDescr 12213 . 12486)
(MarkImpossible 12490 . 12778) (OneAddend 12782 . 15325) (OnesDigit 15329
. 15620) (Parity 15624 . 16142) (PossibleLetterValues 16146 . 17568) (
ProcessBothKnown 17572 . 18982) (ProcessColumn 18986 . 21376) (ProcessColumn2
21380 . 22619) (ProcessNeitherKnown 22623 . 25719) (ProcessOneBlank 25723
. 27368) (ProcessRelatedPair 27372 . 30013) (ProcessSumEq 30017 . 31560) (
ProcessTwin 31564 . 33342) (Propagate 33346 . 33809) (PushGlobalSignalPath
33813 . 34048) (RemoveActionFromTrap 34052 . 34573) (ReportImpossibleProblem
34577 . 34974) (SetUpProblem 34978 . 36370) (ShortestArgList 36374 . 36843)
(TestCases 36847 . 39079) (TestMagnitudeDescription 39083 . 39697) (
TryCasesForLetter 39701 . 40393) (TryElimination 40397 . 42237) (TryToFSP
42241 . 43296) (TryToFSP2 43300 . 43850) (TryToMatch 43854 . 43970) (UpEval
43974 . 44222) (UseList 44226 . 44655)))))
STOP