Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Lisptran source code
(defun multiple (a b)
"Is A a multiple of B?"
(= (mod a b) 0))
(defun next-fraction (n fractions)
"Returns the next value of F in the Fractran program."
(find-if (lambda (f)
(integerp (* n f)))
fractions))
(defun print-fractran-alphabet (n chars)
"After moving to state N, print all of the necessary characters."
(loop for (char . number) in chars
when (multiple n number)
do (princ char)))
(defun run-fractran (fractions alphabet &optional (n 2))
"Run the given Fractran program. ALPHABET is an alist of characters to numbers
representing the alphabet."
(let ((f (next-fraction n fractions)))
(if (null f)
nil
(let ((next (* n f)))
(print-fractran-alphabet next alphabet)
(run-fractran fractions alphabet next)))))
(defun prime (n)
"Is N a prime number?"
(loop for i from 2 to (isqrt n)
never (multiple n i)))
(defparameter *next-new-prime* nil)
(defun new-prime ()
"Returns a new prime we haven't used yet."
(prog1 *next-new-prime*
(setf *next-new-prime*
(loop for i from (+ *next-new-prime* 1)
if (prime i)
return i))))
(defparameter *cur-inst-prime* nil)
(defparameter *next-inst-prime* nil)
(defun advance ()
(setf *cur-inst-prime* *next-inst-prime*
*next-inst-prime* (new-prime)))
(defparameter *lisptran-labels* nil)
(defun prime-for-label (label)
(or (gethash label *lisptran-labels*)
(setf (gethash label *lisptran-labels*)
(new-prime))))
(defparameter *lisptran-macros* (make-hash-table))
(defmacro deftran (name args &body body)
"Define a Lisptran macro."
`(setf (gethash ',name *lisptran-macros*)
(lambda ,args ,@body)))
(defparameter *lisptran-vars* nil)
(defun prime-for-var (var)
(or (gethash var *lisptran-vars*)
(setf (gethash var *lisptran-vars*)
(new-prime))))
(defun assemble (insts)
"Compile the given Lisptran program into Fractran. Returns two values. the
first is the Fractran program and the second is the alphabet of the program."
(let* ((*next-new-prime* 2)
(*cur-inst-prime* (new-prime))
(*next-inst-prime* (new-prime))
(*lisptran-labels* (make-hash-table))
(*lisptran-vars* (make-hash-table)))
(values (assemble-helper insts)
(alphabet *lisptran-vars*))))
(defun alphabet (vars)
"Given a hash-table of the Lisptran variables to primes, returns an alist
representing the alphabet."
(loop for var being the hash-keys in vars
using (hash-value prime)
if (characterp var)
collect (cons var prime)))
(defun assemble-helper (insts)
(if (null insts)
'()
(let ((inst (car insts))
(rest (cdr insts)))
(cond
;; If it's a number, we just add it to the Fractran program and
;; compile the rest of the Lisptran program
((numberp inst)
(cons inst (assemble-helper rest)))
;; If it's a symbol, we divide the prime for the next instruction by
;; the prime for the label and continue compiling the Lisptran program
((symbolp inst)
(cons (/ *cur-inst-prime* (prime-for-label inst))
(assemble-helper rest)))
;; Otherwise it's a macro. We look up the function for the macro call
;; it on the rest of the instruction. We then append all of the
;; instructions returned by it to the rest of the program and compile
;; that.
(:else
(let ((macrofn (gethash (car inst)
*lisptran-macros*)))
(assemble-helper (append (apply macrofn
(cdr inst))
rest))))))))
(defun run-lisptran (insts)
"Run the given Lisptran program."
(multiple-value-call #'run-fractran (assemble insts)))
(deftran addi (x y)
(prog1 (list (/ (* *next-inst-prime*
(expt (prime-for-var x) y))
*cur-inst-prime*))
(advance)))
(deftran subi (x y) `((addi ,x ,(- y))))
(deftran >=i (var val label)
(prog1 (let ((restore (new-prime)))
(list (/ restore
(expt (prime-for-var var) val)
*cur-inst-prime*)
(/ (* (prime-for-label label)
(expt (prime-for-var var) val))
restore)
(/ *next-inst-prime* *cur-inst-prime*)))
(advance)))
(deftran goto (label) `((>=i ,(gensym) 0 ,label)))
(deftran <=i (var val label)
(let ((skip (gensym)))
`((>=i ,var ,(+ val 1) ,skip)
(goto ,label)
,skip)))
(deftran print-char (char)
`((addi ,char 1)
(subi ,char 1)))
(deftran print-string (str)
(loop for char across str
collect `(print-char ,char) into result
finally (return `(,@result (print-char #\newline)))))
(deftran print-digit (var)
(loop with gend = (gensym)
for i from 0 to 9
for gprint = (gensym)
for gskip = (gensym)
append `((<=i ,var ,i ,gprint)
(goto ,gskip)
,gprint
(print-char ,(digit-char i))
(goto ,gend)
,gskip)
into result
finally (return `(,@result ,gend))))
(deftran while (test &rest body)
(let ((gstart (gensym))
(gend (gensym)))
`((goto ,gend)
,gstart
,@body
,gend
(,@test ,gstart))))
(deftran zero (var)
`((while (>=i ,var 1)
(subi ,var 1))))
(deftran move (to from)
(let ((gtemp (gensym)))
`((zero ,to)
(while (>=i ,from 1)
(addi ,gtemp 1)
(subi ,from 1))
(while (>=i ,gtemp 1)
(addi ,to 1)
(addi ,from 1)
(subi ,gtemp 1)))))
(deftran modi (var val)
`((while (>=i ,var ,val)
(subi ,var ,val))))
(deftran divi (var val)
(let ((gresult (gensym)))
`((zero ,gresult)
(while (>=i ,var ,val)
(subi ,var ,val)
(addi ,gresult 1))
(move ,var ,gresult))))
(deftran print-number (var)
(let ((gtemp (gensym))
(gskip (gensym)))
`((move ,gtemp ,var)
(divi ,gtemp 10)
(<=i ,gtemp 0 ,gskip)
(print-digit ,gtemp)
,gskip
(move ,gtemp ,var)
(modi ,gtemp 10)
(print-digit ,gtemp)
(print-char #\newline))))
((move x 1)
(while (<=i x 100)
(move rem x)
(modi rem 15)
(<=i rem 0 fizzbuzz)
(move rem x)
(modi rem 3)
(<=i rem 0 fizz)
(move rem x)
(modi rem 5)
(<=i rem 0 buzz)
(print-number x)
(goto end)
fizzbuzz
(print-string "fizzbuzz")
(goto end)
fizz
(print-string "fizz")
(goto end)
buzz
(print-string "buzz")
(goto end)
end
(addi x 1)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment