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