Appendix A

; engine.cl
; impliments the engine for the top down parser

; Terry Brugger
; PSYC-526
; continued for CS-471

(defun engine (list dict &optional (len (length list)))
					; list is a list of words
					; len is the length to parse for
					; check for bad input list
  (cond ((null list) nil)
					; Does the list have relivance?
	((not (null (assoc list dict :test 'equal)))
	 (list (lexeme-meaning (second (assoc list dict :test 'equal)))))
					; base case: learn the word
	((equal len 1) (learn list))
	(t
					; otherwise loop on the smaller lists
					; examine is the size of the 
					;    interval examined
	 (do ((examine (1- len) (1- examine)))
					; if we've gotten to the base case,
					; we don't know what the word is,
					; so we might need to learn it.
	     ((equal examine 0) nil)
					; otherwise, loop through starting
					; positions in the list
	     (setq doret
					; num == word to start at
		   (do ((num 0 (1+ num)))
					; base case is when parse starts
					; offset distance from the end
		       ((equal num (1+ (- len examine))) nil)
					; if the segment in question is
					; in the dictonary then return one
					; of three cases
		       (if (not (null (assoc (segment list 
						      (+ num 1) 
						      (+ num examine))
					     dict :test 'equal)))
					; the segment is at the start of
					; the list so we return a list of
					; itself and parse the rest of
					; the list
			   (cond ((equal num 0)
				  (return (append (list (lexeme-meaning (second (assoc 
										 (segment list
											  (+ num 1)
											  (+ num examine))
										 dict :test 'equal))))
						  (engine (segment list
								   (+ 1 (+ num examine))
								   len)
							  dict))))
					; the segment is at the end of
					; the list so we return a list of
					; the parse of the beginning and
					; itself
				 ((equal (+ num examine) len)
				  (return (append (engine (segment list 0 num) dict)
						  (list (lexeme-meaning (second (assoc 
										 (segment list
											  (+ num 1)
											  (+ num examine))
										 dict :test 'equal)))))))
					; otherwise we know it must be
					; in the middle so we return
					; a parse of the beginning,
					; itself and a parse of the end
				 (t
				  (return (append (engine (segment list 0 num) dict)
						  (append (list (lexeme-meaning (second 
										 (assoc 
										  (segment list
											   (+ num 1)
											   (+ num examine))
										  dict :test 'equal))))
							  (engine (segment list
									   (1+ (+ num examine))
									   len) dict))))))
					; if it's not found by the time
					; the examination size is one
					; word, learn it by passing the
					; first word recursively and
					; the rest of the list
			 (if (equal examine 1)
			     (return (append (engine (list (first list)) dictionary 1)
					     (engine (rest list) dictionary (- len 1))))))))
					; if the inner loop produced
					; something (doret != null)
					; then that's the answer so
					; we're done. Otherwise,
					; we need to loop on the next
					; finest granularity
	     (if (not (null doret)) (return doret))))))


					; acts as the interface between
					; the user and the engine
(defun parser ()
  (progn (princ "Enter quit to quit.")
    (terpri)
    (read-line))
  (loop
					; prompt
   (princ "up>")
					; get input
   (let ((input (make-list-from-string (read-line))))
					; check for endcase
     (if (equal (first input) 'quit) 	
	 (return nil)
					; otherwise print the result
       (prog1 (printparse (engine input dictionary)))))))

					; prints out all the strings
					; from the engine call
(defun printparse (lsts)
  (if (null lsts) (terpri)
    (progn
      (princ (first lsts))
      (terpri)
      (printparse (rest lsts)))))

					; get the information on a
					; unrecogniged word
(defun learn (word)
  (format t "The word ~s is unrecogniged." (first word))
  (terpri)
  (princ "Press Enter to continue.")
  (read-line)
  (terpri)
  (princ "What is its meaning: ")
  (setq meaning (read-line))
  (princ "What action should be performed with it: ")
  (setq action (read))
  (princ "What part of speech is it: ")
  (setq part (read))
  (princ "What is its agreement: ")
  (setq agr (read))
  (if (or (equal part 'V)
	  (equal part 'VP))
      (progn (princ "What is its form: ")
	     (setq form (read))
	     (princ "What is its subcategory: ")
	     (setq subcat (read)))
    (progn (setq form nil)
	   (setq subcat nil)))
  (add-dictionary word
		  (make-lexeme :meaning meaning
			       :action action
			       :part part
			       :agr agr
			       :vform form
			       :subcat subcat))
  (list meaning))

					; returns a segment of a list
					; between start and end
(defun segment (list start end)
  (cond ((equal end 0) nil)
	((> start 1) 
	 (segment (cdr list) (1- start) (1- end)))
	(t 
	 (cons (car list) 
	       (segment (cdr list) (1- start) (1- end))))))

					; make a list from the
					; given string
					; based on code by Bob Gattis
					; for ELIZA 
(defun make-list-from-string (string)
					; make stream the string
  (with-input-from-string (stream string)
					; loop through the words
			  (do ((word-in-string
				(read stream nil 'end-of-string)
				(read stream nil 'end-of-string))
			       (string-list))
					; test for end of string
			      ((eq word-in-string 'end-of-string)
					; reverse the order
					; when we're done
			       (nreverse string-list))
					; push the word onto the list
			    (push word-in-string string-list))))