;Reading at top level in Lisp Listener 2.
;Reading in base 10 in package USER with standard Common-Lisp readtable.

(defun chomp (list)
	(do ((list (chomp-once list) (chomp-once list)))
	    ((null list) (format t "~%<BURP>  Mmmm, thank you.~%"))
	 (print list)))
CHOMP
(defun chomp-once (list)
	(let ((chomper-direction (chomper-going-where? list)))
	(case chomper-direction
	  (> (if (anything-to-chomp-left list) (move-left list)
		(chomper-point 'V list)))
	  (< (if (anything-to-chomp-right list) (move-right list)
		(chomper-point 'V list)))
	  (V (cond ((anything-to-chomp-left list)
		    (chomper-point '> list))
		   ((anything-to-chomp-right list)
		    (chomper-point '< list))
		   (t nil))))))
CHOMP-ONCE
(defun chomper-going-where? (list)
	(case (car list)
	  (< '<)
	  (> '>)
	  (V 'V)
	  (t (chomper-going-where? (cdr list)))))
CHOMPER-GOING-WHERE?
(defun anything-to-chomp-left (list)
	(case (car list)
	  (1 t)
	  (0 (anything-to-chomp-left (cdr list)))
	  ((< > V) nil)))
ANYTHING-TO-CHOMP-LEFT
(defun anything-to-chomp-right (list)
	(let ((list (flush-until-chomper list)))
	  (member 1 list)))
ANYTHING-TO-CHOMP-RIGHT
(defun flush-until-chomper (list)
	(if (null list) nil
	  (case (car list)
	    ((> < V) (cdr list))
	    (t (flush-until-chomper (cdr list))))))
FLUSH-UNTIL-CHOMPER
(defun move-left (list)
	(cond ((eql (cadr list) '>) (cons '> (cons 0 (cddr list))))
	      (t (cons (car list) (move-left (cdr list))))))
MOVE-LEFT
(defun move-right (list)
	(cond ((eql (car list) '<) (cons 0 (cons '< (cddr list))))
	      (t (cons (car list) (move-right (cdr list))))))
MOVE-RIGHT
(defun chomper-point (direction list)
	(let ((old-direction (chomper-going-where? list)))
	  (substitute direction old-direction list)))
CHOMPER-POINT
(chomp '(0 1 0 1 0 0 0 V 1 1 0 0))
(0 1 0 1 0 0 0 > 1 1 0 0) 
(0 1 0 1 0 0 > 0 1 1 0 0) 
(0 1 0 1 0 > 0 0 1 1 0 0) 
(0 1 0 1 > 0 0 0 1 1 0 0) 
(0 1 0 > 0 0 0 0 1 1 0 0) 
(0 1 > 0 0 0 0 0 1 1 0 0) 
(0 > 0 0 0 0 0 0 1 1 0 0) 
(0 V 0 0 0 0 0 0 1 1 0 0) 
(0 < 0 0 0 0 0 0 1 1 0 0) 
(0 0 < 0 0 0 0 0 1 1 0 0) 
(0 0 0 < 0 0 0 0 1 1 0 0) 
(0 0 0 0 < 0 0 0 1 1 0 0) 
(0 0 0 0 0 < 0 0 1 1 0 0) 
(0 0 0 0 0 0 < 0 1 1 0 0) 
(0 0 0 0 0 0 0 < 1 1 0 0) 
(0 0 0 0 0 0 0 0 < 1 0 0) 
(0 0 0 0 0 0 0 0 0 < 0 0) 
(0 0 0 0 0 0 0 0 0 V 0 0) 
<BURP>  Mmmm, thank you.

NIL
(dribble)