随手整理的就贴出来了，其实我不会 Brainfuck，写这个只是尝试一下 Common Lisp 写一个解释器需要多少代码（逃。
;; constants
(defparameter *max-operations* 100000)
(defparameter *valid-operations* "<>+-.,[]")
;; global variables
(defvar *memory* (make-array 100000 :initial-element 0))
(defvar *source* (make-array 5000 :initial-element #\0))
(defvar *source-pointer* 0)
(defvar *source-pointer-end* 0)
(defvar *operations* 0)
(defvar *data-pointer* 0)
(defvar *open-loop-stack* nil)
(defvar *input* nil)
(defvar *input-pointer* 0)
(defun main ()
(let ((input-length (read))
(source-length (read)))
;; Get Input
(setf *input* (subseq (read-line) 0 input-length))
;; Parse
(let ((source-pointer 0))
(loop repeat source-length
for line = (read-line)
do (loop for char across line
when (not (null (position char *valid-operations*)))
do (progn (setf (aref *source* source-pointer) char)
(incf source-pointer))))
(setf *source-pointer-end* source-pointer))
;; Interpret
(loop while (< *source-pointer* *source-pointer-end*)
when (>= *operations* *max-operations*)
return (format t "~%PROCESS TIME OUT. KILLED!!!")
do (labels ((increment-data ()
(if (= (aref *memory* *data-pointer*) 255)
(setf (aref *memory* *data-pointer*) 0)
(incf (aref *memory* *data-pointer*))))
(decrement-data ()
(if (= (aref *memory* *data-pointer*) 0)
(setf (aref *memory* *data-pointer*) 255)
(decf (aref *memory* *data-pointer*))))
(increment-data-pointer ()
(incf *data-pointer*))
(decrement-data-pointer ()
(unless (= 0 *data-pointer*)
(decf *data-pointer*)))
(read-input ()
(prog1 (aref *input* *input-pointer*)
(incf *input-pointer*)))
(print-data ()
(princ (code-char (aref *memory* *data-pointer*))))
(read-data ()
(setf (aref *memory* *data-pointer*)
(char-code (read-input))))
(opened-loop-p ()
(eql (aref *source* *source-pointer*) #\[))
(closed-loop-p ()
(eql (aref *source* *source-pointer*) #\]))
(goto-end-of-loop ()
(let ((loops 0))
(loop when (opened-loop-p)
do (incf loops)
when (closed-loop-p)
do (decf loops)
when (and (closed-loop-p)
(= loops 0))
return nil
do (incf *source-pointer*))))
(goto-start-of-loop ()
(setf *source-pointer* (pop *open-loop-stack*)))
(open-loop ()
(push *source-pointer* *open-loop-stack*)
(if (plusp (aref *memory* *data-pointer*))
(incf *source-pointer*)
(goto-end-of-loop)))
(close-loop ()
(if (plusp (aref *memory* *data-pointer*))
(goto-start-of-loop)
(progn (pop *open-loop-stack*)
(incf *source-pointer*)))))
(let ((op (aref *source* *source-pointer*)))
(if (case op
(#\+ (increment-data))
(#\- (decrement-data))
(#\> (increment-data-pointer))
(#\< (decrement-data-pointer))
(#\. (print-data))
(#\, (read-data)))
(incf *source-pointer*)
(case op
(#\[ (open-loop))
(#\] (close-loop)))))
(incf *operations*)))))
(defun print-source ()
(loop for x from 0 below *source-pointer-end*
collect (princ (aref *source* x))))