Execute Brain****/Common Lisp

Execute Brain****/Common Lisp is an implementation of Brainf***. Other implementations of Brainf***.

Execute Brain****/Common Lisp is part of RCBF. You may find other members of RCBF at Category:RCBF.

Common Lisp

(defstruct bf-state
  (program)
  (program-counter 0)
  (memory (make-array 1 :initial-element 0 :adjustable t))
  (memory-pointer 0))

(defun adjust-memory (state)
  (cond ((>= (bf-state-memory-pointer state)
             (array-dimension (bf-state-memory state) 0))
         (adjust-array (bf-state-memory state)
                       (1+ (bf-state-memory-pointer state))
                       :initial-element 0))
        ((< (bf-state-memory-pointer state) 0)
         (let ((extent (- (bf-state-memory-pointer state))))
           (incf (bf-state-memory-pointer state) extent)
           (let ((old-memory (copy-seq (bf-state-memory state))))
             (setf (bf-state-memory state)
                   (make-array (+ (length old-memory) extent)))
             (setf (subseq (bf-state-memory state) extent)
                   old-memory))))))

(defun matching-bracket-for (program bracket-index)
  (let ((depth 0))
    (loop for index := bracket-index then (1+ index)
          when (>= index (length program))
            do (error 'fail)
          when (char= #\[ (elt program index))
            do (incf depth)
          when (char= #\] (elt program index))
            do (decf depth)
          until (= depth 0)
          finally (return index))))

(defun brainfuck-eval (state &optional (stream *standard-output*))
  (let ((program (bf-state-program state))
        (places nil))
    (loop while (< (bf-state-program-counter state) (length program)) do
      (case (elt program (bf-state-program-counter state))
        (#\+ (incf (elt (bf-state-memory state) (bf-state-memory-pointer state))))
        (#\- (decf (elt (bf-state-memory state) (bf-state-memory-pointer state))))
        (#\> (incf (bf-state-memory-pointer state)) (adjust-memory state))
        (#\< (decf (bf-state-memory-pointer state)) (adjust-memory state))
        (#\[ (if (/= 0 (elt (bf-state-memory state) (bf-state-memory-pointer state)))
                 (push (1- (bf-state-program-counter state)) places)
                 (setf (bf-state-program-counter state)
                       (matching-bracket-for program (bf-state-program-counter state)))))
        (#\] (setf (bf-state-program-counter state) (pop places)))
        (#\. (write-char (code-char (elt (bf-state-memory state)
                                         (bf-state-memory-pointer state)))
                         stream)))
      (incf (bf-state-program-counter state)))))
 
(defun bf (program) (brainfuck-eval (make-bf-state :program program)))

(defun bf-repl ()
  (loop do (fresh-line)
           (princ "BRAINFUCK> ")
           (brainfuck-eval (make-bf-state :program (read-line)))))