brainfuck interpreter 2014-02-15

brainfuck-interpreter.lisp

;; brainfuck interpreter 2014-02-15

(defun run (sorce)
  (let ((tape (make-array '(10) :initial-element 0))
        (i 0)
        (ptr 0))
    (while (< i (length sorce))
       (case (elt sorce i)
         (#\> (incf ptr) (incf i))
         (#\< (decf ptr) (incf i))
         (#\+ (incf (elt tape ptr)) (incf i))
         (#\- (decf (elt tape ptr)) (incf i))
         (#\. (format t "~a" (code-char (elt tape ptr))) (incf i))
         (#\, (setf (elt tape ptr) (read)) (incf i))
         (#\[ (if (not (= 0 (elt tape ptr)))
                  (incf i)
                  (setf i (1+ (position-coparen sorce i)))))
         (#\] (if (not (= 0 (elt tape ptr)))
                  (setf i (1+ (position-coparen sorce i)))
                  (incf i)))
         (otherwise (incf i))))
    (format t "~%tape: ")
    (dolist (x (coerce tape 'list))
      (format t "~a " x))
    ))

(defun position-coparen (sorce i)
  (if (eq (elt sorce i) #\[)
      (position-close-paren sorce (1+ i))
      (position-open-paren sorce  (1- i))))

(defun position-open-paren (sorce i &optional (depth 0))
  (if (< i 0)
      nil
      (case (elt sorce i)
        (#\[ (if (= depth 0)
                 i
                 (position-open-paren sorce (1- i) (1- depth))))
        (#\] (position-open-paren sorce (1- i) (1+ depth)))
        (otherwise (position-open-paren sorce (1- i) depth)))))

(defun position-close-paren (sorce i &optional (depth 0))
  (if (<= (length sorce) i)
      nil
      (case (elt sorce i)
        (#\] (if (= depth 0)
                 i
                 (position-close-paren sorce (1+ i) (1- depth))))
        (#\[ (position-close-paren sorce (1+ i) (1+ depth)))
        (otherwise (position-close-paren sorce (1+ i) depth)))))


;Hello, world!
(run "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.
 ------------.<++++++++.--------.+++.------.--------.>+.")
;=>Hello, world!
;  tape: 0 72 100 33 0 0 0 0 0 0


;1+2
(run "+>++><<
>[-<+>]<
++++++++++++++++++++++++++++++++++++++++++++++++.")
;=>3
;  tape: 51 0 0 0 0 0 0 0 0 0 NIL


;4*2
(run 
 "++++>++><<
[-
  >[->>+<<]
  >>[-<+<+>>]
  <<<
]>>
++++++++++++++++++++++++++++++++++++++++++++++++.")
;=>8
;  tape: 0 2 56 0 0 0 0 0 0 0

(run
"[]++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>---.
+++++++++++++++++++.-.++.-------.---------.+++++++++++++++.
-.++.>++.<<-------.>---.-------------.----.")