Execute Brain****/Common Lisp: Difference between revisions
m
Fixed syntax highlighting.
m (<code>) |
m (Fixed syntax highlighting.) |
||
| (9 intermediate revisions by 7 users not shown) | |||
Line 1:
{{implementation|Brainf***}}{{collection|RCBF}}
This is an implementation of [[Brainf***]] written in [[Common Lisp]].
<code lisp>(defstruct bf-state▼
(program)
(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
(defun adjust-memory (state)▼
"Macro to replace cumbersome structure slot references with
(1+ (bf-state-memory-pointer state))▼
local lexical macros resembling local variables."
:initial-element 0))▼
(
(
,@body))
(make-array (+ (length old-memory) extent)))▼
(setf (subseq (bf-state-memory state) extent)▼
old-memory))))))▼
▲(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))
(let ((extent (- ptr)))
(incf ptr extent)
(let ((old-memory (copy-seq mem)))
(setf (subseq mem extent) old-memory)))))))
(defun matching-bracket-for (program bracket-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▼
(#\+ (incf (elt (bf-state-memory state) (bf-state-memory-pointer state))))▼
(#\- (decf (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
(with-bf-slots (program pc mem ptr stack) state
(case (aref program pc)
(#\+ (incf (aref mem ptr)))
(#\- (decf (aref mem ptr)))
(#\[ (if (/= 0 (aref mem ptr))
(incf pc))))
(defun brainfuck-compile-guts (program &optional (start 0) (until-bracket nil))
(loop for insn from start below (length program)
appending (case (aref program insn)
(#\+ `((incf (aref mem ptr))))
(#\- `((decf (aref mem ptr))))
`((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)
(with-bf-slots (program pc mem ptr stack) state
(defun bf (program)
(if (and (not (zerop (length program)))
(char= #\! (aref program 0)))
(funcall (brainfuck-compile program))
(defun bf-repl ()
"read-eval-print loop for bf. Code prefixed with ! is compiled, otherwise interpreted"
(loop do (fresh-line)
(princ "BRAINFUCK> ")
(
| |||