Execute Brain****/Common Lisp: Difference between revisions
Content added Content deleted
m (<lang>) |
(→{{header|Common Lisp}}: explain how adjust-memory works, use length in favor of array-dimension, various other polish (UNTESTED)) |
||
Line 10: | Line 10: | ||
(defun adjust-memory (state) |
(defun adjust-memory (state) |
||
"Modifies memory and memory-pointer such that memory-pointer is a valid index to the memory array. |
|||
If it is too large, the array is extended; if it is negative, the array is extended, its contents are shifted forward and the memory-pointer is incremented, by an amount to make the memory ." |
|||
(cond ((>= (bf-state-memory-pointer state) |
(cond ((>= (bf-state-memory-pointer state) |
||
( |
(length (bf-state-memory state))) |
||
(adjust-array (bf-state-memory state) |
(adjust-array (bf-state-memory state) |
||
(1+ (bf-state-memory-pointer state)) |
(1+ (bf-state-memory-pointer state)) |
||
:initial-element 0)) |
:initial-element 0)) |
||
(( |
((minusp (bf-state-memory-pointer state)) |
||
(let ((extent (- (bf-state-memory-pointer state)))) |
(let ((extent (- (bf-state-memory-pointer state)))) |
||
(incf (bf-state-memory-pointer state) extent) |
(incf (bf-state-memory-pointer state) extent) |
||
Line 25: | Line 27: | ||
(defun matching-bracket-for (program bracket-index) |
(defun matching-bracket-for (program bracket-index) |
||
( |
(loop with depth := 0 |
||
for index := bracket-index then (1+ index) |
|||
when (>= index (length program)) |
|||
do (error "unmatched bracket") |
|||
when (char= #\[ (elt program index)) |
|||
do (incf depth) |
|||
when (char= #\] (elt program index)) |
|||
do (decf depth) |
|||
until (zerop depth) |
|||
finally (return index))) |
|||
(defun brainfuck-eval (state &optional (stream *standard-output*)) |
(defun brainfuck-eval (state &optional (stream *standard-output*)) |
||
Line 60: | Line 62: | ||
(loop do (fresh-line) |
(loop do (fresh-line) |
||
(princ "BRAINFUCK> ") |
(princ "BRAINFUCK> ") |
||
( |
(bf (read-line)))) |
||
</lang> |
</lang> |
Revision as of 15:03, 31 January 2009
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)
"Modifies memory and memory-pointer such that memory-pointer is a valid index to the memory array.
If it is too large, the array is extended; if it is negative, the array is extended, its contents are shifted forward and the memory-pointer is incremented, by an amount to make the memory ."
(cond ((>= (bf-state-memory-pointer state) (length (bf-state-memory state))) (adjust-array (bf-state-memory state) (1+ (bf-state-memory-pointer state)) :initial-element 0)) ((minusp (bf-state-memory-pointer state)) (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)
(loop with depth := 0 for index := bracket-index then (1+ index) when (>= index (length program)) do (error "unmatched bracket") when (char= #\[ (elt program index)) do (incf depth) when (char= #\] (elt program index)) do (decf depth) until (zerop depth) 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> ") (bf (read-line))))
</lang>