(DOCTOR RESTRICT MATCH BADWORDS BADWORD ATOMCAR ATOMCDR TEST)›(DEFINEQ DOCTOR '(LAMBDA NIL (PROG (L MOTHER S) (POKE 128 0) (PRINT (QUOTE (SPEAK UP))) LOOP (SETQ S (READ)) (COND ((ATOM S) (SETQ S (LIST S)))) (COND ((MATCH (QUOTE (I AM WORRIED +L)) S) (PRINT (APPEND (QUOTE (HOW LONG HAVE YOU BEEN WORRIED)) L))) ((MATCH (QUOTE (+ MOTHER +)) S) (SETQ MOTHER T) (PRINT (QUOTE (TELL ME MORE ABOUT YOUR FAMILY)))) ((MATCH (QUOTE (+ COMPUTERS +)) S) (PRINT (QUOTE (DO MACHINES FRIGHTEN YOU)))) ((OR (MATCH (QUOTE (NO)) S) (MATCH (QUOTE (YES)) S)) (PRINT (QUOTE (PLEASE DO NOT BE SO SHORT WITH ME)))) ((MATCH (QUOTE (+ (RESTRICT > BADWORD) +)) S) (PRINT (QUOTE (PLEASE DO NOT USE WORDS LIKE THAT)))) (MOTHER (SETQ MOTHER NIL) (PRINT (QUOTE (EARLIER YOU SPOKE OF YOUR MOTHER)))) (T (PRINT (QUOTE (I AM SORRY OUR TIME IS UP))) (RETURN (QUOTE GOODBYE)))) (GO LOOP)))›)›(DEFINEQ MATCH '(LAMBDA (P D) (COND ((AND (EQ P) (EQ D)) T) ((OR (EQ P) (EQ D)) NIL) ((EQ (ATOM (CAR P))) (COND ((AND (EQ (CAR (CAR P)) (QUOTE RESTRICT)) (EQ (CAR (CDR (CAR P))) (QUOTE >)) (TEST (CDR (CDR (CAR P))) (CAR D))) (MATCH (CDR P) (CDR D))) ((AND (EQ (CAR (CAR P)) (QUOTE RESTRICT)) (EQ (ATOMCAR (CAR (CDR (CAR P)))) (QUOTE >)) (TEST (CDR (CDR (CAR P))) (CAR D)) (MATCH (CDR P) (CDR D))) (SET (ATOMCDR (CAR (CDR (CAR P)))) (CAR D)) T))) ((OR (EQ (CAR P) (QUOTE >)) (EQ (CAR P) (CAR D))) (MATCH (CDR P) (CDR D))) ((AND (EQ (ATOMCAR (CAR P)) (QUOTE >)) (MATCH (CDR P) (CDR D))) (SET (ATOMCDR (CAR P)) (CAR D)) T) ((EQ (CAR P) (QUOTE +)) (COND ((MATCH (CDR P) (CDR D)) T) (T (MATCH P (CDR D))))) ((EQ (ATOMCAR (CAR P)) (QUOTE +)) (COND ((MATCH (CDR P) (CDR D)) (SET (ATOMCDR (CAR P)) (LIST (CAR D))) T) ((MATCH P (CDR D)) (SET (ATOMCDR (CAR P)) (CONS (CAR D) (EVAL (ATOMCDR (CAR P))))) T)))))›)›(SETQ BADWORDS '(DARN HELL)›)›(DEFINEQ BADWORD '(LAMBDA (WORD) (MEMBER WORD BADWORDS))›)›(DEFINEQ ATOMCAR '(LAMBDA (X) (CAR (UNPACK X)))›)›(DEFINEQ ATOMCDR '(LAMBDA (X) (PACK (CDR (UNPACK X))))›)›(DEFINEQ TEST '(LAMBDA (PREDICATES ARGUMENT) (PROG NIL LOOP (COND ((EQ PREDICATES) (RETURN T))) (COND ((APPLY* (CAR PREDICATES) ARGUMENT) (SETQ PREDICATES (CDR PREDICATES)) (GO LOOP)) (T (RETURN)))))›)›NIL›