xref: /original-bsd/old/lisp/doctor/doctor.l (revision 208c3823)
1 ;
2 ; Copyright (c) 1982 The Regents of the University of California.
3 ; All rights reserved.
4 ;
5 ; Redistribution and use in source and binary forms are permitted
6 ; provided that the above copyright notice and this paragraph are
7 ; duplicated in all such forms and that any documentation,
8 ; advertising materials, and other materials related to such
9 ; distribution and use acknowledge that the software was developed
10 ; by the University of California, Berkeley.  The name of the
11 ; University may not be used to endorse or promote products derived
12 ; from this software without specific prior written permission.
13 ; THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
14 ; IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
15 ; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
16 ;
17 ;	@(#)doctor.l	4.4 (Berkeley) 01/05/90
18 ;
19 (eval-when (eval) (cvttomaclisp))
20 ; these functions are franz only.
21 ; to make doctor:
22 ;   liszt -mr -o doctor doctor.l
23 
24 (declare (special endtime starttime ticks float-format user topipe
25 		  user-top-level))
26 
27 (defun mailbill ()
28   (setq endtime (ptime)
29 	ticks  (difference (car endtime) (car starttime))
30 	user (getenv '|USER|)
31 	float-format "%.2f")
32   (apply 'process (list (concat "//bin//mail " user)
33 		       'topipe
34 		       'frompipe))
35   (msg (|P| topipe) "From the doctor" |N|
36 		  "To: " user |N|
37   		  "Subject: bill for services" |N| |N|
38   		  "Please remit $" (min 50. (quotient (times ticks 10000.0)
39 					     (times 60 60 60)))
40   			" for " (quotient ticks 60.0) " cpu seconds "
41 			|N|
42 			"       thank you, " |N|
43 			"           The doctor."
44 			|N|)
45   (close topipe))
46 
47 (DECLARE (SPECIAL TERMINAL LETTER WORD SENTENCE KEYSTACK TERMINALWIDTH
48 		  CARRIAGERETURN RUBOUT LINEFEED FLAG PARSELIST
49 		  RULES FLIPFLOP S D LINE)
50 	 (SPECIAL READTABLE)
51 	 (EVAL (READ)))
52 
53 (PROG2  (SETSYNTAX #/' 2 )
54 	(SETSYNTAX #/; 2 )
55 	(setsyntax #/" 2)
56 	(setsyntax #/, 2)
57 	(setsyntax #/` 2)
58 	(setsyntax #/# 2)
59 	)
60 
61 
62 
63 
64 
65 
66 (DEFUN GOBBLE-LINES-OF-CHARS NIL
67      (PROG (CH L)
68       C    (SETQ CH (readc))
69            (COND ((AND (EQ CH linefeed)
70 		       (SETQ L (CONS CH L))
71 		       (EQ (SETQ CH (readc)) linefeed))
72 		  (RETURN (NREVERSE (CONS CH L))))
73 		(t(SETQ L (CONS CH L))))
74 	   (GO C) ))
75 
76 
77 (DEFUN WORKER NIL
78  (setq terminalwidth 72)
79 	(PROG (SENTENCE KEYSTACK)
80 	      (TERPRI)
81 	      (PRINC (QUOTE SPEAK/ UP!/ HIT/ 2/ RETURNS/ after/ typing))
82 	      (TERPRI)
83 	  A   (SETQ SENTENCE (SETQ KEYSTACK NIL))
84 	      (READIN)
85 	      (ANALYZE)
86 	      (TERPRI)
87 	      (TERPRI)
88 	      (GO A)) )
89 
90 
91 
92 
93 
94 
95 
96 (DEFUN READIN NIL
97    (PROG (WORD LETTER FLAG TERMINAL LINE)
98          (SETQ LINE (GOBBLE-LINES-OF-CHARS))
99       A  (COND ((NULL (READWORD)) (GO B)))
100          (MAKESENTENCE)
101 	 (SETKEYSTACK)
102       B  (BREAKANALYZE)
103 	 (COND ((NOT FLAG) (GO A)))
104 	 (SETQ SENTENCE (NREVERSE SENTENCE)) ))
105 
106 (DEFUN READWORD NIL
107  (PROG NIL
108        (SETQ WORD NIL)
109   A    (COND ((SETQ FLAG (GET (NEXTCH) (QUOTE BREAK)))
110 	      (RETURN (COND (WORD (SETQ WORD
111 					(IMPLODE (REVERSE WORD))))))))
112        (SETQ WORD (CONS LETTER WORD))
113        (GO A)))
114 
115 (DEFUN MAKESENTENCE NIL
116  (SETQ SENTENCE
117        (CONS (COND ((SETQ FLAG (GET WORD (QUOTE TRANSLATION)))
118 			    FLAG)
119 		   (WORD))
120 	     SENTENCE)))
121 
122 (DEFUN SETKEYSTACK NIL
123  (COND ((AND (SETQ FLAG (GET WORD (QUOTE PRIORITY)))
124 	     KEYSTACK
125 	     (GREATERP FLAG
126 		       (GET (CAR KEYSTACK) (QUOTE PRIORITY))))
127 	(SETQ KEYSTACK (CONS WORD KEYSTACK)))
128        (FLAG (SETQ KEYSTACK (APPEND KEYSTACK (LIST WORD))))))
129 
130 (DEFUN BREAKANALYZE NIL
131  (COND ((EQ LETTER CARRIAGERETURN) (SETQ FLAG TERMINAL)
132 					(SETQ TERMINAL T))
133        ((AND 	(SETQ FLAG (GET LETTER (QUOTE PUNCTUATION)))
134 		KEYSTACK)
135 		(GOBBLE))
136        (FLAG (SETQ SENTENCE (SETQ FLAG NIL)))
137        ((NOT (EQ LETTER LINEFEED))
138 	    (SETQ TERMINAL NIL))))
139 
140 (DEFUN TEST (D S)
141  (PROG NIL
142   G    (COND ((NULL D)
143 	      (RETURN (COND ((NOT S)
144 			     (SETQ PARSELIST
145 				   (REVERSE PARSELIST))))))
146 	     ((NOT (COND ((NUMBERP (CAR D))
147 			  (COND ((ZEROP (CAR D)) (TEST5))
148 				((TEST3 (CAR D) NIL))))
149 			 ((TEST4 (CAR D)) (TEST2))))
150 	      (RETURN NIL)))
151        (SETQ D (CDR D))
152        (GO G)))
153 
154 (DEFUN ADVANCE NIL
155      (RPLACA (CDAR RULES)
156 	     (COND ((NULL (CDADAR RULES)) (CDDAR RULES))
157 		   ((CDADAR RULES)))))
158 
159 (DEFUN SENTPRINT (ANS)
160        (PROG (N)
161 	  A0 (SETQ N 0)
162 	  A  (PRINC (CAR ANS))
163 	     (SETQ N (PLUS N (FLATSIZE (CAR ANS))))
164 	     (COND ((SETQ ANS (CDR ANS))
165 		    (COND ((GREATERP N TERMINALWIDTH)
166 			   (TERPRI)
167 			   (GO A0))
168 			  ((PRINC (QUOTE / ))))
169 		    (GO A)))
170 	     (MEMORY)))
171 
172 (DEFUN RECONSTRUCT (R)
173      (COND ((NULL R) NIL)
174 	   ((NUMBERP (CAR R)) (APPEND (RECO1 (CAR R) PARSELIST)
175 				      (RECONSTRUCT (CDR R))))
176 	   ((CONS (CAR R) (RECONSTRUCT (CDR R))))))
177 
178 (DEFUN GOBBLE NIL
179  (PROG NIL
180       A	   (NEXTCH)
181 	   (BREAKANALYZE)
182 	   (COND ((NOT FLAG) (GO A)))))
183 
184 (DEFUN NEXTCH NIL
185 	(SETQ LETTER (CAR LINE))
186 	(SETQ LINE (CDR LINE))
187 	LETTER)
188 
189 (DEFUN TEST1 (PROPL X)
190    (COND ((NULL PROPL) NIL)
191 	 ((GET X (CAR PROPL)) T)
192 		 ((TEST1 (CDR PROPL) X))))
193 
194 (DEFUN TEST2 NIL
195   (PROG NIL
196    (SETQ PARSELIST (CONS (LIST (CAR S)) PARSELIST))
197    (SETQ S (CDR S))
198    (RETURN T)))
199 
200 (DEFUN TEST3 (X L)
201 	 (COND ((ZEROP X) (SETQ PARSELIST (CONS (REVERSE L) PARSELIST)))
202 	       (S (TEST3 (SUB1 X)
203 			 (CONS (CAR S) (PROG2 (SETQ S (CDR S)) L))))))
204 
205 (DEFUN TEST4 (D)
206      (COND ((NULL S) NIL)
207 	   ((ATOM D) (EQ D (CAR S)))
208 	   ((CAR D) (MEMBER (CAR S) D))
209 	   ((TEST1 (CDR D) (CAR S)))))
210 
211 (DEFUN TEST5 NIL
212  (PROG (L)
213        (COND ((NULL (CDR D)) (SETQ PARSELIST (CONS S PARSELIST))
214 			     (RETURN (NOT (SETQ S NIL)))))
215   A    (COND ((TEST4 (CADR D))
216 	      (RETURN (SETQ PARSELIST
217 			    (CONS (REVERSE L) PARSELIST))))
218 	     ((AND (SETQ L (CONS (CAR S) L)) (SETQ S (CDR S)))
219 	      (GO A)))))
220 
221 (DEFUN RECO1 (X P)
222   (COND ((GREATERP X 1)
223 	 (RECO1 (SUB1 X) (CDR P)))
224 	((CAR P))))
225 
226 (DEFUN ANALYZE NIL
227     (PROG (RULES PARSELIST DECOMP)
228 	(SETQ KEYSTACK
229 	      (APPEND KEYSTACK
230 		      (LIST (GET (QUOTE NONE)
231 				 (COND ((ZEROP (SETQ FLIPFLOP
232 						     (DIFFERENCE 2 FLIPFLOP)))
233 					(QUOTE MEM))
234 				       ((QUOTE LASTRESORT)))))))
235    A	(SETQ RULES (GET (CAR KEYSTACK) (QUOTE RULES)))
236    B	(SETQ DECOMP (CAAR (COND ((ATOM (CAR RULES))
237 				  (SETQ RULES (GET (CAR RULES) (QUOTE RULES))))
238 				 (RULES))))
239 	(SETQ PARSELIST NIL)
240 	(COND ((NOT (TEST DECOMP SENTENCE)) (SETQ RULES (CDR RULES)))
241 	      ((AND (NOT (ATOM (CAR (SETQ RULES (CAR (ADVANCE))))))
242 		    (NOT (EQ (CAAR RULES) (QUOTE PRE))))
243 	       (RETURN (SENTPRINT (RECONSTRUCT (CAR RULES)))))
244 	      ((NOT (ATOM (CAR RULES)))
245 	       (SETQ SENTENCE (RECONSTRUCT (CADAR RULES)))
246 	       (SETQ RULES (CDDAR RULES)))
247 	      ((EQ (CAR RULES) (QUOTE NEWKEY)) (SETQ KEYSTACK (CDR KEYSTACK))
248 					       (GO A)))
249 	(GO B)))
250 
251 
252 (DEFUN MEMORY NIL
253     ((LAMBDA (PARSELIST)
254 	     (AND (SETQ RULES (GET (CAR KEYSTACK) (QUOTE MEMR)))
255 		  (TEST (CAAR RULES) SENTENCE)
256 		  ((LAMBDA (X) (RPLACA X
257 				       (APPEND (CAR X)
258 					       (LIST (RECONSTRUCT (CAAR (ADVANCE)))))))
259 			(CDAR (GET (GET (QUOTE NONE) (QUOTE MEM)) (QUOTE RULES))))))
260 	NIL))
261 
262 
263 (COMMENT DOCTOR SET UP OF SOME INITIAL VALUES AND PROPERTIES)
264 
265 
266 (MAPC 	(QUOTE (LAMBDA (X) (PUTPROP (SET (CAR X) (ASCII (CADR X))) T (QUOTE BREAK))))
267 	(QUOTE ((RUBOUT 127.)
268 		(BLANK 32.)
269 		(CARRIAGERETURN 10.)
270 		(LINEFEED 10.)
271 		(HORIZONTALTAB 9.))))
272 
273 (SETQ FLIPFLOP 0)
274 
275 (MAPC 	(QUOTE (LAMBDA (X)
276 		   (PUTPROP X T (QUOTE BREAK))
277 		   (PUTPROP X T (QUOTE PUNCTUATION))))
278 	(QUOTE (/. /, /( /) ! ? : /;)))
279 
280 
281 (COMMENT  DOCTOR SCRIPT - UPDATED TO /25 NOV /69)
282 
283 (PUTPROP (QUOTE NONE)
284 	 ((LAMBDA (X)
285 		  (PUTPROP X
286 			   (QUOTE (((0)
287 					(NIL)
288 					(I AM NOT SURE I UNDERSTAND YOU FULLY)
289 					(PLEASE GO ON)
290 					(WHAT DOES THAT SUGGEST TO YOU)
291 					(DO YOU FEEL STRONGLY ABOUT DISCUSSING SUCH THINGS))))
292 			   (QUOTE RULES))
293 		   X)
294 	   (GENSYM))
295 	 (QUOTE LASTRESORT))
296 
297 (PUTPROP (QUOTE NONE)
298 	 ((LAMBDA (X)
299 		  (PUTPROP X
300 			   (LIST  (LIST (LIST 0)
301 					(LIST NIL)
302 					(GET (QUOTE NONE)
303 					     (QUOTE LASTRESORT))))
304 			   (QUOTE RULES))
305 		  X)
306 	      (GENSYM))
307 	 (QUOTE MEM))
308 
309 
310 
311 (DEFPROP SORRY 0 PRIORITY)
312 
313 (DEFPROP SORRY
314 	 (((0) (NIL)
315 	       (PLEASE DON/'T APOLOGIZE)
316 	       (APOLOGIES ARE NOT NECESSARY)
317 	       (WHAT FEELINGS DO YOU HAVE WHEN YOU APOLOGIZE)
318 	       (I/'VE TOLD YOU THAT APOLOGIES ARE NOT REQUIRED)
319 	       (APOLOGIES ARE NOT NECESSARY/, PLEASE GO ON)))
320 	 RULES)
321 
322 (DEFPROP DONT DON/'T TRANSLATION)
323 
324 (DEFPROP CANT CAN/'T TRANSLATION)
325 
326 (DEFPROP WONT WON/'T TRANSLATION)
327 
328 (DEFPROP REMEMBER 5 PRIORITY)
329 
330 (DEFPROP REMEMBER
331 	 (((0 YOU REMEMBER 0) (NIL)
332 			      (DO YOU OFTEN THINK OF 4)
333 			      (DOES THINKING OF 4 BRING ANYTHING ELSE TO MIND)
334 			      (WHAT ELSE DO YOU REMEMBER)
335 			      (WHY DO YOU REMEMBER 4 JUST NOW)
336 			      (WHAT IN THE PRESENT SITUATION REMINDS YOU OF 4)
337 			      (WHAT IS THE CONNECTION BETWEEN ME AND 4))
338 	  ((0 DO I REMEMBER 0) (NIL)
339 			       (DID YOU THINK I WOULD FORGET 5)
340 			       (WHY DO YOU THINK I SHOULD RECALL 5 NOW)
341 			       (WHAT ABOUT 5)
342 			       WHAT
343 			       (YOU MENTIONED 5))
344 	  ((0) (NIL) NEWKEY))
345 	 RULES)
346 
347 (DEFPROP IF 3 PRIORITY)
348 
349 (DEFPROP IF
350 	 (((0 IF 0 HAD 0) (NIL) (PRE (1 2 3 MIGHT HAVE 5) IF))
351 	  ((0 IF 0) (NIL)
352 		    (DO YOU THINK ITS LIKELY THAT 3)
353 		    (DO YOU WISH THAT 3)
354 		    (WHAT DO YOU THINK ABOUT 3)
355 		    (REALLY IF 3)))
356 	 RULES)
357 
358 (DEFPROP DREAMT 4 PRIORITY)
359 
360 (DEFPROP DREAMT
361 	 (((0 YOU DREAMT 0) (NIL)
362 			    (REALLY 4)
363 			    (HAVE YOU EVER FANTASIED 4 WHILE YOU WERE AWAKE)
364 			    (HAVE YOU DREAMT 4 BEFORE)
365 			    DREAM
366 			    NEWKEY)
367 	 ((0) (NIL) DREAM NEWKEY))
368 	 RULES)
369 
370 (DEFPROP DREAMED DREAMT TRANSLATION)
371 
372 (DEFPROP DREAMED 4 PRIORITY)
373 
374 (DEFPROP DREAMED (DREAMT) RULES)
375 
376 (DEFPROP DREAM 3 PRIORITY)
377 
378 (DEFPROP DREAM
379 	 (((0)
380 	   (NIL)
381 	   (WHAT DOES THAT DREAM SUGGEST TO YOU)
382 	   (DO YOU DREAM OFTEN)
383 	   (WHAT PERSONS APPEAR IN YOUR DREAMS)
384 	   (DON/'T YOU BELIEVE THAT DREAM HAS SOMETHING TO DO WITH YOUR PROBLEM)
385 	   (DO YOU EVER WISH YOU COULD FLEE FROM REALITY)
386 	   NEWKEY))
387 	 RULES)
388 
389 (DEFPROP DREAMS DREAM TRANSLATION)
390 
391 (DEFPROP DREAMS 3 PRIORITY)
392 
393 (DEFPROP DREAMS (DREAM) RULES)
394 
395 (DEFPROP WHAT 0 PRIORITY)
396 
397 (DEFPROP WHAT
398 	(((WHAT WHERE)
399 	  (NIL)
400 	  HOW)
401 	 ((0 (WHAT WHERE) 0)
402 	  (NIL)
403 	  (TELL ME ABOUT 2 3)
404 	  (2 3)
405 	  (DO YOU WANT ME TO TELL YOU 2 3)
406 	  (REALLY)
407 	  (I SEE)
408 	  NEWKEY))
409 	RULES)
410 
411 (DEFPROP ALIKE 10. PRIORITY)
412 
413 (DEFPROP ALIKE (DIT) RULES)
414 
415 (DEFPROP SAME 10. PRIORITY)
416 
417 (DEFPROP SAME (DIT) RULES)
418 
419 (DEFPROP CERTAINLY 0 PRIORITY)
420 
421 (DEFPROP CERTAINLY (YES) RULES)
422 
423 (DEFPROP FEEL T BELIEF)
424 
425 (DEFPROP THINK T BELIEF)
426 
427 (DEFPROP BELIEVE T BELIEF)
428 
429 (DEFPROP WISH T BELIEF)
430 
431 (DEFPROP BET T BELIEF)
432 
433 (DEFPROP MY
434 	 (((0 YOUR 1 0)
435 	   (NIL)
436 	   (EARLIER YOU SAID YOUR 3 4)
437 	   (BUT YOUR 3 4)
438 	   (DOES THAT HAVE ANYTHING TO DO WITH YOUR STATEMENT ABOUT 3 4)))
439 	 MEMR)
440 
441 
442 
443 (DEFPROP PERHAPS 0 PRIORITY)
444 
445 (DEFPROP PERHAPS
446 	 (((0) (NIL)
447 	       (YOU DON/'T SEEM QUITE CERTAIN)
448 	       (WHY THE UNCERTAIN TONE)
449 	       (CAN/'T YOU BE MORE POSITIVE)
450 	       (YOU AREN/'T SURE)
451 	       (DON/'T YOU KNOW)))
452 	 RULES)
453 
454 (DEFPROP MAYBE 0 PRIORITY)
455 
456 (DEFPROP MAYBE (PERHAPS) RULES)
457 
458 (DEFPROP NAME 15. PRIORITY)
459 
460 (DEFPROP NAME
461 	 (((0)
462 	   (NIL)
463 	   (I AM NOT INTERESTED IN NAMES)
464 	   (I/'VE TOLD YOU BEFORE I DON/'T CARE ABOUT NAMES /- PLEASE CONTINUE)))
465 	 RULES)
466 
467 (DEFPROP DEUTSCH 0 PRIORITY)
468 
469 (DEFPROP DEUTSCH (((0) (NIL) (I AM SORRY/, I SPEAK ONLY ENGLISH))) RULES)
470 
471 (DEFPROP FRANCAIS 0 PRIORITY)
472 
473 (DEFPROP FRANCAIS (DEUTSCH) RULES)
474 
475 (DEFPROP SVENSKA 0 PRIORITY)
476 
477 (DEFPROP SVENSKA (DEUTSCH) RULES)
478 
479 (DEFPROP ITALIANO 0 PRIORITY)
480 
481 (DEFPROP ITALIANO (DEUTSCH) RULES)
482 
483 (DEFPROP ESPANOL 0 PRIORITY)
484 
485 (DEFPROP ESPANOL (DEUTSCH) RULES)
486 
487 (DEFPROP HELLO 0 PRIORITY)
488 
489 (DEFPROP HELLO (((0) (NIL) (HOW DO YOU DO/. PLEASE STATE YOUR PROBLEM))) RULES)
490 
491 (DEFPROP COMPUTER 50. PRIORITY)
492 
493 (DEFPROP COMPUTER
494 	 (((0) (NIL)
495 	       (DO COMPUTERS WORRY YOU)
496 	       (WHY DO YOU MENTION COMPUTERS)
497 	       (WHAT DO YOU THINK MACHINES HAVE TO DO WITH YOUR PROBLEM)
498 	       (DON/'T YOU THINK COMPUTERS CAN HELP PEOPLE)
499 	       (WHAT ABOUT MACHINES WORRIES YOU)
500 	       (WHAT DO YOU THINK ABOUT MACHINES)))
501 	 RULES)
502 
503 (DEFPROP MACHINE 50. PRIORITY)
504 
505 (DEFPROP MACHINE (COMPUTER) RULES)
506 
507 (DEFPROP MACHINES 50. PRIORITY)
508 
509 (DEFPROP MACHINES (COMPUTER) RULES)
510 
511 (DEFPROP COMPUTERS 50. PRIORITY)
512 
513 (DEFPROP COMPUTERS (COMPUTER) RULES)
514 
515 (DEFPROP AM 0 PRIORITY)
516 
517 (DEFPROP AM ARE TRANSLATION)
518 
519 (DEFPROP AM
520 	 (((0 ARE YOU 0) (NIL)
521 			 (DO YOU BELIEVE YOU ARE 4)
522 			 (WOULD YOU WANT TO BE 4)
523 			 (YOU WISH I WOULD TELL YOU YOU ARE 4)
524 			 (WHAT WOULD IT MEAN IF YOU WERE 4)
525 			 HOW)
526 	  ((0) (NIL) (WHY DO YOU SAY /'AM/') (I DON/'T UNDERSTAND THAT)))
527 	 RULES)
528 
529 (DEFPROP ARE 0 PRIORITY)
530 
531 (DEFPROP ARE
532 	 (((0 THERE ARE 0 YOU 0) (NIL) (PRE (1 2 3 4) ARE))
533 	  ((0 THERE ARE 1 0) (NIL)
534 			     (WHAT MAKES YOU THINK 2 3 4 5)
535 			     (DO YOU USUALLY CONSIDER 4 5)
536 			     (DO YOU WISH 2 WERE 4 5))
537 	  ((0 THERE ARE 0) (NIL) NEWKEY)
538 	  ((0 ARE I 0) (NIL)
539 		       (WHY ARE YOU INTERESTED IN WHETHER I AM 4 OR NOT)
540 		       (WOULD YOU PREFER IF I WEREN/'T 4)
541 		       (PERHAPS I AM 4 IN YOUR FANTASIES)
542 		       (DO YOU SOMETIMES THINK I AM 4)
543 		       HOW)
544 	  ((ARE 0) (NIL) HOW)
545 	  ((0 ARE 0) (NIL)
546 		     (DID YOU THINK THEY MIGHT NOT BE 3)
547 		     (WOULD YOU LIKE IT IF THEY WERE NOT 3)
548 		     (WHAT IF THEY WERE NOT 3)
549 		     (POSSIBLY THEY ARE 3)))
550 	 RULES)
551 
552 (DEFPROP YOUR 0 PRIORITY)
553 
554 (DEFPROP YOUR MY TRANSLATION)
555 
556 (DEFPROP YOUR
557 	 (((0 MY 0) (NIL)
558 		    (WHY ARE YOU CONCERNED OVER MY 3)
559 		    (WHAT ABOUT YOUR OWN 3)
560 		    (ARE YOU WORRIED ABOUT SOMEONE ELSES 3)
561 		    (REALLY/, MY 3)))
562 	 RULES)
563 
564 (DEFPROP WAS 2 PRIORITY)
565 
566 (DEFPROP WAS
567 	 (((0 WAS YOU 0) (NIL)
568 			 (WHAT IF YOU WERE 4)
569 			 (DO YOU THINK YOU WERE 4)
570 			 (WERE YOU 4)
571 			 (WHAT WOULD IT MEAN IF YOU WERE 4)
572 			 (WHAT DOES /' 4 /' SUGGEST TO YOU)
573 			 HOW)
574 	  ((0 YOU WAS 0) (NIL)
575 			 (WERE YOU REALLY)
576 			 (WHY DO YOU TELL ME YOU WERE 4 NOW)
577 			 (PERHAPS I ALREADY KNEW YOU WERE 4))
578 	  ((0 WAS I 0) (NIL)
579 		       (WOULD YOU LIKE TO BELIEVE I WAS 4)
580 		       (WHAT SUGGESTS THAT I WAS 4)
581 		       (WHAT DO YOU THINK)
582 		       (PERHAPS I WAS 4)
583 		       (WHAT IF I HAD BEEN 4))
584 	  ((0) (NIL) NEWKEY))
585 	 RULES)
586 
587 (DEFPROP WERE 0 PRIORITY)
588 
589 (DEFPROP WERE WAS TRANSLATION)
590 
591 (DEFPROP WERE (WAS) RULES)
592 
593 (DEFPROP ME YOU TRANSLATION)
594 
595 (DEFPROP YOU/'RE 0 PRIORITY)
596 
597 (DEFPROP YOU/'RE I/'M TRANSLATION)
598 
599 (DEFPROP YOU/'RE (((0 I/'M 0) (NIL) (PRE (I ARE 3) YOU))) RULES)
600 
601 (DEFPROP I/'M 0 PRIORITY)
602 
603 (DEFPROP I/'M YOU/'RE TRANSLATION)
604 
605 (DEFPROP I/'M (((0 YOU/'RE 0) (NIL) (PRE (YOU ARE 3) I))) RULES)
606 
607 (DEFPROP MYSELF YOURSELF TRANSLATION)
608 
609 (DEFPROP YOURSELF MYSELF TRANSLATION)
610 
611 (DEFPROP MOTHER T FAMILY)
612 
613 (DEFPROP MOM MOTHER TRANSLATION)
614 
615 (DEFPROP MOM T FAMILY)
616 
617 (DEFPROP MOMMY MOTHER TRANSLATION)
618 
619 (DEFPROP MOMMY T FAMILY)
620 
621 (DEFPROP DAD FATHER TRANSLATION)
622 
623 (DEFPROP DAD T FAMILY)
624 
625 (DEFPROP FATHER T FAMILY)
626 
627 (DEFPROP DADDY FATHER TRANSLATION)
628 
629 (DEFPROP DADDY T FAMILY)
630 
631 (DEFPROP SISTER T FAMILY)
632 
633 (DEFPROP BROTHER T FAMILY)
634 
635 (DEFPROP WIFE T FAMILY)
636 
637 (DEFPROP CHILDREN T FAMILY)
638 
639 (DEFPROP I 0 PRIORITY)
640 
641 (DEFPROP I YOU TRANSLATION)
642 
643 (DEFPROP I
644 	 (((0 YOU (WANT NEED) 0)
645 	   (NIL)
646 	   (WHAT WOULD IT MEAN TO YOU IF YOU GOT 4)
647 	   (WHY DO YOU WANT 4)
648 	   (SUPPOSE YOU GOT 4 SOON)
649 	   (WHAT IF YOU NEVER GOT 4)
650 	   (WHAT WOULD GETTING 4 MEAN TO YOU)
651 	   (WHAT DOES WANTING 4 HAVE TO DO WITH THIS DISCUSSION)
652 	   (YOU REALLY WANT 4)
653 	   (I SUSPECT YOU REALLY DON/'T WANT 4))
654 	  ((0 YOU ARE 0 (SAD UNHAPPY DEPRESSED SICK) 0)
655 	   (NIL)
656 	   (I AM SORRY TO HEAR YOU ARE 5)
657 	   (DO YOU THINK COMING HERE WILL HELP YOU NOT TO BE 5)
658 	   (I/'M SURE ITS NOT PLEASANT TO BE 5)
659 	   (CAN YOU EXPLAIN WHAT MADE YOU 5)
660 	   (PLEASE GO ON))
661 	  ((0 YOU ARE 0 (HAPPY ELATED GLAD BETTER) 0)
662 	   (NIL)
663 	   (HOW HAVE I HELPED YOU TO BE 5)
664 	   (HAS YOUR TREATMENT MADE YOU 5)
665 	   (WHAT MAKES YOU 5 JUST NOW)
666 	   (CAN YOU EXPLAIN WHY YOU ARE SUDDENLY 5)
667 	   (ARE YOU SURE)
668 	   (WHAT DO YOU MEAN BY 5))
669 	  ((0 YOU WAS 0) (NIL) WAS)
670 	  ((0 YOU (NIL BELIEF) YOU 0) (NIL)
671 				      (DO YOU REALLY THINK SO)
672 				      (BUT YOU ARE NOT SURE YOU 5)
673 				      (DO YOU REALLY DOUBT YOU 5))
674 	  ((0 YOU 0 (NIL BELIEF) 0 I 0) (NIL) YOU)
675 	  ((0 YOU ARE 0) (NIL)
676 			 (IS IT BECAUSE YOU ARE 4 THAT YOU CAME TO ME)
677 			 (HOW LONG HAVE YOU BEEN 4)
678 			 (DO YOU BELIEVE IT NORMAL TO BE 4)
679 			 (DO YOU ENJOY BEING 4))
680 	  ((0 YOU (CAN/'T CANNOT) 0) (NIL)
681 				    (HOW DO YOU KNOW YOU CAN/'T 4)
682 				    (HAVE YOU TRIED)
683 				    (PERHAPS YOU COULD 4 NOW)
684 				    (DO YOU REALLY WANT TO BE ABLE TO 4))
685 	  ((0 YOU DON/'T 0) (NIL)
686 			   (DON/'T YOU REALLY 4)
687 			   (WHY DON/'T YOU 4)
688 			   (DO YOU WISH TO BE ABLE TO 4)
689 			   (DOES THAT TROUBLE YOU))
690 	  ((0 YOU FEEL 0) (NIL)
691 			  (TELL ME MORE ABOUT SUCH FEELINGS)
692 			  (DO YOU OFTEN FEEL 4)
693 			  (DO YOU ENJOY FEELING 4)
694 			  (OF WHAT DOES FEELING 4 REMIND YOU))
695 	  ((0 YOU 0 I 0) (NIL)
696 			 (PERHAPS IN YOUR FANTASY WE 3 EACH OTHER)
697 			 (DO YOU WISH TO 3 ME)
698 			 (YOU SEEM TO NEED TO 3 ME)
699 			 (DO YOU 3 ANYONE ELSE))
700 	  ((0) (NIL)
701 	       (YOU SAY 1)
702 	       (CAN YOU ELABORATE ON THAT)
703 	       (DO YOU SAY 1 FOR SOME SPECIAL REASON)
704 	       (THAT/'S QUITE INTERESTING)))
705 	 RULES)
706 
707 (DEFPROP YOU 0 PRIORITY)
708 
709 (DEFPROP YOU I TRANSLATION)
710 
711 (DEFPROP YOU
712 	 (((0 I REMIND YOU OF 0) (NIL) DIT)
713 	  ((0 I ARE 0 YOU 0) (NIL) NEWKEY)
714 	  ((0 I 0 ARE 0) (NIL)
715 			 (WHAT MAKES YOU THINK I AM 5)
716 			 (DOES IT PLEASE YOU TO BELIEVE I AM 5)
717 			 (PERHAPS YOU WOULD LIKE TO BE 5)
718 			 (DO YOU SOMETIMES WISH YOU WERE 5))
719 	  ((0 I 0 YOU) (NIL)
720 		       (WHY DO YOU THINK I 3 YOU)
721 		       (YOU LIKE TO THINK I 3 YOU /- DON/'T YOU)
722 		       (WHAT MAKES YOU THINK I 3 YOU)
723 		       (REALLY/, I 3 YOU)
724 		       (DO YOU WISH TO BELIEVE I 3 YOU)
725 		       (SUPPOSE I DID 3 YOU /- WHAT WOULD THAT MEAN)
726 		       (DOES SOMEONE ELSE BELIEVE I 3 YOU))
727 	  ((0 I 1 0) (NIL)
728 		     (WE WERE DISCUSSING YOU /- NOT ME)
729 		     (OH/, I 3 4)
730 		     (IS THIS REALLY RELEVANT TO YOUR PROBLEM)
731 		     (PERHAPS I DO 3 4)
732 		     (ARE YOU GLAD TO KNOW I 3 4)
733 		     (DO YOU 3 4)
734 		     (WHAT ARE YOUR FEELINGS NOW))
735 	  ((0) (NIL) NEWKEY))
736 	 RULES)
737 
738 (DEFPROP WE YOU TRANSLATION)
739 
740 (DEFPROP WE 0 PRIORITY)
741 
742 (DEFPROP WE (I) RULES)
743 
744 (DEFPROP XXYYZZ 0 PRIORITY)
745 
746 (DEFPROP XXYYZZ
747 	 (((0) (NIL)
748 	       (YOURE BEING SOMEWHAT SHORT WITH ME)
749 	       (YOU DONT SEEM VERY TALKATIVE TODAY)
750 	       (PERHAPS YOUD RATHER TALK ABOUT SOMETHING ELSE)
751 	       (ARE YOU USING MONOSYLLABLES FOR SOME REASON)
752 	       NEWKEY))
753 	 RULES)
754 
755 (DEFPROP YES 0 PRIORITY)
756 
757 (DEFPROP YES
758 	 (((YES) (NIL) XXYYZZ (PRE (X YES) YES)) ((0) (NIL)
759 						      (YOU SEEM QUITE POSITIVE)
760 						      (YOU ARE SURE)
761 						      (I SEE)
762 						      (I UNDERSTAND)
763 						      NEWKEY))
764 	 RULES)
765 
766 (DEFPROP NO 0 PRIORITY)
767 
768 (DEFPROP NO
769 	 (((NO) (NIL) XXYYZZ (PRE (X NO) NO))
770 	  ((0) (NIL)
771 	       (ARE YOU SAYING /'NO/' JUST TO BE NEGATIVE)
772 	       (YOU ARE BEING A BIT NEGATIVE)
773 	       (WHY NOT)
774 	       (WHY /'NO/')
775 	       NEWKEY))
776 	 RULES)
777 
778 (DEFPROP MY 2 PRIORITY)
779 
780 (DEFPROP MY YOUR TRANSLATION)
781 
782 (DEFPROP MY
783 	 (((0 YOUR 0 (NIL FAMILY) 0)
784 	   (NIL)
785 	   (TELL ME MORE ABOUT YOUR FAMILY)
786 	   (WHO ELSE IN YOUR FAMILY 5)
787 	   (YOUR 4)
788 	   (WHAT ELSE COMES TO MIND WHEN YOU THINK OF YOUR 4))
789 	  ((0 YOUR 1 0) (NIL)
790 			(YOUR 3 4)
791 			(WHY DO YOU SAY YOUR 3 4)
792 			(DOES THAT SUGGEST ANYTHING ELSE WHICH BELONGS TO YOU)
793 			(IS IT IMPORTANT TO YOU THAT YOUR 3 4))
794 	  ((0) (NIL) NEWKEY))
795 	 RULES)
796 
797 (DEFPROP CAN 0 PRIORITY)
798 
799 (DEFPROP CAN
800 	 (((0 CAN I 0) (NIL)
801 		       (YOU BELIEVE I CAN 4 DON/'T YOU)
802 			HOW
803 		       (YOU WANT ME TO BE ABLE TO 4)
804 		       (PERHAPS YOU WOULD LIKE TO BE ABLE TO 4 YOURSELF))
805 	  ((0 CAN YOU 0)
806 	   (NIL)
807 	   (WHETHER OR NOT YOU CAN 4 DEPENDS ON YOU MORE THAN ON ME)
808 	   (DO YOU WANT TO BE ABLE TO 4)
809 	   (PERHAPS YOU DON/'T WANT TO 4)
810 	   HOW)
811 	 ((0) (NIL) HOW NEWKEY))
812 	 RULES)
813 
814 (DEFPROP IS 0 PRIORITY)
815 
816 (DEFPROP IS
817 	 (((1 0 IS 1 0) (NIL)
818 			(SUPPOSE 1 2 WERE NOT 4 5)
819 			(PERHAPS 1 2 REALLY IS 4 5)
820 			(TELL ME MORE ABOUT 1 2))
821 	  ((0) (NIL) NEWKEY))
822 	 RULES)
823 
824 (DEFPROP WHERE 0 PRIORITY)
825 
826 (DEFPROP WHERE (HOW) RULES)
827 
828 (DEFPROP HOW 0 PRIORITY)
829 
830 (DEFPROP HOW
831 	 (((0) (NIL)
832 	       (WHY DO YOU ASK)
833 	       (DOES THAT QUESTION INTEREST YOU)
834 	       (WHAT IS IT YOU REALLY WANT TO KNOW)
835 	       (ARE SUCH QUESTIONS MUCH ON YOUR MIND)
836 	       (WHAT ANSWER WOULD PLEASE YOU MOST)
837 	       (WHAT DO YOU THINK)
838 	       (WHAT COMES TO YOUR MIND WHEN YOU ASK THAT)
839 	       (HAVE YOU ASKED SUCH QUESTIONS BEFORE)
840 	       (HAVE YOU ASKED ANYONE ELSE)))
841 	 RULES)
842 
843 (DEFPROP BECAUSE 0 PRIORITY)
844 
845 (DEFPROP BECAUSE
846 	 (((0) (NIL)
847 	       (IS THAT THE REAL REASON)
848 	       (DON/'T ANY OTHER REASONS COME TO MIND)
849 	       (DOES THAT REASON SEEM TO EXPLAIN ANYTHING ELSE)
850 	       (WHAT OTHER REASONS MIGHT THERE BE)
851 	       (YOU/'RE NOT CONCEALING ANYTHING FROM ME/, ARE YOU)))
852 	 RULES)
853 
854 (DEFPROP WHY 0 PRIORITY)
855 
856 (DEFPROP WHY
857 	 (((0 WHY DON/'T I 0) (NIL)
858 			     (DO YOU BELIEVE I DON/'T 5)
859 			     (PERHAPS I WILL 5 IN GOOD TIME)
860 			     (SHOULD YOU 5 YOURSELF)
861 			     (YOU WANT ME TO 5)
862 			     HOW)
863 	  ((0 WHY CAN/'T YOU 0) (NIL)
864 			       (DO YOU THINK YOU SHOULD BE ABLE TO 5)
865 			       (DO YOU WANT TO BE ABLE TO 5)
866 			       (DO YOU BELIEVE THIS WILL HELP YOU TO 5)
867 			       (HAVE YOU ANY IDEA WHY YOU CAN/'T 5)
868 			       HOW)
869 	 ((0) (NIL) (WHY INDEED) (WHY /'WHY/') (WHY NOT) HOW NEWKEY))
870 	 RULES)
871 
872 (DEFPROP EVERYONE 2 PRIORITY)
873 
874 (DEFPROP EVERYONE
875 	 (((0 (EVERYONE EVERYBODY NOBODY NOONE) 0)
876 	   (NIL)
877 	   (REALLY/, 2)
878 	   (SURELY NOT 2)
879 	   (CAN YOU THINK OF ANYONE IN PARTICULAR)
880 	   (WHO/, FOR EXAMPLE)
881 	   (YOU ARE THINKING OF A VERY SPECIAL PERSON)
882 	   (WHO/, MAY I ASK)
883 	   (SOMEONE SPECIAL PERHAPS)
884 	   (YOU HAVE A PARTICULAR PERSON IN MIND/, DON/'T YOU)
885 	   (WHO DO YOU THINK YOU/'RE TALKING ABOUT)
886 	   (I SUSPECT YOU/'RE EXAGGERATING A LITTLE)))
887 	 RULES)
888 
889 (DEFPROP EVERYBODY 2 PRIORITY)
890 
891 (DEFPROP EVERYBODY (EVERYONE) RULES)
892 
893 (DEFPROP NOBODY 2 PRIORITY)
894 
895 (DEFPROP NOBODY (EVERYONE) RULES)
896 
897 (DEFPROP NOONE 2 PRIORITY)
898 
899 (DEFPROP NOONE (EVERYONE) RULES)
900 
901 (DEFPROP ALWAYS 1 PRIORITY)
902 
903 (DEFPROP ALWAYS
904 	 (((0) (NIL)
905 	       (CAN YOU THINK OF A SPECIFIC EXAMPLE)
906 	       (WHEN)
907 	       (WHAT INCIDENT ARE YOU THINKING OF)
908 	       (REALLY/, ALWAYS)
909 	       (WHAT IF THIS NEVER HAPPENED)))
910 	 RULES)
911 
912 (DEFPROP LIKE 10. PRIORITY)
913 
914 (DEFPROP LIKE
915 	 (((0 (AM IS ARE WAS) 0 LIKE 0) (NIL) DIT) ((0) (NIL) NEWKEY))
916 	 RULES)
917 
918 (DEFPROP DIT
919 	 (((0) (NIL)
920 	       (IN WHAT WAY)
921 	       (WHAT RESEMBLANCE DO YOU SEE)
922 	       (WHAT DOES THAT SIMILARITY SUGGEST TO YOU)
923 	       (WHAT OTHER CONNECTIONS DO YOU SEE)
924 	       (WHAT DO YOU SUPPOSE THAT RESEMBLANCE MEANS)
925 	       (WHAT IS THE CONNECTION/, DO YOU SUPPOSE)
926 	       (COULD THERE REALLY BE SOME CONNECTION)
927 	       (HOW)))
928 	 RULES)
929 
930 (DEFPROP BAG 5 PRIORITY)
931 
932 (DEFPROP BAG
933 	 (((0 (BITE BITES) THE BAG) (NIL)
934 				    (DO YOU SAY 1 2 3 4 FOR SOME SPECIAL REASON)
935 				    (WHAT MIGHT 1 HAVE TO DO WITH YOUR PROBLEM)
936 				    (DO YOU OFTEN SAY /' 2 3 4 /')
937 				    (PERHAPS YOU FEEL THAT YOU BITE 3 4))
938 	 ((0) (^IL) (WHY THE INTEREST IN BAGS) (PLEASE BE MORE SPECIFIC)
939 (YOU AREN/'T PULLING MY LEG ARE YOU) NEWKEY))
940 	 RULES)
941 
942 (DEFPROP ZZYYXX (((0) (NIL) NEWKEY)) RULES)
943 
944 (DEFPROP FUCK 55. PRIORITY)
945 
946 (DEFPROP FUCK
947 	 (((0) (NIL)
948 	       (ARE SUCH OBSCENITIES FREQUENTLY ON YOUR MIND)
949 	       (YOU ARE BEING A BIT CHILDISH)
950 	       (REALLY NOW)
951 	       (DEAR ME)
952 	       (I REALLY SHOULDN/'T TOLERATE SUCH LANGUAGE)
953 	       NEWKEY))
954 	 RULES)
955 
956 (DEFPROP SHIT 55. PRIORITY)
957 
958 (DEFPROP SHIT (FUCK) RULES)
959 
960 (DEFPROP CUNT 55. PRIORITY)
961 
962 (DEFPROP CUNT (FUCK) RULES)
963 
964 (DEFPROP PISS 55. PRIORITY)
965 
966 (DEFPROP PISS (FUCK) RULES)
967 
968 (DEFPROP BARF 0 PRIORITY)
969 
970 (DEFPROP BARF (FUCK) RULES)
971 
972 (DEFPROP DAMN 0 PRIORITY)
973 
974 (DEFPROP DAMN (FUCK) RULES)
975 
976 (DEFPROP HELL 0 PRIORITY)
977 
978 (DEFPROP HELL (FUCK) RULES)
979 
980 (DEFPROP SUCK 5 PRIORITY)
981 
982 (DEFPROP SUCK (FUCK) RULES)
983 
984 (DEFPROP SUCKS SUCK TRANSLATION)
985 
986 (DEFPROP PROBLEM 5 PRIORITY)
987 
988 (DEFPROP PROBLEM
989 	 (((0 (IS ARE) YOUR (PROBLEM PROBLEMS) 0) (NIL)
990 						  (1 2 YOUR 4)
991 						  (ARE YOU SURE 1 2 YOUR 4)
992 						  (PERHAPS 1 2 NOT YOUR REAL 4)
993 						  (YOU THINK YOU HAVE PROBLEMS)
994 						  (DO YOU OFTEN THINK ABOUT 1))
995 	  ((0 YOUR (PROBLEM PROBLEMS) (IS ARE) 0) (NIL)
996 						  (YOUR 2 3 4)
997 						  (ARE YOU SURE YOUR2 3 4)
998 						  (PERHAPS YOUR REAL 2 3 NOT 4)
999 						  (YOU THINK YOU HAVE PROBLEMS))
1000 	  ((0) (NIL)
1001 	       (PLEASE CONTINUE/, THIS MAY BE INTERESTING)
1002 	       (HAVE YOU ANY OTHER PROBLEMS YOU WISH TO DISCUSS)
1003 	       (PERHAPS YOU/'D RATHER CHANGE THE SUBJECT)
1004 	       (YOU SEEM A BIT UNEASY)
1005 	       NEWKEY))
1006 	 RULES)
1007 
1008 (DEFPROP PROBLEMS 5 PRIORITY)
1009 
1010 (DEFPROP PROBLEMS (PROBLEM) RULES)
1011 
1012 (DEFPROP PROBLEM
1013 	 (((0 IS YOUR PROBLEM 0)
1014 	   (NIL)
1015 	   (EARLIER YOU MENTIONED 1)
1016 	   (LET/'S TALK FURTHER ABOUT 1)
1017 	   (TELL ME MORE ABOUT 1)
1018 	   (YOU HAVEN/'T MENTIONED 1 FOR A WHILE)))
1019 	 MEMR)
1020 
1021 (DEFPROP PROBLEMS
1022 	(((0 ARE YOU PROBLEMS)
1023 	(NIL)
1024 	(EARLIER YOU MENTIONED 1)
1025 	(LET/'S TALK ABOUT 1)
1026 	(TELL ME MORE ABOUT 1)
1027 	(YOU HAVEN/'T MENTIONED 1 FOR A WHILE)))
1028 	MEMR)
1029 
1030 (DEFPROP CRAP 6 PRIORITY)
1031 
1032 (DEFPROP CRAP (FUCK) RULES)
1033 
1034 (DEFPROP ASK 0 PRIORITY)
1035 
1036 (DEFPROP ASK
1037 	(((0 YOU ASK 0)
1038 	  (NIL)
1039 	  HOW)
1040 	 ((0 YOU 1 ASKING 0)
1041 	  (NIL)
1042 	  HOW)
1043 	 ((0 I 0)
1044 	  (NIL)
1045 	  YOU)
1046 	 ((0)
1047 	  (NIL)
1048 	  NEWKEY))
1049 	RULES)
1050 
1051 
1052 
1053 (defun top-level () (setq user-top-level nil starttime (ptime)) (worker))
1054 (setq user-top-level (quote top-level))
1055 
1056 (signal 2 (quote byebye))
1057 
1058 (defun byebye (x)
1059   (terpri)(terpri)
1060   (princ (quote your/ bill/ will/ be/ in/ the/ mail ))
1061   (terpri)
1062   (mailbill)
1063   (exit))
1064