brainf*ck compiler

bfc.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#| <Put a one-line description here>
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  ;;#+quicklisp (ql:quickload '() :silent t)
  )

(defpackage :ros.script.bfc.3707264787
  (:use :cl))
(in-package :ros.script.bfc.3707264787)

(defun parse (stream)
  (labels ((parse-1 (ir)
         (case (read-char stream nil t)
           ((#\Newline #\Space #\Tab) (parse-1 ir))
           (#\> (parse-1 (cons '(:decrement (:pointer)) ir)))
           (#\< (parse-1 (cons '(:increment (:pointer)) ir)))
           (#\. (parse-1 (cons '(:print (:value)) ir)))
           (#\+ (parse-1 (cons '(:increment (:value)) ir)))
           (#\- (parse-1 (cons '(:decrement (:value)) ir)))
           (#\, (parse-1 (cons '(:read (:value)) ir)))
           (#\[ (parse-1 (cons `(:loop ,@(parse-1 nil)) ir)))
           (#\] (reverse ir))
           (t   (reverse ir)))))
    (parse-1 nil)))

(defun translate (ir)
  (labels ((translate-1 (ir)
         (loop :for op :in ir :collect
        (case (car op)
          (:increment `(incf ,@(translate-1 (cdr op))))
          (:decrement `(incf ,@(translate-1 (cdr op)) -1))
          (:pointer 'p)
          (:value '(svref v p))
          (:read `(setf ,@(translate-1 (cdr op)) (read-char)))
          (:print `(princ (code-char ,@(translate-1 (cdr op)))))
          (:loop `(do () ((zerop (svref v p)))
                ,@(translate-1 (cdr op))))))))
    `(defun main()
       (let ((v (make-array 1024)) (p 512))
     ,@(translate-1 ir)))))

(defun main (&rest argv)
  (let* ((input-file (first argv))
     (output-file (make-pathname :name (pathname-name input-file) :type "l"))
     (executable-file (pathname-name input-file)))
    (with-open-file (input input-file :direction :input)
      (with-open-file (output output-file :direction :output :if-exists :supersede)
    (print (translate (parse input)) output)
    (print `(sb-ext:save-lisp-and-die ,executable-file :toplevel #'main :executable t) output)))

    (load output-file)))
;;; vim: set ft=lisp lisp: