Brainf**k implemented in Common Lisp

Question

I tried implementing Brainf**k in Common Lisp, SBCL. I have encountered some problems.

(defparameter *tape* (make-array '(1) :adjustable t))
(defparameter *pointer* 0)
(defparameter *tape-size* 1)
(defparameter *output* (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t))

(defun move-pointer-right (a b)
 (declare (ignore a))
 (declare (ignore b))
 '(progn 
  (incf *tape-size*)
  (adjust-array *tape* (list *tape-size*))
  (incf *pointer*)))
(defun move-pointer-left (a b)
 (declare (ignore a))
 (declare (ignore b))
 '(progn (decf *pointer*)))
(defun increment-byte (a b)
 (declare (ignore a))
 (declare (ignore b))
 '(incf (aref *tape* *pointer*)))
(defun decrement-byte (a b)
 (declare (ignore a))
 (declare (ignore b))
 '(decf (aref *tape* *pointer*)))
(defun start-loop (stream ch)
 (declare (ignore ch))
 (let ((loop-body (read-delimited-list #\] stream t)))
 `(loop :until (zerop (aref *tape* *pointer*))
        :do ,@loop-body)))
(defun print-one-char (a b)
 (declare (ignore a))
 (declare (ignore b))
 '(with-output-to-string (s *output*) (write-char (code-char (aref *tape* *pointer*)) s)))
(defun read-one-char (a b)
 (declare (ignore a))
 (declare (ignore b))
 '(setf (aref *tape* *pointer*) (char-code (read-char *standard-input*))))
(defun flush-output (a b)
 (declare (ignore a))
 (declare (ignore b))
 '(progn *output*))
(defun reset-me (a b)
 (declare (ignore a))
 (declare (ignore b))
 '(progn 
  (setf *output* (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t))
  (adjust-array *tape* '(1))
  (setf (aref *tape* 0) 0)
  (setf *pointer* 0)))
(set-macro-character #\< #'move-pointer-left)
(set-macro-character #\> #'move-pointer-right)
(set-macro-character #\+ #'increment-byte)
(set-macro-character #\[ #'start-loop)
(set-macro-character #\= #'flush-output)
(set-macro-character #\. #'print-one-char)
(set-macro-character #\, #'read-one-char)
(set-macro-character #\! #'reset-me)
(set-macro-character #\- #'decrement-byte)

• input doesn't work
• I am not sure whether nested loops would work because "[" reads to "]" and if you try "[/commands[/more]/dubious]" I don't how /dubious could be loaded with this methods.
• I tried "++[->+>+<<]". As far as I know array should have: "0 2 2" but I got "0 2 0" instead. I conclude something is deeply wrong.
• I am getting a lot of warnings from SBCL - it would be better to not have them:/
• Is there a quick way to output all generated code (returned from functions such as "move-pointer-right") to file?
• output is saved in one string to be printed at "=" command. I did it, because other operations were printing a lot of useless things to standard output. It is not a big problem for me - it seems easy to imagine just printing to file, instead of this workaround.
• I am sorry for possible mistakes in my English.

Edit: I edited code (again - thank you for help, Sylwester). Everything but input seems to work.

• As for input: I used read-char, but it doesn't work the way I want it. For example ,D inputs "D". I would like to redo it so it stops evaluation at each , and waits for user input.

• Question: Is there an alternative to progn that does not return values (I want to just evaluate but not return)? For example (what-i-look-for (setf a 1) 1 2) sets a to 1 but does not return 2.

Answer 1

Without knowing too much about how you think its supposed to work you need to define tape, pointer and output as global variables, preferrably with *earmuffs* so that you can see they are globals.

(defparameter *tape* (make-array '(1) :adjustable t))

Then I noticed > extends the *tape* with a default element nil. Thus for every > you do you should set it to 0 if it's not true (every value is true except nil) It also seem to think that pointer is always at the end of the tape. When doing >>>++++<<< the element with 4 in it is long gone.

loop-body is a global variable. You should have used let here to not clobber package level variables. You use loopwrong. See examples in Loop for black belts. Eg.

(defun start-loop (stream ch)
 (declare (ignore ch))
 (let ((loop-body (read-delimited-list #\] stream t)))
 `(loop :until (zerop (aref *tape* *pointer*)) 
        :do ,@loop-body)))

Notice the declare there that tells Common Lisp to ignore ch not being used. The nesting is done automatically since read-deliited-list calls start-loop at a new [.

print-one-char doesn't add the char based on the ascii value but adds it as a number. Also usually it's common to print right away in BF so print-char might be better. You can print to a string input stream if you want to continue keeping it in memory until you press =.

read reads lisp data. Thus you would need to give it #\a instead of an a. Use read-char instead.

I guess you have enough to tacke at this point. Doing it with macros and reader-macros looked cool, but it is difficult to debug and extending since after the reader macros are added you have problems with code consisting those characters. Making one function for each operation except [ would simplify testing since you can test that and the macro would just expand to calling it.

(defun move-pointer-left ()
  (assert (> *pointer* 0) (*pointer*) "Tape pointer out of bounds: ~a" *pointer*) 
  (decf *pointer*))

(set-macro-character #\< (constantly '(move-pointer-left)))