Execute Brain****/Common Lisp

Revision as of 13:23, 31 January 2009 by Ce (talk | contribs) (<lang>)
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

<lang 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)))))

</lang>