Anonymous user
Execute Brain****/Common Lisp: Difference between revisions
m
<code>
m (RCBF (Common Lisp) moved to RCBF/Common Lisp: MW has page hierarchy support. And it makes the URLs prettier.) |
m (<code>) |
||
Line 2:
=={{header|Common Lisp}}==
(defun adjust-memory (state)
(bf-state-memory-pointer state)))
▲ (cond ((>= (bf-state-memory-pointer state)
▲ (array-dimension (bf-state-memory state) 0))
▲ (adjust-array (bf-state-memory 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-repl ()
▲ (loop do (fresh-line)
▲ (brainfuck-eval (make-bf-state :program (read-line)))))
| |||