Skip to content

Instantly share code, notes, and snippets.

@burtonsamograd
Created October 9, 2015 02:48
Show Gist options
  • Save burtonsamograd/29103c2dfaa67f4fd344 to your computer and use it in GitHub Desktop.
Save burtonsamograd/29103c2dfaa67f4fd344 to your computer and use it in GitHub Desktop.
A Nock Interpreter and Compiler in Common Lisp #Urbit
;; A nock interpreter
(defun tar (a f)
(labels ((fas (b a)
(declare (integer b))
(cond
((= b 1) a)
((= b 2) (car a))
((= b 3) (cdr a))
((evenp b) (car (fas (/ b 2) a)))
((oddp b) (cdr (fas (/ (1- (the integer b)) 2) a))))))
(if (consp (car f))
(cons
(tar a (car f))
(tar a (cdr f)))
(case (car f)
(0 (let ((b (cdr f)))
(fas b a)))
(1 (cdr f))
(2 (let ((b (cadr f))
(c (cddr f)))
(let ((x (tar a b))
(y (tar a c)))
(tar x y))))
(3 (let ((b (cdr f)))
(let ((x (tar a b)))
(if (consp x) 0 1))))
(4 (let ((b (cdr f)))
(let ((x (tar a b)))
(1+ (the integer x)))))
(5 (let ((b (cdr f)))
(let ((x (tar a b)))
(if (= (the integer (car x)) (the integer (cdr x))) 0 1))))
(6 (let ((b (cadr f))
(c (caddr f))
(d (cdddr f)))
(tar a `(2 (0 . 1) 2 (1 ,c . ,d) (1 . 0) 2
(1 2 . 3) (1 . 0) 4 4 . ,b))))
(7 (let ((b (cadr f))
(c (cddr f)))
(tar a `(2 ,b 1 . ,c))))
(8 (let ((b (cadr f))
(c (cddr f)))
(tar a `(7 ((7 (0 . 1) . ,b) 0 . 1) . ,c))))
(9 (let ((b (cadr f))
(c (cddr f)))
(tar a `(7 ,c 2 (0 . 1) 0 . ,b))))
))))
;; A nock compiler
(defun dao (f)
(declare (inline cons car cdr 1+))
(labels
((fas (b)
(declare (integer b))
(cond
((= b 1) 'a)
((= b 2) '(car a))
((= b 3) '(cdr a))
((evenp b) `(car ,(fas (/ b 2))))
((oddp b)
`(cdr ,(fas (/ (1- b) 2)))))))
(declare (inline fas))
(if (or (integerp f)
(symbolp f))
f
(if (consp (car f))
(let ((m (dao (car f)))
(n (dao (cdr f))))
`(cons ,m ,n))
(case (car f)
(0 (fas (cdr f)))
(1 (if (or (integerp (cdr f))
(symbolp (cdr f)))
(cdr f)
`',(cdr f)))
(2 (let ((bc (dao (cadr f)))
(d (dao (cddr f))))
(if (eq (car d) 'quote)
(let ((x (dao (cadr d))))
(if (or (eq bc 'a)
(integerp x))
x
`(let ((a ,bc))
,x)))
`(funcall (the function (phi ,d a)) ,bc))))
(3 `(if (consp ,(dao (cdr f))) 0 1))
(4 `(1+ (the integer ,(dao (cdr f)))))
(5 (destructuring-bind (m . n) (cdr f)
`(if (= ,(dao m) ,(dao n)) 0 1)))
(6 (let ((b (dao (cadr f)))
(c (dao (caddr f)))
(d (dao (cdddr f))))
`(if (= (the integer ,b) 0)
,c ,d)))
(7 (let ((b (dao (cadr f)))
(c (dao (cddr f))))
`(flet ((f (a) ,b)
(g (a) ,c))
(declare (inline f g))
(g (f a)))))
(8 (let ((b (dao (cadr f)))
(c (dao (cddr f))))
`(let ((a (cons ,b a)))
,c)))
(9
(let ((b (dao (cadr f)))
(c (dao (cddr f))))
`(flet ((f (a) ,c))
(declare (inline f))
(let ((x (f a)))
(funcall (the function
(phi (let ((a x))
,(fas b)))) x))))))
))))
;; A nock compiler driver
(defparameter cache (make-hash-table :test #'equal))
(defun phi (f &optional a)
(let ((compiled (gethash f cache)))
(if compiled
compiled
(let ((code `(lambda (a)
(declare (optimize (speed 3) (safety 0)))
,(dao f))))
(print code)
(setf (gethash f cache) (compile nil code))))))
#|
;; Running (dec 100.000.000)...
CL-USER> (time (tar 0 '(8 (8 (1 . 0) 8 (1 . 0) (1 6 (5 (4 0 . 14) 0 . 6) (0 . 14) 9 2 (0 . 2) (0 . 6) (4 0 . 14) 0 . 15) 0 . 1) 9 2 (0 . 4) (7 (0 . 3) 1 . 100000000) 0 . 11)))
Evaluation took:
154.804 seconds of real time
154.191088 seconds of total run time (151.147045 user, 3.044043 system)
[ Run times consist of 4.769 seconds GC time, and 149.423 seconds non-GC time. ]
99.60% CPU
433,556,434,319 processor cycles
195,199,995,456 bytes consed
99999999
CL-USER> (time (funcall (phi '(8 (8 (1 . 0) 8 (1 . 0) (1 6 (5 (4 0 . 14) 0 . 6) (0 . 14) 9 2 (0 . 2) (0 . 6) (4 0 . 14) 0 . 15) 0 . 1) 9 2 (0 . 4) (7 (0 . 3) 1 . 100000000) 0 . 11)) 0))
Evaluation took:
2.575 seconds of real time
2.563883 seconds of total run time (2.488210 user, 0.075673 system)
[ Run times consist of 0.093 seconds GC time, and 2.471 seconds non-GC time. ]
99.57% CPU
7,212,489,149 processor cycles
4,800,019,808 bytes consed
99999999
|#
@burtonsamograd
Copy link
Author

This was my first "code compiler" I managed to write. First I wrote the interpreter (tar), then I added backticks and massaged it a bit to get the compiler (dao) and then wrote the compiler driver (phi). Was impressed with the speedup (154 seconds vs 2.5 seconds) with such little work and skill required to write it. Showed it to Curtis Yarvin, but didn't expect him to rewrite Urbit in Common Lisp.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment