PUTPROP(ANIMAL PROGRAMS (PLAY EXPLORE GROW-IN-INTELLIGENCE GET-NEW-PREDICATE 
PRINT-SENTENCE GET-STATEMENT ASK GET-NON-WISECRACK SAVE-GAME PRINC A-AN-HACK))

DEFINE((
(PLAY (LAMBDA NIL
      (PROG NIL
	   (PRINC (QUOTE (LET'S PLAY A GAME%. THINK OF SOME ANIMAL%.)))
	   (TERPRI)
	   (PRINC (QUOTE (I'LL TRY TO GUESS IT BY ASKING YOU QUESTIONS,)))
	   (TERPRI)
	   (PRINC 
	    (QUOTE (AND YOU GIVE ME YES-OR-NO ANSWERS, OK? LET'S GO%.)))
	   (TERPRI)
	   LOOP
	   (EXPLORE TOPTREE NIL)
	   (AND (ASK (QUOTE (THAT WAS FUN%. WANT TO TRY AGAIN))) (GO LOOP))
	   (AND (ASK (QUOTE (DO YOU WANT TO SAVE WHAT I LEARNED))) 
		(SAVE-GAME)))))

(EXPLORE (LAMBDA (NODE WHAT-TO-RPLACA)
      (COND ((ATOM NODE) (COND
		   ((ASK (LIST (QUOTE (IS IT)) (A-AN-HACK NODE))) (
PRINT-SENTENCE (QUOTE (HEY HEY, I SURE AM CLEVER, HUH)) (QUOTE ?)))
		   (T (GROW-IN-INTELLIGENCE NODE WHAT-TO-RPLACA))))
	    (T (COND
		   ((ASK (CAR NODE)) (EXPLORE (CADR NODE) (CDR NODE)))
		   (T (EXPLORE (CADDR NODE) (CDDR NODE))))))))

(GROW-IN-INTELLIGENCE (LAMBDA (LOSER HOWD-WE-GET-HERE)
      (PRINT-SENTENCE (QUOTE (WELL, I'M NOT TOO SHARP TODAY%. I GIVE UP%.%
JUST WHAT KIND OF BEAST DID YOU HAVE IN MIND)) (QUOTE ?))
      ((LAMBDA (NEW-BEAST)
	    (PRINT-SENTENCE (LIST (QUOTE (TELL ME SOMETHING ABOUT)) 
	      (A-AN-HACK NEW-BEAST) (QUOTE (WHICH IS NOT TRUE ABOUT)) 
	      (A-AN-HACK LOSER)) (QUOTE %.))
	    (PRINT-SENTENCE 
	     (QUOTE (PLEASE ENCLOSE YOUR REPLY IN PARENTHESES)) (QUOTE %.))
	    (RPLACA HOWD-WE-GET-HERE 
	     (LIST (GET-NEW-PREDICATE NEW-BEAST) NEW-BEAST LOSER))) (APPLY 
	(QUOTE PACK) (CDR (MAPCONC ((LAMBDA (ANIMAL)
		(COND ((MEMBER (CAR ANIMAL) (QUOTE (A AN))) 
		       (CDR ANIMAL))
		      (T ANIMAL))) (GET-NON-WISECRACK 
	    (QUOTE (HEY, THAT'S NOT THE NAME OF A REAL BEAST%.)))) 
	  (QUOTE (LAMBDA (X) (LIST (QUOTE % ) X)))))))))

(GET-NEW-PREDICATE (LAMBDA (NEW-ANIMAL)
      ((LAMBDA (WISDOM)
	    (COND ((AND (MEMBER (CAR WISDOM) (QUOTE (A AN))) 
			(EQ (CADR WISDOM) NEW-ANIMAL)) 
		   (SETQ WISDOM (CONS (QUOTE IT) (CDDR WISDOM)))))
	    (COND ((EQ (CAR WISDOM) (QUOTE IT)) (COND
			 ((EQ (CADR WISDOM) (QUOTE HAS)) (APPEND 
			   (QUOTE (DOES IT HAVE)) (CDDR WISDOM)))
			 ((EQ (CADR WISDOM) (QUOTE IS)) (APPEND 
			   (QUOTE (IS THIS ANIMAL)) (CDDR WISDOM)))
			 (((LAMBDA (REVEXPLODE)
				(AND (EQ (CAR REVEXPLODE) (QUOTE S)) (PROGN 
		(SETQ REVEXPLODE (CDR REVEXPLODE)) (AND 
		(EQ (CAR REVEXPLODE) (QUOTE E)) 
		(EQ (CADR REVEXPLODE) (CADDR REVEXPLODE)) 
		(SETQ REVEXPLODE (CDR REVEXPLODE))) (SETQ WISDOM (CONS 
		  (APPLY (QUOTE PACK) (REVERSE REVEXPLODE)) 
		  (CDDR WISDOM)))))) (REVERSE (UNPACK (CADR WISDOM)))) 
			  (APPEND (QUOTE (DOES THIS ANIMAL)) WISDOM))
			 (T (APPEND (QUOTE (IS IT TRUE THAT)) WISDOM))))
		  (T (APPEND (QUOTE (WOULD YOU SAY THAT)) WISDOM)))) (
GET-NON-WISECRACK (QUOTE (AW, BE SERIOUS, I ASKED YOU A REAL QUESTION%.))))))

(PRINT-SENTENCE (LAMBDA (SENTENCE PUNCTUATION)
      (OR (NULL SENTENCE) (PRINC SENTENCE))
      (AND PUNCTUATION (PRINC PUNCTUATION))
      (TERPRI)
      (TERPRI)))

(GET-STATEMENT (LAMBDA NIL
      (PROG (STATEMENT)
	   (COND ((ATOM (SETQ STATEMENT (READ))) 
		  (SETQ STATEMENT (CONS STATEMENT))))
	   (RETURN STATEMENT))))

(ASK (LAMBDA (QUERY)
      (PROG (RESPONSE)
	   (PRINT-SENTENCE QUERY (QUOTE ?))
	   LOOP
	   (SETQ RESPONSE (CAR (GET-STATEMENT)))
	   (COND ((MEMBER RESPONSE (QUOTE (YES NO))) 
		  (RETURN (EQ RESPONSE (QUOTE YES)))))
	   (PRINT-SENTENCE (QUOTE ((PLEASE GIVE ME A YES OR NO ANSWER))) 
	    (QUOTE %.))
	   (GO LOOP))))

(GET-NON-WISECRACK (LAMBDA (REMARK)
      (PROG (RESPONSE)
	   LOOP
	   (SETQ RESPONSE (GET-STATEMENT))
	   (MAPCAR RESPONSE (QUOTE (LAMBDA (X)
		  (COND ((MEMBER X 
			  (QUOTE (I YOU HELL DAMN GO THE IF DONT))) 
			 (PRINT-SENTENCE REMARK NIL) (GO LOOP))))))
	   (RETURN RESPONSE))))

(A-AN-HACK (LAMBDA (WORD) 
    ((LAMBDA (FIRST-LETTER)
	     (LIST (COND ((MEMBER FIRST-LETTER '(A E I O U))
			  'AN)
			 (T 'A))
		   WORD))
     (CAR (UNPACK WORD)))))

(SAVE-GAME (LAMBDA NIL
      (PROG (N)
	   LOOP
	   (PRINT-SENTENCE (QUOTE (WHAT FILE NAME SHOULD I SAVE IT ON?)))
	   (COND ((GEQP 0 (SETQ N (OPENW (CAR (GET-STATEMENT))))) 
		  (PRINT-SENTENCE (QUOTE (THAT'S NOT A GOOD FILE NAME%.))) 
		  (GO LOOP)))
	   (PRINT (LIST (QUOTE PROGN)
	       (LIST (QUOTE SETQ)
			(QUOTE TOPTREE)
			(LIST (QUOTE QUOTE) TOPTREE))
	       (QUOTE
	     (PRINT-SENTENCE (QUOTE (NOW I KNOW ALL ABOUT IT)) (QUOTE !)))
	       (QUOTE (QUOTE % ))) N)
	   (CLOSE N))))

(PRINC (LAMBDA (X)
      (COND ((ATOM X) (PRIN1 X) (PRIN1 (QUOTE % )))
	    (T (MAPCAR X (QUOTE PRINC))))))

))

(GCGAG T)

(PROGN
 (SETQ TOPTREE '((DOES IT HAVE HORNS) BUFFALO BUTTERFLY))
 (TERPRI)
 (TERPRI)
 (TERPRI)
 (PRINC '(TO PLAY ANIMAL, TYPE %(PLAY%)%.  TO LOAD A KNOWLEDGE FILE,
	TYPE LOAD%(FILENAME%)%.))
 (PRINC '(IF YOU ANSWER A QUESTION WITH MORE THAN ONE WORD, YOU MUST
	ENCLOSE YOUR ANSWER IN PARENTHESES%.))
 (TERPRI)
 (TERPRI)
 NIL)
