Execute Brain****/Common Lisp: Difference between revisions
Content added Content deleted
m (moved RCBF/Common Lisp to Execute Brain****/Common Lisp) |
(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 |
|||
⚫ | |||
⚫ | |||
"Macro to replace cumbersome structure slot references with |
|||
local lexical macros resembling local variables." |
|||
`(symbol-macrolet ((,program-sym (bf-state-program ,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 ." |
||
( |
(with-bf-slots (program pc mem ptr) state |
||
(cond ((>= ptr (length mem)) |
|||
(adjust-array ( |
(adjust-array mem (1+ ptr) :initial-element 0)) |
||
((minusp ptr) |
|||
(let ((extent (- ptr))) |
|||
(incf ptr extent) |
|||
(let (( |
(let ((old-memory (copy-seq mem))) |
||
( |
(setf mem (make-array (+ (length old-memory) extent))) |
||
(setf (subseq mem extent) old-memory))))))) |
|||
⚫ | |||
(make-array (+ (length old-memory) 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 (( |
(let ((places nil)) |
||
(with-bf-slots (program pc mem ptr) state |
|||
⚫ | |||
(loop while (< |
(loop while (< pc (length program)) do |
||
(case (elt program |
(case (elt program pc) |
||
(#\+ (incf ( |
(#\+ (incf (aref mem ptr))) |
||
(#\- (decf ( |
(#\- (decf (aref mem ptr))) |
||
(#\> (incf |
(#\> (incf ptr) (adjust-memory state)) |
||
(#\< (decf |
(#\< (decf ptr) (adjust-memory state)) |
||
(#\[ (if (/= 0 ( |
(#\[ (if (/= 0 (aref mem ptr)) |
||
(push (1- |
(push (1- pc) places) |
||
(setf ( |
(setf pc (matching-bracket-for program pc)))) |
||
(#\] (setf pc (pop places))) |
|||
(#\ |
(#\. (write-char (code-char (aref mem ptr)) stream))) |
||
⚫ | |||
(#\. (write-char (code-char (elt (bf-state-memory 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) |