;; Even though it is all undefined, it seems the data array are only bytes.
(define-modify-macro incf-mod-256 (&optional (delta 1))
  (lambda (val &optional (delta 1))
    (mod (+ val delta) 256)))

(define-modify-macro decf-mod-256 (&optional (delta 1))
  (lambda (val &optional (delta 1))
    (mod (- val delta) 256)))


(defun %brainfuck->cl (data-array-size bf-code)
  (let ((while-stack ())
        (instr-stream ()))

    (loop :for command :across bf-code :do
      (case command
        (#\> (push `(incf data-index) instr-stream))
        (#\< (push `(decf data-index) instr-stream))
        (#\+ (push `(incf-mod-256 (aref data-array data-index)) instr-stream))
        (#\- (push `(decf-mod-256 (aref data-array data-index)) instr-stream))
        (#\. (push `(princ (code-char (aref data-array data-index)))
                   instr-stream))
        (#\, (push `(setf (aref data-array data-index)
                          (mod (char-code (read-char)) 256))
                   instr-stream))
        (#\[ (let* ((while-begin-label (gensym "BEGIN-WHILE-"))
                    (while-end-label (gensym "END-WHILE-"))
                    (conditional
                      `(when (zerop (aref data-array data-index))
                         (go ,while-end-label))))
               (push while-begin-label instr-stream)
               (push conditional instr-stream)
               (push (list while-begin-label while-end-label) while-stack)))
        (#\] (destructuring-bind (while-begin while-end) (pop while-stack)
               (push `(go ,while-begin) instr-stream)
               (push while-end instr-stream)))
        (otherwise
         nil)))

    (setf instr-stream (reverse instr-stream))

    `(lambda ()
       (let ((data-array (make-array ,data-array-size
                                     :element-type '(unsigned-byte 8)
                                     :initial-element 0))
             (data-index 0))
         (tagbody
            ,@instr-stream)))))

;; compiling BF to CL. at the repl, (funcall (brainfuck->cl 1024 "<bf-code>"))
;; to run your code in lisp.
(defmacro brainfuck->cl (data-array-size bf-code)
  (%brainfuck->cl data-array-size bf-code))


;; But, suppose we want to just _interpret_ some BF code.
(defun brainfuck-interpreter (data-array-size bf-code)
  (let ((while-symtab (make-hash-table))
        (while-match-list ()))
    (flet ((analyze-while-loops (bf-code)
             ;; First, we walk the entire program and build the address table
             ;; for the while loops.
             (loop :for ip :below (length bf-code)
                   :for command = (aref bf-code ip) :do
                     (case command
                       (#\[
                        (let ((entry (list :begin ip :end nil)))
                          (setf (gethash ip while-symtab) entry)
                          (push entry while-match-list)))
                       (#\]
                        ;; entry is sharing reference with hash table!
                        (let ((entry (pop while-match-list)))
                          ;; and also insert the end of the while loop so
                          ;; we can find the beginning.
                          (setf (gethash ip while-symtab) entry)
                          (setf (getf entry :end) (1+ ip))))))))

      (analyze-while-loops bf-code)

      ;; Then we simply evaluate everything. carefully looking up the
      ;; while address we built before for looping.
      (let ((data-array (make-array data-array-size
                                    :element-type '(unsigned-byte 8)
                                    :initial-element 0))
            (data-index 0))

        (loop
          :with ip = 0
          :until (>= ip (length bf-code))
          :for command = (aref bf-code ip)
          :do
             (case command
               (#\>
                (incf data-index)
                (incf ip))
               (#\<
                (decf data-index)
                (incf ip))
               (#\+
                (incf-mod-256 (aref data-array data-index))
                (incf ip))
               (#\-
                (decf-mod-256 (aref data-array data-index))
                (incf ip))
               (#\.
                (princ (code-char (aref data-array data-index)))
                (incf ip))
               (#\,
                (setf (aref data-array data-index)
                      (mod (char-code (read-char)) 256))
                (incf ip))
               (#\[
                (let ((while-entry (gethash ip while-symtab)))
                  (if (zerop (aref data-array data-index))
                      (setf ip (getf while-entry :end))
                      (incf ip))))

               (#\]
                (let ((while-entry (gethash ip while-symtab)))
                  (setf ip (getf while-entry :begin))))

               (otherwise nil)))))))


(defparameter *hello-world*
  "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.")

;; run the macro. I didn't care enough to get the variable eval right.
(defun doit-0 ()
  (brainfuck->cl 1024 "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++."))

;; run the interpreter on hello world instead.
(defun doit-1 (&optional (bf-code *hello-world*))
  (brainfuck-interpreter 1024 bf-code))