brainf*ck reader for CommonLisp

bf-reader.lisp

(defun read-bf (s &optional (d 0))
  (let (code)
    (loop
       for p = nil then c
       for c = #1=(read-char s nil) then #1#
       while (and c (char/= c #\^))
       do (case c
	    (#\[ (push `(loop while (< 0 #2=(aref tape pos))
			  do ,@(read-bf s (1+ d))) code))
	    (#\] (if (= d 0) (error "unmatch ]")
		     (return (reverse code))))
	    (#\. (push `(princ (code-char #2#)) code))
	    (#\, (push `(setf #2# (read-char)) code))
	    (t (if (eql c p)
		   (incf (caddar code))
		   (case c
		     (#\+ (push (list 'incf '#2# 1) code))
		     (#\- (push (list 'decf '#2# 1) code))
		     (#\> (push (list 'incf 'pos 1) code))
		     (#\< (push (list 'decf 'pos 1) code))))))
       finally (if (> d 0) (error "unmatch [")
		   (return (reverse code))))))

(set-dispatch-macro-character #\# #\^
  #'(lambda (s c len)
      (declare (ignore c))
      `(let ((tape (make-array ,(or len 100)))
             (pos 0))
	 ,@(read-bf s 0)
	 (values tape pos))))

(defmacro bf (src &optional (len 100))
  `(let ((tape (make-array ,len)) (pos 0))
     ,@(read-bf (make-string-input-stream src) 0)
     (values tape pos)))