Execute Brain****/Common Lisp: Difference between revisions
Content added Content deleted
m (RCBF (Common Lisp) moved to RCBF/Common Lisp: MW has page hierarchy support. And it makes the URLs prettier.) |
m (<code>) |
||
Line 2: | Line 2: | ||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
<code lisp>(defstruct bf-state |
|||
(program) |
|||
(program-counter 0) |
|||
(memory (make-array 1 :initial-element 0 :adjustable t)) |
|||
(memory-pointer 0)) |
|||
(defun adjust-memory (state) |
|||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
(bf-state-memory-pointer state))) |
|||
⚫ | |||
⚫ | |||
(defun bf (program) (brainfuck-eval (make-bf-state :program program))) |
|||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
(princ "BRAINFUCK> ") |
|||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
(defun bf (program) (brainfuck-eval (make-bf-state :program program))) |
|||
⚫ | |||
⚫ | |||
(princ "BRAINFUCK> ") |
|||
⚫ |
Revision as of 16:27, 28 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
(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)))))