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

Renamed "places" to "stack" and moved stack into state struct. ELT to AREF changes. Implemented compiler.
(The obvious: use local macros to create shorthand references to the slots of the state structure.)
(Renamed "places" to "stack" and moved stack into state struct. ELT to AREF changes. Implemented compiler.)
Line 7:
(program-counter 0)
(memory (make-array 1 :initial-element 0 :adjustable t))
(memory-pointer 0))
(stack))
 
(defmacro with-bf-slots ((program-sym program-counter-sym
memory-sym memory-pointer-sym)
stack-sym)
obj-expr &body body)
"Macro to replace cumbersome structure slot references with
Line 17 ⟶ 19:
(,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)))
(,stack-sym (bf-state-stack ,obj-expr)))
,@body))
 
(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 ."
(with-bf-slots (program pc mem ptr stack) state
(cond ((>= ptr (length mem))
(adjust-array mem (1+ ptr) :initial-element 0))
Line 37 ⟶ 40:
(defun matching-bracket-for (program bracket-index)
(loop with depth := 01
for index := bracket-index thenfrom (1+ bracket-index)
when (>= index (length program))
do (error "unmatched [ bracket")
whendo (char= #\[case (eltaref program index))
do (#\[ (incf depth))
when (char= (#\] (elt programdecf indexdepth)))
do (decf depth)
until (zerop depth)
finally (return index)))
(defun brainfuck-eval (state &optional (stream *standard-output*))
(with-bf-slots (program pc mem ptr stack) state
(let ((places nil))
(with-bf-slotsloop while (program< pc mem(length ptrprogram)) statedo
(loop whilecase (<aref program pc (length program)) do
(case#\+ (eltincf program(aref mem pcptr)))
(#\+- (incfdecf (aref mem ptr)))
(#\-> (decfincf ptr) (arefadjust-memory mem ptr)state))
(#\>< (incfdecf ptr) (adjust-memory state))
(#\<[ (decfif ptr)(/= 0 (adjust-memoryaref statemem ptr))
(#\[ (if (/= 0 (arefpush mem(1- ptrpc) stack)
(setf pc (push (1matching-bracket-for program pc) places)))
(#\] (setf pc (matching-bracket-forpop program pc)stack)))
(#\]. (setfwrite-char pc(code-char (poparef mem ptr)) placesstream)))
(incf pc)))))
(#\. (write-char (code-char (aref mem ptr)) stream)))
 
(incf pc)))))
(defun brainfuck-compile-guts (program &optional (start 0) (until-bracket nil))
(loop for insn from start below (length program)
(defun bf (program) (brainfuck-eval (make-bf-state :program program)))
appending (case (aref program insn)
(#\+ `((incf (aref mem ptr))))
(#\- `((decf (aref mem ptr))))
(#\> `((incf ptr) (adjust-memory state)))
(#\< `((decf ptr) (adjust-memory state)))
(#\[ (let ((end (matching-bracket-for program insn)))
(prog1
`((do () ((= 0 (aref mem ptr)))
,@(brainfuck-compile-guts program (1+ insn) end)))
(setf insn end))))
(#\] (if until-bracket
(if (= until-bracket insn)
(loop-finish)
(error "internal problem matching brackets"))
(error "extra ] bracket")))
(#\. `((write-char (code-char (aref mem ptr)) stream))))))
(defun brainfuck-compile (program)
(compile nil `(lambda (&optional (stream *standard-output*))
(let ((state (make-bf-state :program ,program)))
(with-bf-slots (program pc mem ptr stack) state
,@(brainfuck-compile-guts program))
(values)))))
 
(defun bf (program)
(if (and (not (zerop (length program)))
(char= #\! (aref program 0)))
(funcall (brainfuck-compile program))
(defun bf (program) (brainfuck-eval (make-bf-state :program program))))
(defun bf-repl ()
"read-eval-print loop for bf. Code prefixed with ! is compiled, otherwise interpreted"
(loop do (fresh-line)
(princ "BRAINFUCK> ")
Anonymous user