;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Joey Baranski
;;ECE 478 HW 3
;;Due 01/31/2005
;;Notes: 
;;       +Portions of this code were adapted from Luger 5th Edition
;;       +There was a full Expert System Implementation in Luger's text
;;       +There was an execellent Rule validator in Paul Graham's ANSI CLisp
;;       +I chose to forgo implementing those programs because the code was 
;;        too complete & would not have increased my knowledge of Lisp
;;       +Instead I implemented this inferrior solution, but in the process
;;        I increased my knowledge of Lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun repeat-confirm (cmd)
  (cond ((cdr cmd) (format t "Please give me a less ambiguous command."))
        ((eq nil cmd) (format t "I don't understand the command you gave."))
        (t (format t "Good Command, I can execute this."))))

(defun start-shell ()
  (declare (special *database*))
  (setq *database* '((go left door)
                     (go right door)
                     (go rear door)
                     (go front door)
                     (grab hammer)
                     (grab nails)
                     (dance with me)
                     (dance by yourself)
                     (buzz off)
                     (sing happy song)
                     (sing sad song)))
  (command-shell *database*))

(defun command-shell (database)
  (prin1 'enter-command>)
  (let ((cmd (read)))
  (terpri)  
  (cond ((equal cmd 'quit) 'bye)
         (t (repeat-confirm (get-matches cmd database))(terpri) (command-shell database)))))
               
(defun variable-p (x)
  (equal x '?))

(defun match-atom (pattern1 pattern2)
  (or (equal pattern1 pattern2) (variable-p pattern1) (variable-p pattern2)))

(defun match (pattern1 pattern2)
  (cond ((or (atom pattern1) (atom pattern2))
            (match-atom pattern1 pattern2))
        (t (and (match (car pattern1) (car pattern2))
             (match (cdr pattern1) (cdr pattern2))))))

(defun get-matches (pattern database)
  (cond ((null database) ())
        ((match pattern (car database))
                (cons (car database) (get-matches pattern (cdr database))))
         (t (get-matches pattern (cdr database)))))