Execute Brain****/Common Lisp: Difference between revisions

Content added Content deleted
(The obvious: use local macros to create shorthand references to the slots of the state structure.)
Line 8: Line 8:
(memory (make-array 1 :initial-element 0 :adjustable t))
(memory (make-array 1 :initial-element 0 :adjustable t))
(memory-pointer 0))
(memory-pointer 0))

(defmacro with-bf-slots ((program-sym program-counter-sym
⚫
memory-sym memory-pointer-sym)
⚫
obj-expr &body body)
"Macro to replace cumbersome structure slot references with
local lexical macros resembling local variables."
`(symbol-macrolet ((,program-sym (bf-state-program ,obj-expr))
⚫
(,program-counter-sym (bf-state-program-counter ,obj-expr))
⚫
(,memory-sym (bf-state-memory ,obj-expr))
⚫
(,memory-pointer-sym (bf-state-memory-pointer ,obj-expr)))
,@body))


(defun adjust-memory (state)
(defun adjust-memory (state)
Line 15: Line 26:
contents are shifted forward and the memory-pointer is incremented,
contents are shifted forward and the memory-pointer is incremented,
by an amount to make the memory ."
by an amount to make the memory ."
(cond ((>= (bf-state-memory-pointer state)
(with-bf-slots (program pc mem ptr) state
(length (bf-state-memory state)))
(cond ((>= ptr (length mem))
(adjust-array (bf-state-memory state)
(adjust-array mem (1+ ptr) :initial-element 0))
(1+ (bf-state-memory-pointer state))
((minusp ptr)
:initial-element 0))
(let ((extent (- ptr)))
((minusp (bf-state-memory-pointer state))
(incf ptr extent)
(let ((extent (- (bf-state-memory-pointer state))))
(let ((old-memory (copy-seq mem)))
(incf (bf-state-memory-pointer state) extent)
(setf mem (make-array (+ (length old-memory) extent)))
(let ((old-memory (copy-seq (bf-state-memory state))))
(setf (subseq mem extent) old-memory)))))))
⚫
(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)
(defun matching-bracket-for (program bracket-index)
(loop with depth := 0
(loop with depth := 0
Line 40: Line 47:
until (zerop depth)
until (zerop depth)
finally (return index)))
finally (return index)))

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

(defun bf-repl ()
(defun bf-repl ()
(loop do (fresh-line)
(loop do (fresh-line)
Retrieved from "https://rosettacode.org/wiki/Execute_Brain****/Common_Lisp"