-
Notifications
You must be signed in to change notification settings - Fork 5
/
newans
1558 lines (1299 loc) · 47.8 KB
/
newans
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(declare (genprefix newans))
;;;################################################################
;;;
;;; NEWANS - (new) Answering component
;;;
;;;################################################################
(DEFUN ANSWER (NODE)
;;THE TOP LEVEL ANSWER FUNCTION CALLED TO CARRY OUT THE
;;RESULTS OF ANY INPUT SENTENCE, WHETHER COMMAND, QUESTION, OR
;;STATEMENT.
(PROG (ANSLIST AMBIG) ;ANSLIST IS THE LIST OF POSSIBLE ANSWERS. AMBIG
(SETQ ANSNAME NIL) ;IS A FLAG SET IF THERE IS A POSSIBLE AMBIGUITY
(SETQ AMBIG (CDR (SM NODE))) ;CLEAR OUT ANSWER NAMES SAVED FOR
(SETQ ANSLIST ;BACKREF(ERENCE) ..I.E. MORE THAN ONE RSS FOR
(ANSORDER (ANSUNIQUE (MAPCAR 'ANSGEN ;THE SENTENCE.
(SM NODE))))) ;ANSGEN GENERATES AN ANSWER FOR EACH
CHOOSE ;INTERPRETATION. ANSUNIQUE TAKES OUT REDUNDANT
(COND ((AND (CDR ANSLIST) ;ONES IN THE CASE THAT DIFFERENT INTERPRETATIONS
(NOT (ENOUGH-BETTER (CAR ANSLIST) ;LEAD TO THE SAME ANSWER. ANSORDER ORDERS THE
(CADR ANSLIST)))) ;REMAINING ONES BY PLAUSIBILITY.
(SETQ ANSLIST (ANSELIMINATE ANSLIST))
(GO CHOOSE))) ;IF NO ANSWER IS CLEARLY BEST, ASK THE USER FOR
(or annoyance (PRINT *3)) ;CLARIFICATION AND TRY AGAIN.
TEST-LOOP
(AND ANS-AFTERFORMULATION-PAUSE (ERT ANSWER HAS BEEN DETERMINED))
(EVLIS (ACTION? (CAR ANSLIST))) ;THE ACTION INCLUDES BOTH THE THINGS TO BE DONE
(PRINC '/.) ;AND THE INSTRUCTIONS FOR PRINTING A RESPONSE.
(TERPRI)
(AND ANS-TEST? (GO TEST-LOOP))
(DOBACKREF (CAR ANSLIST)) ;DOBACKREF STORES AWAY DISCOURSE INFORMATION
(RETURN T)))
;;;############################################################
(DEFUN AMBPUT (CODE)
;;PUTS IN THE JUNK FOR DISCOURSE IF THERE IS NO AMBIGUITY, SO
;;THERE IS NO NEED TO EVALUATE THE CODE A SECOND TIME WHEN
;;GIVING THE ANSWER.
(COND (AMBIG CODE) (T (PLNR-JUNKIFY CODE))))
;;;############################################################
(DEFUN ANSAY (X)
;;GENERATES THE SYNTAX FOR ANSWER ACTIONS FROM A PHRASE.
(LIST (CONS 'SAY X)))
;;;############################################################
(DEFUN ANSBUILD (PLAUS ACTION REDEDUCE)
;;BUILDS AN ANSWER NODE. IF REDEDUCE IS NON-NIL, IT ADDS A
;;REDEDUCTION OF THE ANSWER, ADDING THE DISCOURSE JUNK TO THE
;;ACTION.
(BUILD ANSNODE=
(MAKESYM 'ANS)
PLAUSIBILITY=
PLAUS
ANSRSS=
RSS
ACTION=
(APPEND (COND ((AND AMBIG REDEDUCE (NOT (CQ DECLAR)))
(CONS (LIST 'THVAL2
NIL
(LIST 'PLNR-JUNKIFY
(LIST 'PLNRCODE?
(LIST 'QUOTE
RSS))))
ACTION))
(T ACTION))
(AND (REL? RSS)
(NOT (CQ DECLAR))
(LIST (LIST 'PUTPROP
(QUOTIFY (REL? RSS))
(QUOTIFY ANS)
(QUOTIFY 'REFER=)))))))
(DEFUN ANSCOMMAND (RSS)
;;ANSCOMMAND RESPONDS TO IMPERATIVES.
(PROG (EXP ANS SUCCESS PLAN PLAN2)
(SETQ EXP (PLNR-ANDORIFY RSS)) ;PLNR-ANDORIFY COMBINES ANDS AND ORS INTO
(PUTPROP RSS EXP 'PLNRCODE=) ;APPROPRIATE PLANNER THANDS AND THORS.
(SETQ EXP (AMBPUT EXP))
(SETQ EXP (COND ((EQ (CAR EXP) 'THAND)
(APPEND EXP
'((SETQ SUCCESS T)
(SETQ PLAN2 PLAN))))
(T (LIST 'THAND
EXP
'(SETQ SUCCESS T)
'(SETQ PLAN2 PLAN)))))
(THVAL2 NIL
(COND (AMBIG (APPEND EXP '((THFAIL)))) ;IN CASE OF MULTIPLE INTERPRETATION, THE SYSTEM
(T EXP))) ;USES FAILURE TO WIPE OUT THE EFFECTS OF TRYING
(RETURN ;OUT ONE OF
(ANSBUILD (COND (SUCCESS (PLAUSIBILITY? RSS)) ; ;THEM. BEFORE
(T (DIFFERENCE (PLAUSIBILITY? RSS) ;FAILING IT MARKS DOWN WHETHER IT SUCCEEDED AND
512.))) ;SAVES THE PLAN FROM BACKTRACKING. PLNR-JUNKIFY
(COND (SUCCESS (APPEND (REVERSE PLAN2) ;PUTS ON THE JUNK FOR SAVING THE DISCOURSE
'((SAY OK)))) ;REFERENTS ETC. THE THIRD ARGUMENT TO ANSBUILD
(T '((SAY I CAN/'T)))) ;CAUSES THE SYSTEM TO GO BACK THROUGH THE
T)))) ;DEDUCTION TO GET THE DATA BASE STRAIGHT IF THIS
;ANSWER IS PICKED. IT ALSO TAKES CARE OF THE
;BACKREF STUFF.
;;;############################################################
(DEFUN ANSDECLARE (RSS)
;;FOR DECLARATIVES.
(COND
((OR? RSS)
(GLOBAL-ERR I DON/'T UNDERSTAND DISJUNCTIVE DECLARATIVES))
((AND? RSS)
(PROG (ANS)
(SETQ ANS (MAPCAR 'ANSDECLARE (AND? RSS))) ;CONJOINED DECLARATIVES ARE HANDLED BY DOING
(RETURN
(ANSBUILD
(APPLY 'PLUS ;EACH ONE SEPARATELY.
(MAPCAR 'PLAUSIBILITY? ANS))
(CONS '(SAY I UNDERSTAND)
(MAPCAN '(LAMBDA (X)
(DELETE '(SAY I UNDERSTAND)
(ACTION? X)))
ANS))
NIL))))
((NOT (ISTENSE (PARSENODE? RSS) 'PRESENT))
(GLOBAL-ERR I ONLY UNDERSTAND PRESENT TENSE DECLARATIVES))
(T (ANSBUILD (PLAUSIBILITY? RSS)
(CONS '(SAY I UNDERSTAND)
(MAPCAR '(LAMBDA (X)
(LIST 'THADD
(QUOTIFY (ANSTHM X))
NIL))
(RELATIONS? RSS)))
NIL)))) ;ANSTHM GENERATES THE APPROPRIATE ASSERTION OR
;THEOREM.
;;;############################################################
(DEFUN ANSELIMINATE (ANSLIST)
;;ELIMINATES ANSWERS FROM LIST BY ASKING PERSON TO CLEAR UP
;;THE AMBIGUITIES.
(PROG (AMB POSSIBILITIES XX)
(OR (SETQ AMB (AMBIGUITIES? (ANSRSS? (CAR ANSLIST))))
(BUG ANSELIMINATE -- NO AMBIGUITIES LIST))
UP (SETQ POSSIBILITIES (LIST (CAR AMB))) ;POSSIBILITIES IS THE LIST OF POSSIBLE
(MAPC ;INTERPRETATIONS FOR A SINGLE AMBIGUITY. WE ARE
'(LAMBDA (ANS) ;INSIDE A LOOP STARTING AT UP WHICH GOES THROUGH
(AND (SETQ XX ;ALL THE DIFFERENT POSSIBLE AMBIGUITIES ON THE
(PARSE-ASSOC (CAAR AMB) ;LIST FOR THE FIRST ANSWER ON ANSLIST.
(AMBIGUITIES? (ANSRSS? ANS))))
(NOT (MEMBER XX POSSIBILITIES))
(SETQ POSSIBILITIES (CONS XX POSSIBILITIES)))) ;ON EACH ANSWER WE LOOK FOR POSSIBLE
(CDR ANSLIST)) ;INTERPRETATIONS FOR THE PARTICULAR NODE WHERE
(COND ((CDR POSSIBILITIES) T) ;THE AMBIGUITY WAS CREATED.
((SETQ AMB (CDR AMB)) (GO UP))
(T (BUG ANSELIMINATE -- NO CONFLICT)))
(TERPRI)
(SAY I/'M NOT SURE WHAT YOU MEAN BY ")
(MAPC 'PRINT2
(FROM (NB (CADDAR AMB)) (N (CADDAR AMB))))
(SAY " IN THE PHRASE ")
(MAPC 'PRINT2
(FROM (NB (SETQ XX (PARENT? (CADDAR AMB))))
(N XX)))
(PRINC '"/.)
(TERPRI)
(SAY DO YOU MEAN:)
(SETQ XX 0.)
(MAPC '(LAMBDA (POSS) (PRINT (SETQ XX (ADD1 XX)))
(MAPC 'PRINT2 (CADR POSS))) ;THE PARAPHRASE
POSSIBILITIES)
(PRINC '?)
(TERPRI)
READ (SETQ XX (READ))
(COND ((OR (NOT (NUMBERP XX))
(GREATERP XX (LENGTH POSSIBILITIES)))
(TERPRI)
(SAY PLEASE TYPE ONE OF THE NUMBERS)
(TERPRI)
(GO READ)))
(SETQ POSSIBILITIES (NTH XX POSSIBILITIES))
(RETURN
(MAPBLAND
'(LAMBDA (ANS)
(COND
((OR
(NOT
(SETQ
XX
(PARSE-ASSOC (CAAR AMB)
(AMBIGUITIES? (ANSRSS? ANS)))))
(EQUAL XX POSSIBILITIES))
ANS)))
ANSLIST))))
(DEFUN PARSE-ASSOC (OSS AMBIG-LIST)
;;; PARSE-ASSOC GOES THRU AMBIG-LIST LOOKING FOR AN INTERPRETATION
;;; WITH THE SAME PARSE NODE
;;;
(PROG (ASS)
(SETQ ASS (CAR (PARSENODE? OSS)))
LOOP (COND ((NULL AMBIG-LIST) (RETURN NIL))
((EQ ASS (CAR (PARSENODE? (CAAR AMBIG-LIST))))
(RETURN (CAR AMBIG-LIST))))
(SETQ AMBIG-LIST (CDR AMBIG-LIST))
(GO LOOP)))
;;;############################################################
(DEFUN ANSGEN (RSS)
;;ANSGEN GENERATES AN ANSWER FOR A SINGLE INTERPRETATION.
(COND ((OR (CQ IMPER)
(AND (CQ QUEST)
(ISTENSE (PARSENODE? RSS) 'FUTURE))) ;FUTURE QUESTIONS ARE TREATED LIKE COMMANDS.
(ANSCOMMAND RSS))
((CQ DECLAR)
(PROG (X)
(RETURN (COND ((ERRSET (SETQ X (ANSDECLARE RSS)))
X)
((EQUAL GLOBAL-MESSAGE
'(THAT ISN/'T
THE
KIND
OF
THING
I
CAN
BE
TOLD))
(ANSQUEST RSS))
((ERR NIL)))))) ;THIS STRANGE CONSTRUCTION ALLOWS US A SECOND
((CQ QUEST) (ANSQUEST RSS)) ;CHANCE ON DECLARATIVES ABOUT THINGS WHICH CAN'T
((BUG ANSGEN -- WHAT KIND OF SENTENCE IS THIS?)))) ;BE TOLD TO THE SYSTEM. IF IT RUNS INTO ONE OF
;THEM IT TRIES TO ANSWER IT AS A QUESTION.
;;;#####################################################
(DEFUN ANSNAME (PHRASE)
;; THIS IS THE FUNCTION WHICH PARSES THE NAME PHRASES
;;GENERATED BY THE ANSWER ROUTINES SO THAT THEY CAN BE USED AS
;;REFERENTS FOR PRONOUNS (IT THEY ONE). ITS INPUT IS A TWO-
;;LIST. THE SECOND MEMBER IS THE ACTUAL REFERENT OF THE
;;PHRASE. THE FIRST IS A LIST OF COMMANDS FOR SAYING THE NAME
;;OF AN OBJECT(S). THE FIRST MEMBER OF THIS COMMAND LIST IS
;;GUARANTEED (BY ANSWER, VIA TW) TO BE A "SAY" COMMAND WHICH
;;ENDS WITH THE HEAD NOUN OF THE PHRASE. NOTE THAT ANSNAME IS
;;CALLED BEFORE ONEIFYING AND ITIFYING AND THE REST OF THAT
;;CRAP.
;;;
;; ANSNAME WORKS BY CALLED PARSE NG ON THE FIRST COMMAND OF
;;THE LIST. IT WANTS TO HAVE A PARSENODE AND AN OSSNODE BUILT
;;UP FOR THE OBJECTS. HOWEVER, IT DOES NOT WANT REFERENT
;;ASSIGNMENT DONE BY SMNG3, SINCE IT ALREADY KNOWS THE
;;REFERENT. THE FEATURE "ANSNAME" IS ADDED TO THE INITIAL NG
;;PARSE LIST SPECIFICALLY SO SMNG3 WILL IGNORE THIS NOUN
;;GROUP.
;;;
;; THE WAY ANSNAME WORKS IS THE DECLARE A LOT OF THE RELAVENT
;;PARSE FREE VARIABLES SO THAT IT LOOKS A LITTLE LIKE SHRDLU.
;;THE CRITICAL VARIABLES ARE:
;;; CUT - WHICH TELLS THE NG GUY HOW FAR TO GO.
;;; N - WHICH CONTAINS THE CURRENT SENTENCE.
;;; C - WHICH CONTAINS THE PARENT OF THE NEXT NODE.
;;; WE WANT C TO BE NIL TO STOP THE NG PROGRAM FROM
;;; CRAWLING OVER THE PARSE TREE.
;;;
(PROG (ANSNODE C N CUT)
(SETQ N (CDAAR PHRASE)) ; CDR IS TO REMOVE "SAY"
(SETQ ANSNODE (PARSE2 '(NG ANSNAME) T)) ; THE T SAYS NOT TO ATTACH THIS TO THE TREE
(OR ANSNODE
(RETURN (ERT ANSNAME:
FAILURE
TO
PARSE
ANSWER
NAME
BUT
IF
YOU
ONLY
EXPECT
THE
ANSWER
TO
BE
AN
ADJ,
PROCEED
THIS
AND
DON
'T
WORRY)))
(SETQ ANSNAME (APPEND ANSNODE ANSNAME)) ; LEAVE NODE AROUND IT ACCESSABLE PLACE
(PUTPROP (CAR (SM ANSNODE))
(CADR PHRASE)
'REFER=))) ; PUT THE REFERENT ON AS THE GUY GIVEN BY ANSWER
;;;############################################################
(DEFUN ANSNOREL (RSS)
;;FOR QUESTIONS WITH NO RELATIVE, LIKE "DID YOU PICK UP THE
;;BLOCK?" OR "WHY DID YOU DO THAT?"
(PROG (ANS TYPE CODE NODE VAR)
(SETQ NODE (PARSENODE? RSS))
(SETQ TYPE (COND ((ISQ NODE POLAR) 'POLAR) ;THE TYPE SHOULD BE POLAR, WHY, WHERE, WHEN, OR
((SETQ TYPE (GETR 'QADJ NODE))
(CAR (NB TYPE))) ;HOW.
((BUG ANSNOREL -- FUNNY TYPE))))
(PUTPROP (VARIABLE? RSS) T 'USED)
(SETQ CODE
(PLNR-DESCRIBE (RELATIONS? RSS)
(COND ((ISTENSE NODE
'PRESENT)
NIL) ;IN PRESENT TENSE CASES, WE DON'T LOOK FOR
((SETQ VAR (VARIABLE? RSS)))) ;EVENTS. OTHERWISE WE LOOK FOR A SET OF
(LIST (VARIABLE? RSS)))) ;APPROPRIATE EVENTS NO MATTER WHAT THE TYPE.
(PUTPROP RSS CODE 'PLNRCODE=)
(RETURN
(COND
((NOT VAR)
(SETQ ANS (THVAL-MULT (AMBPUT CODE)))
(ANSBUILD (PLUS (CAR ANS) (PLAUSIBILITY? RSS))
(COND ((CADR ANS) '((SAY YES)))
((ISTENSE NODE 'MODAL)
'((SAY I DON/'T KNOW)))
(T '((SAY NO))))
T))
((SETQ ANS (THVAL-MULT (PLNR-FINDIFY 'ALL
VAR
(LIST VAR)
(AMBPUT CODE))))
(ANSBUILD
(COND ((CADR ANS)
(PLUS (PLAUSIBILITY? RSS) (CAR ANS))) ;AN ANSWER IS VERY IMPLAUSIBILE IF IT MENTIONS
(T (DIFFERENCE (PLAUSIBILITY? RSS) 512.))) ;AN EVENT THE SYSTEM CAN'T FIND.
(COND ((NULL (CADR ANS))
'((SAY I CAN/'TDISCUSSA NON-EXISTENT EVENT)))
((APPEND (AND (EQ TYPE 'POLAR)
'((SAY YES)))
(LIST (LIST 'EVLIS
(LIST 'DESCRIBEVENT
(QUOTIFY (CADR ANS))
(QUOTIFY TYPE)))))))
T))))))
;;;############################################################
(DEFUN ANSORDER (LIST)
;;ORDERS A LIST BY PLAUSIBILITY HIGHEST FIRST.
(PROG (X Y)
GO (SETQ X LIST)
UP (COND ((NULL (CDR X)) (RETURN LIST))
((LESSP (PLAUSIBILITY? (CAR X))
(PLAUSIBILITY? (CADR X)))
(SETQ Y (CAR X))
(RPLACA X (CADR X))
(RPLACA (CDR X) Y)
(GO GO))
((SETQ X (CDR X)) (GO UP)))))
;;;############################################################
(DEFUN ANSQUEST (RSS)
;;ANSQUEST ANSWERS ALL TYPES OF QUESTIONS BY SENDING THEM OUT
;;TO ANSREL OR ANSNOREL DEPENDING ON WHETHER THERE IS A REL.
(COND
((OR (OR? RSS) (AND? RSS))
(PROG (ANS)
(SETQ ANS (MAPCAR 'ANSQUEST
(OR (AND? RSS) (OR? RSS))))
(RETURN
(ANSBUILD
(APPLY 'PLUS
(MAPCAR 'PLAUSIBILITY? ANS))
(APPEND
(AND (NOT (ISQ (PARSENODE? RSS) COMPONENT))
'((SAY YOU/'RE TRYING TO CONFUSE ME/.)))
(MAPCAN
'(LAMBDA (QUEST)
(APPEND
'((TERPRI))
(ANSAY
(ELIZA
(FROM (NB (PARSENODE? (ANSRSS? QUEST)))
(N (PARSENODE? (ANSRSS? QUEST))))))
'((PRINC '?) (TERPRI)) ;CONJOINED QUESTIONS ARE HANDLED BY SIMPLY
(ACTION? QUEST))) ;REPEATING EACH PART AND ANSWERING IT
ANS))
NIL)))) ;SEPARATELY.
((REL? RSS) (ANSREL RSS))
(T (ANSNOREL RSS))))
;;;############################################################
(DEFUN ANSREL (RSS)
;;ANSREL HANDLES ALL QUESTIONS WITH A RELATIVE NG OF ANY TYPE
(PROG (TYPE REL CODE PLAUS ANS PHRASE LENGTH NUM)
(OR (SETQ REL (REL? RSS)) (BUG ANSREL -- NO REL))
(SETQ PHRASE (CONS 'NIL
(HEADPART (PARSENODE? REL)))) ;THIS IS FOR THE PART OF THE GENERATOR THAT WILL
(SETQ TYPE (OR (QTYPE? REL) ;SUBSITUTE "ONE" FOR NOUN NAMES. THE LEADING
(QUANTIFIER? REL)
(BUG ANSREL -- NO TYPE))) ;NIL IS TO MAKE THIS PHRASE COMPATIBLE WITH THE
(AND (EQ TYPE 'ALL)
(PUTPROP RSS T 'NEGATIVE=)) ;"SAY" PHRASES WHICH THE OTHER PARTS GENERATE.
(PUTPROP ;UNIVERSALS ARE CONVERTED TO NOT THERE EXISTS
RSS ;NOT.
(SETQ
CODE
(PLNR-FINDIFY 'ALL
(VARIABLE? REL)
(LIST (VARIABLE? REL))
(PLNR-DESCRIBE (CONS RSS
(RELATIONS? REL))
(VARIABLE? REL)
(LIST (VARIABLE? REL)))))
'PLNRCODE=) ;CONSING THE RSS ONTO THE THINGS TO BE DESCRIBED
(SETQ ANS (THVAL-MULT (AMBPUT CODE))) ;HAS THE EFFECT OF PUTTING THE RELATION INTO THE
(SETQ PLAUS (CAR ANS)) ;DESCRIPTION OF THE OBJECT. DISAMB PUTS IN THE
(SETQ LENGTH (LENGTH (SETQ ANS (CADR ANS)))) ;JUNK IF THERE IS NO AMBIGUIT, AVOIDING HAVING
(RETURN ;TO GOTHROUGH THE EVALUATION A SECOND TIME.
(COND ;THVAL-MULT RETURNS A LIST OF A PLAUSIBILITY
((EQ TYPE 'ALL) ;AND AN ANSWER.
(ANSBUILD (PLUS PLAUS (PLAUSIBILITY? RSS))
(COND ((NULL ANS) '((SAY YES)))
((CONS '(SAY NO, NOT)
(PREPPUT (NAMELIST PHRASE
'INDEF
ANS)))))
T))
((EQ TYPE 'HOWMANY)
(ANSBUILD (PLUS PLAUS (PLAUSIBILITY? RSS))
(PREPPUT (NAMESUGAR LENGTH REL))
T))
((MEMQ TYPE '(WHICH WHAT))
(ANSBUILD (PLUS PLAUS
(PLAUSIBILITY? RSS)
(COND (ANS 512.) (0.)))
(PREPPUT (NAMELIST PHRASE 'DEF ANS))
T))
((EQ TYPE 'INDEF)
(SETQ NUM (NUMBER? REL))
(ANSBUILD
(PLUS PLAUS (PLAUSIBILITY? RSS))
(COND
((MEMQ NUM '(NS SG-PL))
(COND
((NULL ANS)
(COND ((ISTENSE (PARSENODE? RSS) 'MODAL)
'((SAY I DON/'T KNOW)))
(T '((SAY NO)))))
(T
(APPEND
'((SAY YES,))
(COND
((ISTENSE (PARSENODE? RSS) 'MODAL) NIL)
((PREPPUT
(APPEND (AND (CDR ANS)
(APPEND (NAMESUGAR LENGTH REL)
'((PRINC ':))))
(NAMELIST PHRASE
'INDEF
ANS)))))))))
((NUMBERP NUM)
(APPEND (COND ((EQ NUM LENGTH)
'((SAY YES,)))
((GREATERP LENGTH NUM) NIL) ;THIS IS THE CASE WHERE WE ARE CAGEY AND AVOID
((ZEROP NUM) '((SAY NO,))) ;ANSWERING YES OR NO.
(T '((SAY NO, ONLY))))
(COND ((EQ NUM LENGTH) NIL) ;THE NUMBER ISN'T REPEATED IF IT IS THE SAME AS
(T (PREPPUT (APPEND (NAMESUGAR LENGTH
REL) ;THE NUMBER IN THE SPECIFICATION.
'((PRINC ':))))))
(PREPPUT (NAMELIST PHRASE
'INDEF
ANS))))
((EQ (CAR NUM) 'EXACTLY)
(COND ((EQ LENGTH NUM) '((SAY YES)))
(T (CONS '(SAY NO,)
(PREPPUT (NAMESUGAR LENGTH RES))))))
((EQ (CAR NUM) '>)
(CONS (COND ((GREATERP LENGTH NUM)
'(SAY YES,))
((ZEROP LENGTH) '(SAY NO,))
(T '(SAY NO, ONLY)))
(PREPPUT (NAMESUGAR LENGTH REL))))
((EQ (CAR NUM) '<)
(CONS (COND ((LESSP LENGTH NUM) '(SAY YES,))
(T '(SAY NO,)))
(PREPPUT (NAMESUGAR LENGTH REL))))
((ERT ANSREL -- FUNNY NUMBER)))
T))
((ERT ANSREL-- FUNNY TYPE))))))
;;;############################################################
(DEFUN ANSTHM (EXP)
;;GENRATES A THEOREM OR ASSERTION FOR AN EXPRESSION
(PROG (NEG VARLIST BODY)
(COND
((ATOM EXP) (NOTELL)) ;NOTELL MARKS THAT THIS ISN'T THE KIND OF
((NOT (GET (CAR EXP) 'TELLABLE)) (NOTELL)) ;ASSERTION IT CAN HANDLE. IT USES GLOBAL-ERR
(T
(SETQ NEG (NEGATIVE? RSS))
(SETQ EXP (MAPCAR 'ANSTHMELEMENT
(PLNR-REMTIME EXP)))
(RETURN
(COND
((NOT (OR VARLIST NEG)) EXP) ;VAR AND NEG ARE SET AS FREE VARIABLES BY
(T
(PLNR-THCONSIFY
VARLIST ;ANSTHMELEMENT WHICH ANALYZES EACH ELEMENT. IF
EXP ;THERE ARE NO VARS, IT IS A SIMPLE ASSERTION.
(COND (NEG (PLNR-PROGIFY NIL
(LIST BODY
'(THFAIL THEOREM))))
(T BODY))))))))))
;;;############################################################
(DEFUN ANSTHMADD (OSS)
(SETQ VARLIST (CONS (VARIABLE? OSS) VARLIST))
(SETQ
BODY
(COND
(BODY
(PLNR-PROGIFY
NIL
(LIST BODY
(PLNR-DESCRIBE (RELATIONS? OSS)
(VARIABLE? OSS)
(LIST (VARIABLE? OSS))))))
(T (PLNR-DESCRIBE (RELATIONS? OSS)
(VARIABLE? OSS)
(LIST (VARIABLE? OSS))))))
(PLNR-VAR (VARIABLE? OSS)))
;;;############################################################
(DEFUN ANSTHMELEMENT (X)
(COND ((NOT (ATOM X)) X)
((TSS? X) (NOTELL))
((RSS? X) (NOTELL))
((NOT (OSS? X)) X)
((REFER? X) (ATOMIFY (REFER? X)))
((EQ (QUANTIFIER? X) 'ALL)
(COND (NEG (NOTELL)) (T (ANSTHMADD X))))
((EQ (QUANTIFIER? X) 'NO)
(SETQ NEG T)
(ANSTHMADD X))
((EQ (QUANTIFIER? X) 'NDET) (ANSTHMADD X))
((NOT (EQ (QUANTIFIER? X) 'INDEF)) (NOTELL))
((ISQ (PARSENODE? X) ANY) (ANSTHMADD X))
(T (GLOBAL-ERR YOU HAVE TO TELL ME WHICH))))
;;;############################################################
(DEFUN ANSUNIQUE (LIST)
;;THIS FUNCTION SHOULD ELIMINATE ANSWERS WHICH GIVE THE SAME
;;RESULT EVEN THHOUGH THEY INVOLVE DIFFERENT INTERPRETATIONS.
;;IT NEEDS TO CHECK FOR SIGNIFICANT DIFFERENCES, E.G. IN WHAT
;;GETS PRINTED OR DONE, WHILE IGNORING INSIGNIFICANT ONES,
;;E.G. THE NAMES OF ATOMS TO WHICH THINGS ARE ATTACHED. FOR
;;THE MOMENT, IT JUST RETURNS THE LIST UNTOUCHED.
LIST)
;FROM BOTH THE INPUT SENTENCE AND THE ANSWER.
(SETQ ANS-TEST? NIL)
;;;############################################################
(DEFUN ATOMIFY (X) (COND ((ATOM X) X) ((CDR X) X) ((CAR X))))
;;;############################################################
(DEFUN CUTOFF (X)
;;FOR CUTTING # OFF OF CONCEPT NAMES TO GET ENGLISH WORDS
(READLIST (CDR (EXPLODE X))))
;;;############################################################
(DEFUN DESCRIBEVENT (EVENT TYPE)
(PROG (ANS)
(SETQ EVENT (CAR EVENT))
(RETURN
(COND
((EQ TYPE 'WHERE)
(GLOBAL-ERR I CAN/'T ANSWER "WHERE" QUESTIONS YET))
((EQ TYPE 'WHY)
(COND ((EQ (GET EVENT 'WHY) 'COMMAND)
'((SAY BECAUSE YOU TOLD ME TO)))
(T (CONS '(SAY TO)
(NAMEACTION 'INFINITIVE
(GET EVENT
'WHY))))))
((EQ TYPE 'HOW)
(MAPCAR '(LAMBDA (X)
(AND (EQ (GET X 'WHY) EVENT)
(SETQ ANS (CONS X ANS))))
EVENTLIST)
(COND
((NULL ANS)
'((SAY I CAN/'T ANALYZE HOW I DID IT)))
(T
(APPEND
'((SAY BY))
(NAMEACTION 'ING (CAR ANS))
(MAPCAN
'(LAMBDA (X)
(CONS '(PRINC '/;)
(CONS '(SAY THEN)
(NAMEACTION 'ING X))))
(CDR ANS))))))
((OR (EQ TYPE 'POLAR) (EQ TYPE 'WHEN))
(COND
((EQ (GET EVENT 'WHY) 'COMMAND)
(COND
((EQ EVENT (TOPLEVEL (CAR EVENTLIST)))
'((SAY JUST NOW)))
(T
(CONS
'(SAY BEFORE)
(NAMEACTION
'PAST
(TOPLEVEL (CAR (FINDB EVENT EVENTLIST))))))))
(T (CONS '(SAY WHILE)
(NAMEACTION 'PRES-PAST
(TOPLEVEL EVENT))))))
((BUG DESCRIBEVENT -- FUNNY TYPE))))))
;;;############################################################
(DEFUN DISPUT (ASSERTION)
;;PUT THE SENTENCE NUMBER ON THE ASSERTION AS A WHO PROPERTY
(OR (NOT DISCOURSE) (PUTPROP ASSERTION SENTNO 'WHO)))
;;;############################################################
(DEFUN ELIZA (NODE)
;;DOES THE OBVIOUS THING
(PROG (XX NUM)
(SETQ NUM (LENGTH (N NODE)))
(RETURN
(APPLY
'APPEND
(MAPLIST
'(LAMBDA (WORD)
(COND ((NOT (LESSP NUM (LENGTH WORD))) NIL) ;THIS KLUDGE STOPS IT AT THE END OF THE NODE
((SETQ XX (ASSQ (CAR WORD)
'((I YOU) (ME YOU)
(AM ARE) (ARE AM))))
(CDR XX)) ;WE RETURN LIST OF THE THING REALLY WANTED, SO
((EQ (CAR WORD) 'YOU) ;THE APPLY APPEND CAN GET RID OF THE EMPTY ONES.
(SETQ XX (FINDMOTHER WORD NODE)) ;UNFORTUNATELY, FOR "YOU" IT IS NECESSARY TO
(COND ((ISQ XX SUBJ) '(I)) ;DECIDE WHETHER IT SHOULD BE REPLACED BY "I" OR
((ISQ XX OBJ) '(YOU)) ;"ME", ACCORDING TO WHETHER IT WAS PARSED AS AN
((BUG ELIZA -- SUBJ OBJ)))) ;OBJECT OR SUBJECT. FINDMOTHER IS USED TO FIND
((LIST (CAR WORD))))) ;THE PARSE NODE. WORDS OTHER THAN THE SPECIAL
(NB NODE)))))) ;ONES GO THROUGH DIRECTLY.
;;;############################################################
(DEFUN ENOUGH-BETTER (ANS1 ANS2)
(GREATERP (PLAUSIBILITY? ANS1)
(PLUS (PLAUSIBILITY? ANS2) TIMID)))
;;;############################################################
(DEFUN FINDMOTHER (WORD NODE)
;;FINDMOTHER TAKES A PLACE IN THE SENTENCE AND A GRAMMAR NODE
;;(BOTH ARE ACTUALLY LISTS) AND FINDS THE SINGLE-WORD
;;CONSTITUTENT BEGINNING AT THAT PLACE IN THE SENTENCE.
(COND ((AND (EQ WORD (NB NODE)) (EQ (CDR WORD) (N NODE))) NODE)
(T (APPLY 'APPEND
(MAPLIST '(LAMBDA (NOD) (FINDMOTHER WORD NOD))
(H NODE))))))
;;;############################################################
(DEFUN HEADPART (NODE)
(AND (SETQ PT NODE)
(MOVE-PT DLC PV (NOUN))
(FROM (NB NODE) (N PT)))) ;EVERYTHING UP TO THE NOUN, FOR EXAMPLE "THE RED
;BLOCK" IN "THE RED BLOCK WHICH..." NOTE THAT
;NODE IS ACTUALLY A LIST OF NODE (A PROPER
;GRAMMAR POINTER).
;;;############################################################
(DEFUN LISTNAMES (PHRASE SPEC NAMES)
;;PHRASE IS THE INITIAL THING TO COMPARE FOR USING "ONE", SPEC
;;IS EITHER DEF OR INDEF, AND THE NAMES ARE OF DATA-BASE
;;OBJECTS. LISTNAMES PUTS OUT AN ACTION LIST, AS WELL AS
;;PUTTING THINGS ONTO THE BACKREF. IT IS CALLED AFTER THE
;;ANSWER HAS BEEN DECIDED ON.
(PROG (COUNT EXAM X RES ANS COMMA?)
(SETQ NAMES (MAPCAR '(LAMBDA (X) (NAMEOBJ X SPEC))
NAMES)) ;NAMEOBJ RETURNS A LIST OF THE OBJECT AND THE
(COND ((NULL NAMES) (RETURN '(SAY NOTHING)))) ;THIS PATCH MAY WELL BE TOTALLOUT OF PHASE WITH
UP (SETQ COUNT 1.) ;THE BACKREF HACKER - DDM 5-12-73 INSTRUCTIONS
(SETQ EXAM (CAR NAMES)) ;FOR NAMING IT.
(SETQ NAMES (CDR NAMES))
BACK (COND ((SETQ X (ASSOC (CAR EXAM) NAMES))
(SETQ NAMES (DELQ X NAMES))
(SETQ COUNT (ADD1 COUNT))
(SETQ EXAM (LIST (CAR EXAM)
(APPEND (CADR X) (CADR EXAM))))
(GO BACK))) ;WHEN THERE ARE TWO OBJECTS WITH THE SAME
(SETQ RES (CONS (CONS (PLURALIZE (CAR EXAM) COUNT)
(CDR EXAM))
RES)) ;ENGLISH DESCRIPTIONS, A JOINT OBJECT IS
(AND NAMES (GO UP)) ;PRODUCED COMBINING THE OBJECTS. THE COUNT IS
(SETQ ;LATER USED TO PUT IN THE APPROPRIATE NUMBER,
RES ;AND THE DESCRIPTION IS CHECKED TO SEE IF "ONE"
(MAPCAR '(LAMBDA (PHRASE2) ;CAN BE USED. ADD THE ONE JUST PRODUCED TO THE
(COND ((PROPNAME (CAADR PHRASE2)) ;RESULT LIST. TRY ANOTHER.
(CAR PHRASE2))
(T (ANSNAME PHRASE2) ;ANSNAME PARSES THE PHRASE AND PUTS THE
(ONECHECK (CAR PHRASE2))))) ;ANSONE SUBSTITUTES "ONE" IF POSSIBLE
RES))
(SETQ ANS (CAR RES))
OUTPUT
(COND ((NULL (SETQ RES (CDR RES))) (RETURN ANS))
((CDR RES)
(SETQ COMMA? T)
(SETQ ANS (APPEND ANS
'((PRINC '/,))
(CAR RES))))
((SETQ ANS (APPEND ANS
(AND COMMA?
'((PRINC '/,)))
'((SAY AND))
(CAR RES)))))
(GO OUTPUT)))
;;;############################################################
(DEFUN NAMEACTION (TENSE EVENT)
;;THIS FUNCTION SETS UP A LIST OF S-EXPRESSIONS
;;WHICH ARE RETURNED TO DESCRIBEVENT AND WHICH
;;WHEN EVALUATED WILL PRINT OUT AN ENGLISH DESCRIPTION
;;OF THE SINGLE, SIMPLE EVENT IMBEDDED IN THE LIST
;;"THASSERTION" WITH THE TENSE SPECIFIED
(PROG (PLNR-FORM VERB OBJ1 OBJ2)
(SETQ PLNR-FORM
(CAR (CADDR (CADADR (GET EVENT
'THASSERTION)))) ;THE THASSERTION PROPERTY IS A LIST THAT
VERB ;TYPICALLY LOOKS LIKE "(NIL (2 (3 1 ((#GRASP
(CUTOFF (CAR PLNR-FORM)) ;:E2 :B6)))))"
OBJ1
(CADDR PLNR-FORM)
OBJ2
(CADDDR PLNR-FORM))
(SETQ FOOBAR
(COND ((EQ VERB 'CLEARTOP)
(CONS (SAYIFY (VBFIX 'CLEAN NIL)) ;SAYIFY WRAPS THE FUNCTION "SAY" ARROUND A LIST
(PRON-PRT 'OFF OBJ1))) ;OF WORDS AND RETURNS THE RESULTING S-EXPRESSION
((EQ VERB 'GET-RID-OF) ;NAMELIST-EVALED '(NIL) 'DEF RETURNS A LIST (!!!) OF
(CONS (SAYIFY (VBFIX 'GET T) ;S-EXPRESSIONS
'RID
'OF)
(NAMELIST-EVALED '(NIL) 'DEF OBJ1)))
((EQ VERB 'GRASP)
(CONS (SAYIFY (VBFIX 'GRASP T))
(NAMELIST-EVALED '(NIL) 'DEF OBJ1)))
((EQ VERB 'PICKUP)
(CONS (SAYIFY (VBFIX 'PUT T))
(PRON-PRT 'UP OBJ1)))
((EQ VERB 'PUTON)
(APPEND (CONS (SAYIFY (VBFIX 'PUT T))
(NAMELIST-EVALED '(NIL)
'DEF
OBJ1))
(CONS '(SAY ON)
(NAMELIST-EVALED '(NIL)
'DEF
OBJ2))))
((EQ VERB 'STACKUP)
(CONS (VBFIX STACK T) (PRON-PRT 'UP OBJ1)))
((EQ VERB 'RAISEHAND) NIL)
(T (BUG NAMEACTION
-
I
DON/'T
KNOW
WHAT
TO
DO
WITH
THE
VERB
I
GOT))))
(RETURN FOOBAR)))
;;;############################################################
(DEFUN NAMELIST (ONE SPEC LISTX)
;;GENERATES A LIST OF EXPRESSIONS TO BE EVALUATED WHICH WILL
;;CAUSE THE APPROPRIATE NAMELIST TO BE PRINTED OUT. THE
;;ARGUMENTS ARE JUST THOSE TO LISTNAMES.
(LIST (LIST 'EVLIS
(LIST 'LISTNAMES
(QUOTIFY ONE)
(QUOTIFY SPEC)
(QUOTIFY LISTX))))) ;A TYPICAL CALL WOULD RESULT IN A VALUE OF
;((EVLIS(LISTNAMES '(A RED BLOCK) 'INDEF '(:B1
;:B7)))) WHICH WOULD BE EVALUATED LATER. NOTE
;THAT LISTNAMES WILL IN TURN PRODUCE A LIST OF
;EXPRESSIONS TO BE EVALUATED, WHICH WILL BE
;CAUGHT BY THE EVLIS. CONFUSING?
;;;############################################################
(DEFUN NAMELIST-EVALED (ONE SPEC LISTX)
(PROG (F)
(SETQ F (LIST 'LISTNAMES
(QUOTIFY ONE)
(QUOTIFY SPEC)
(QUOTIFY LISTX)))
(RETURN (LIST (EVAL F)))))
;;;############################################################
(DEFUN NAMENUM (X)
;;GENERATES NUMBER NAMES
(OR (NTH (ADD1 X)
'(NONE ONE
TWO
THREE
FOUR
FIVE
SIX
SEVEN
EIGHT
NINE
TEN))
(GLOBAL-ERR I CAN/'T COUNT THAT HIGH)))
;;;############################################################
(DEFUN NAMEOBJ (ITEM SPEC)
;;NAMES THE OBJECT IN ENGLISH -- GENERATES LIST OF THINGS TO
;;BE EVALUATED. SPEC IS EITHER 'INDEF OR 'DEF
(PROG (TYPE: TYPELIST TYPE NAME: COLOR: COLORLIST SIZE:
SIZELIST CUBE NAME X)
(AND (SETQ X (ASSOC ITEM
'((:SHRDLU I) (:FRIEND YOU))))
(RETURN (LIST (ANSAY (CDR X)) (LIST ITEM)))) ; SPECIAL CASE CHECK
(THVAL2 NIL
'(THGOAL (#NAMEOBJ) (THUSE TC-NAMEOBJ)))
(OR TYPELIST
(ERT NAMEOBJ -- OBJECT WITH NO #IS ASSERTION))
(DISPUT TYPE:) ;DISPUT CHECKS TO SEE IF DISCOURSE IS BEING
(COND ((EQ (SETQ TYPE (CADDAR TYPE:)) '#NAME) ;KEPT, AND IF SO PUTS THE RELEVANT SENTENCE
(RETURN (LIST (ANSAY (LIST ITEM)) (LIST ITEM)))) ;NUMBER AS A PROPERTY ON THE ASSERTION. A NAME
((MEMQ '#PROPERTY (GET TYPE 'SYS)) ;IS ITS OWN NAME
(RETURN (LIST (ANSAY (LIST (CUTOFF ITEM)))
(LIST ITEM)))) ;CUTOFF CUTS THE # OFF OF NAMES LIKE #RED AND
((NOT (CDR TYPELIST)) ;#POINTED WHICH ARE USED FOR PROPERTIES.
(RETURN (LIST (ANSAY (LIST 'THE
(CUTOFF TYPE)))
(LIST ITEM)))) ; THERE IS ONLY ONE OBJECT OF THIS TYPE (E.G.
(CUBE (SETQ NAME '(CUBE))) ;TABLE, BOX, HAND)
((SETQ NAME (LIST (CUTOFF TYPE))))) ;E.G. #BLOCK BECOMES BLOCK.
(AND NAME:
(RETURN (LIST (ANSAY (LIST 'THE
(CAR NAME)
'NAMED
(CADDAR NAME:)))
(LIST ITEM)))) ;E.G. THE BLOCK NAMED SUPERBLOCK.
(DISPUT COLOR:) ;IF WE HAVEN'T RETURNED YET, COLOR
(SETQ NAME (CONS (CUTOFF (CADDAR COLOR:)) NAME)) ;WILL BE NEEDED TO FULLY DESCRIBE THE OBJECT.
(OR (CDR COLORLIST)
(RETURN (LIST (ANSAY (CONS 'THE NAME))
(LIST ITEM)))) ;THERE ARE NO OTHERS OF THE SAME COLOR. IF THERE
(SETQ NAME (CONS SIZE: NAME)) ;ARE, WE MUST USE SIZE AS WELL
(RETURN
(LIST
(COND
((NULL (CDR SIZELIST))
(ANSAY (CONS 'THE NAME))) ;THE SIZE MANAGES TO FINISH SPECIFYING IT.
((EQ SPEC 'INDEF)
(ANSAY (CONS 'A NAME))) ;IN THE INDEFINITE CASE WE DON'T CARE IF THIS
((SETQ X (THVAL2 NIL ;ISN'T A FULL SPECIFICATION.
'(THFIND ALL
$?X
(X (Y ITEM))
($G (#SUPPORT $?Y $?X)))))
(CONS (APPEND '(SAY THE) NAME)
(CONS '(SAY WHICH SUPPORTS)
(LISTNAMES NIL 'INDEF X)))) ;IF IT SUPPORTS ANYTHING, NAME THEM.
((CONS
(APPEND '(SAY THE) NAME)
(CONS
'(SAY WHICH IS TO THE RIGHT OF)
(COND ((SETQ
X
(THVAL2 NIL
'(THFIND ALL
$?X
(X (Y ITEM))
($G (#AT $?X ?)) ;MAKE SURE IT IS AN ITEM WITH A LOCATION.
($G (#LOC #RIGHT $?Y $?X)
(THUSE TC-LOC)))))
(LISTNAMES NIL 'INDEF X))
('((SAY NOTHING))))))))
(LIST ITEM)))))