;;;ELIZA.SCM                                            October 23, 1998


;;                   RULES FOR THE "DOCTOR" PROGRAM

;;Evaluate (load "match.scm") -- the pattern matching code -- before
;;evaluating the definitions below.

(define eliza-rules
  (list
   (make-simple-rule '(~ mother ~)
                     '(tell me more about your mother))
   (make-simple-rule '(~ because ~)
                     '(are you feeling defensive))
   (make-simple-rule '(~ feel ?adverb ~)
                     '(Is it usual for you to feel ?adverb))
   (make-simple-rule '(I ~phrase)
                     '(why do you say you ~phrase))
   (make-simple-rule '(~ to ?%verb ~)
                     '(When did you start to ?%verb))
   (make-simple-rule '(~ you ~phrase)
                     '(would you ask that of anyone else besides me))
   (make-simple-rule 'yes
                     '(you sound confident))
   (make-simple-rule 'no
                     '(how negative do you feel?))
   (make-simple-rule '?%short
                     '(say a little more please))
   (make-simple-rule '?%symbol
                     '(Why are you being short with me?))
   (make-simple-rule '(~phrase)
                     '(what makes you say ~phrase))
   (make-simple-rule '?any        ;guarantees a last-resort match
                     '(you can say ?any if you want to))))

(define (verb? datum)
  (memq datum '(dance run sing cry laugh hate)))

(define (short? datum)
  (and (pair? datum)
       (< (length datum) 3)))

(define restriction-table
  `((?%verb  ,verb?)
    (?%short ,short?)))


                      ;;READ-EVAL-PRINT-LOOP

(define (doctor)
  (begin
    (newline)
    (newline)
    (display '(hello, what can i do for you?))
    (newline)
    (doctor-repl (read))))


(define (doctor-repl input)
  (if (or (eq? input 'quit)
          (eq? input 'exit)
          (equal? input '(quit))
          (equal? input '(exit)))
      "Your session is over.  Good luck."
      (begin
        (newline)
        (newline)
        (display
         (one-rules-application eliza-rules input))
                      ;eliza rules application can't fail
        (newline)
        (doctor-repl (read)))))