Conversation

Made a brainfuck->lambda "compiler" in 46 SLOC, 69 with lambda->C included.
Gonna embed this into the post just like last time(defun compile-thing (thing) (compile nil `(lambda () (declare (optimize (safety 0) (speed 3) (debug 0))) (let ((data (make-array (expt 2 16) :element-type '(unsigned-byte 8) :adjustable nil)) (pointer 0)) (macrolet ((ref () `(aref data pointer)) (p-arif (i) `(setf pointer (logand (1- (expt 2 16)) (,i pointer)))) (d-arif (i) `(setf (ref) (logand 255 (,i (ref)))))) (declare (type (simple-array (unsigned-byte 8) 1))) (tagbody ,@thing)))))) (defun make-the-list (thing) (let ((stack '(main)) (next-tag (gensym))) (loop for char across thing if (equalp char #\[) do (push (gensym) stack) and collect `(if (zerop (ref)) (go ,next-tag) (go ,(car stack))) and collect (car stack) else if (equalp char #\]) collect `(if (zerop (ref)) (go ,next-tag) (go ,(car stack))) and do (progn (pop stack) (push next-tag stack) (setf next-tag (gensym))) and collect (car stack) else collect (case char (#\> '(p-arif 1+)) (#\< '(p-arif 1-)) (#\+ '(d-arif 1+)) (#\- '(d-arif 1-)) (#\, '(setf (ref) (char-code (read-char)))) (#\. '(princ (code-char (ref)))))))) (defun compile-to-c (thing) (apply #'concatenate (append '(string) '("int i=0; char d[30000] = {};") (loop for op in thing collect (if (atom op) (concatenate 'string " " (string op) ": ") (case (car op) (incf "i++;") (decf "i--;") (setf "d[i]=getchar();") (princ "putchar(d[i]);") (d-arif (if (equalp (cadr op) '1+) "d[i]++;" "d[i]--;")) (if (concatenate 'string " if(d[i]==0) {goto " (string (cadr (caddr op))) ";} else {goto " (string (cadr (cadddr op))) ";}"))))))))