brainf*ck interpreter

bf.lisp

(defun bf (src &optional (tape-length 100))
  (let* ((code (remove-if-not (lambda (c) (find c "<>+-.,[]")) src))
         (len (length code))
         (jump (make-hash-table)))
 
    (do* ((i 0 (1+ i)) (stack))
        ((= i len) (when stack (error (format nil "unmatch [ at ~A" (car stack)))))
      (case (aref code i)
        (#\[ (push i stack))
        (#\] (unless stack (error (format nil "unmatch ] at ~A" i)))
         (let ((j (pop stack)))
           (setf (gethash j jump) i (gethash i jump) j)))))
 
    (do* ((tape (make-array tape-length :initial-element 0))
          (pos 0)
          (cur 0 (1+ cur)))
        ((= cur len) (values tape pos))
      (case (aref code cur)
        (#\+ (incf #1=(aref tape pos)))
        (#\- (decf #1#))
        (#\> (incf pos))
        (#\< (when (< (decf pos) 0) (error (format nil "address-error at ~A" cur))))
        (#\, (setf #1# (char-code (read-char))))
        (#\. (princ (code-char #1#)))
        (#\[ (when (= 0 #1#) (setq cur #2=(gethash cur jump))))
        (#\] (when (> #1# 0) (setq cur #2#)))))))