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