Skip to content

Instantly share code, notes, and snippets.

@ehaliewicz

ehaliewicz/bf.lisp

Created July 30, 2018 17:37
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save ehaliewicz/25e75035705f267f9daa5bd875b7385f to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save ehaliewicz/25e75035705f267f9daa5bd875b7385f to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. ehaliewicz created this gist Jul 30, 2018.
    35 changes: 35 additions & 0 deletions bf.lisp
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,35 @@
    (defun compile-bf (program)
    (let ((loop-stack (list)))
    (let ((translated (loop for char across program appending
    (case char
    (#\> '((incf pointer)))
    (#\< '((decf pointer)))
    (#\+ '((incf (aref memory (wrap-pointer pointer)))))
    (#\- '((decf (aref memory (wrap-pointer pointer)))))
    (#\. '((format t "~a" (code-char (aref memory (wrap-pointer pointer))))))
    (#\, '((setf (aref memory (wrap-pointer pointer)) (char-code (read-char)))))
    (#\[ (let ((start-lbl (gensym "start")) ;; generate labels for jumping
    (end-lbl (gensym "end")))

    ;; save them on a stack
    (push (cons start-lbl end-lbl)
    loop-stack)
    ;; generate loop header code
    `((if (zerop (aref memory (wrap-pointer pointer)))
    (go ,end-lbl))
    ,start-lbl)))

    (#\] (let ((labels (pop loop-stack))) ;; pop labels off stack, causes error if stack is empty as a result of unbalanced brackets
    (destructuring-bind (start-lbl . end-lbl) labels
    ;; generate loop footer code
    `((if (plusp (aref memory (wrap-pointer pointer)))
    (go ,start-lbl))
    ,end-lbl))))))))

    ;; run lisp compiler on generated lisp code
    (compile nil `(lambda () (let ((memory (make-array 30000 :initial-element 0))
    (pointer 0))
    (labels ((wrap-pointer (ptr)
    (mod ptr 30000)))
    (tagbody
    ,@translated))))))))