Skip to content

Instantly share code, notes, and snippets.

@koji-kojiro
Last active January 14, 2021 22:56
  • Star 2 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save koji-kojiro/c794e841b9729aaf9f126b211a10a8f7 to your computer and use it in GitHub Desktop.
brainfuck compiler written in Common Lisp (SBCL)
#!/usr/bin/sbcl --script
;;; brainfuck compiler written in Common Lisp (SBCL)
;;; author: TANI Kojiro
;;; usage: `sbcl --script brainfuck.lisp` or `chmod +x brainfuck.lisp; ./brainfuck.lisp`
(declaim ((simple-array (unsigned-byte 8) (*)) *memory*))
(defvar *memory* (make-array 30000 :element-type '(unsigned-byte 8)))
(defvar *pointer* 0)
(defvar *bf-readtable* (make-instance 'readtable))
(defun count-positive-and-negative-chars (positive-char negative-char stream char)
(let ((chars (loop :for char := (read-char stream nil)
:while (find char `(,positive-char ,negative-char)) :collect char
:finally (unread-char char stream))))
(- (count positive-char chars)
(count negative-char chars)
(if (char= char negative-char) 1 -1))))
(defun plus-minus-reader (stream char)
`(incf (aref *memory* *pointer*) ,(count-positive-and-negative-chars #\+ #\- stream char)))
(defun gt-lt-reader (stream char)
`(incf *pointer* ,(count-positive-and-negative-chars #\> #\< stream char)))
(defun comma-reader (stream char)
(declare (ignore stream char))
'(setf (aref *memory* *pointer*) (char-code (read-char *standard-input*))))
(defun dot-reader (stream char)
(declare (ignore stream char))
'(princ (code-char (aref *memory* *pointer*))))
(defun openparen-reader (stream char)
(declare (ignore char))
(let ((body (loop :for form := (read stream t)
:until (eql form ']) :collect form)))
`(loop :until (zerop (aref *memory* *pointer*))
:do (progn ,@body))))
(defun closeparen-reader (stream char)
(declare (ignore char))
'])
(defun newline-reader (stream char)
(declare (ignore stream char))
't)
(set-macro-character #\+ #'plus-minus-reader nil *bf-readtable*)
(set-macro-character #\- #'plus-minus-reader nil *bf-readtable*)
(set-macro-character #\> #'gt-lt-reader nil *bf-readtable*)
(set-macro-character #\< #'gt-lt-reader nil *bf-readtable*)
(set-macro-character #\, #'comma-reader nil *bf-readtable*)
(set-macro-character #\. #'dot-reader nil *bf-readtable*)
(set-macro-character #\[ #'openparen-reader nil *bf-readtable*)
(set-macro-character #\] #'closeparen-reader nil *bf-readtable*)
(set-macro-character #\newline #'newline-reader nil *bf-readtable*)
(set-macro-character #\; (get-macro-character #\;) nil *bf-readtable*)
(defmacro with-simple-handler (&body body)
`(handler-case
(let ((*error-output* (make-broadcast-stream))) ,@body)
(condition (c) (format t "~&~a~%" c))))
(defun execute-brainfuck (file)
(with-simple-handler
(let ((*readtable* *bf-readtable*))
(load file))))
(defun compile-brainfuck (input output)
(let ((toplevel-forms))
(with-open-file (stream input :direction :input)
(let ((*readtable* *bf-readtable*))
(setf toplevel-forms
`(with-simple-handler ,@(loop :for form := (read stream nil)
:while form :collect form)))))
(save-lisp-and-die output
:toplevel (lambda () (eval toplevel-forms))
:executable t
:purify t)))
(defun show-usage-and-exit ()
(format t "Usage: ~a~@[.~a~] input [-c|[-o output]]~%"
(pathname-name *load-truename*)
(pathname-type *load-truename*))
(exit))
(defun main ()
(let ((input (cadr *posix-argv*))
(output) (compile-p))
(let ((pos (position "-o" *posix-argv* :test #'string=)))
(setf output (if pos (nth (1+ pos) *posix-argv*) "a.out")))
(setf compile-p (find "-c" *posix-argv* :test #'string=))
(unless input (show-usage-and-exit))
(if compile-p
(compile-brainfuck input output)
(execute-brainfuck input))))
(main)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment