diff --git a/bf.lisp b/bf.lisp new file mode 100644 index 0000000..1225373 --- /dev/null +++ b/bf.lisp @@ -0,0 +1,46 @@ +(load "utils.lisp") +; i've done this before + +(deftype cell () '(mod 256)) + +; TODO: group ops +(defun comp-part (&optional (port *standard-input*)) + (begin + (loop with out + for c = (read-char port nil nil) + while (and c (not (eql c #\]))) + when (in c #\+ #\- #\> #\< #\. #\, #\[) + do (push + (ecase c + (#\+ '(inc)) + (#\- '(dec)) + (#\> '(minc)) + (#\< '(mdec)) + ; TODO: fix + (#\. '(put-byte)) + (#\, '(get-byte)) + (#\[ `(loop until (zerop cell) do (progn ,@(comp-part port))))) + out) + finally (return (nreverse out))))) + +(defun comp (&optional (port *standard-input*)) + `(begin + (declare (optimize (speed 3) (safety 0))) + (= mem (make-array '(65536) :element-type 'cell)) + (= mp 0) + (=sm cell (aref mem mp)) + + (=f inc (&optional (n 1)) (setf cell (mod (+ cell n) 256))) + (=f dec () (inc -1)) + + (=f minc (&optional (n 1)) (setf mp (mod (+ mp n) 65536))) + (=f mdec () (minc -1)) + + (=f get-byte () (setf cell (mod (char-code (read-char *standard-input* nil #\null)) 256))) + (=f put-byte () (write-char (code-char cell))) + + (=m bf-loop (&body body) + `(loop until (zerop cell) + do (progn ,@body))) + ,@(comp-part port) + t)) diff --git a/utils.lisp b/utils.lisp index ab0a37a..360458d 100644 --- a/utils.lisp +++ b/utils.lisp @@ -694,5 +694,13 @@ `(flet ((,name ,args (begin ,@body))) (begin ,@rest))) - (_ `(progn ,stmt (begin ,@rest))))) + ((structure ('=m name args . body)) + `(macrolet ((,name ,args (begin ,@body))) + (begin ,@rest))) + + ((structure ('=sm sym val)) + `(symbol-macrolet ((,sym ,val)) + (begin ,@rest))) + + (_ `(locally ,stmt (begin ,@rest))))) (_ nil)))