Nock Nock (Part 1)
Here is a very simple Common Lisp compiler [1] of Nock, C. Yarvin's elegant systems language.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; *************************** define reader macros ***************************
(eval-when (:load-toplevel :execute)
(defmacro char-macro (ch &body body)
`(set-macro-character ,ch #'(lambda (stream char)
(declare (ignore char)) ,@body)))
; define syntax of N-expression
(char-macro #\[
(reduce #'(lambda (&rest exp)
(if (functionp (car exp)) exp `(list ,@exp)))
(read-delimited-list #\] stream t)
:from-end t))
(set-syntax-from-char #\] #\))
(defun div (a b) (/ a b)) ; we will want to preserve
(defun mul (a b) (* a b)) ; and use '/', '*', and '='
(defun es (a b) (= a b)) ; after they are clobbered.
(defvar %nk-ops% '()) ; table of Nock operator names
(macrolet ((opchar (ch name) ; mutilate the Lisp reader into a Nock reader
`(progn
(push (cons ',name ,ch) %nk-ops%)
(char-macro ,(character ch)
(list ',name (read stream t nil t))))))
(opchar "?" QMARK) (opchar "^" CARROT) (opchar "=" EQSIG)
(opchar "/" FSLASH) (opchar "*" NOCK))
)
; *************************** define reader macros ***************************
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun nkcar (E) (if (listp E) (car E) E))
(defun nkcdr (E) (if (listp E) (cadr E) nil))
(defun cellp (exp) (and (listp exp) (not (symbolp (car exp)))))
(defun nk-print (E)
(cond ((null E) "")
((atom E) (write-to-string E))
((listp E)
(let ((hd (car E)))
(if (symbolp hd)
(concatenate 'string
(cdr (assoc hd %nk-ops%)) (nk-print (cadr E)))
(concatenate 'string
"[" (nk-print hd) " " (nk-print (cadr E)) "]"))))))
(defmacro mk-op (name &body body)
`(defun ,name (args)
(let ((hd (nkcar args))
(tl (nkcdr args))
(same (list ',name args)))
,@body)))
(mk-op QMARK (declare (ignore hd same)) (if (null tl) 1 0))
(mk-op CARROT (if (and (null tl) (numberp hd)) (1+ hd) same))
(mk-op EQSIG (if (and (atom hd) (atom tl)) (if (eq hd tl) 0 1) same))
(mk-op FSLASH
(if (null tl)
same
(cond
((eq hd 1) tl)
((and (eq hd 2) (cellp tl)) (car tl))
((and (eq hd 3) (cellp tl)) (cadr tl))
((and (numberp hd) (> hd 3))
(if (evenp hd)
/[2 /[(div hd 2) tl]]
/[3 /[(div (1- hd) 2) tl]]))
(t same))))
(mk-op NOCK
(if (cellp tl)
(let ((x (car tl))
(b (cadr tl)))
(if (cellp x)
[*[hd x] *[hd b]]
(case x
(0 /[b hd])
(1 b)
(2 (if (cellp (nkcdr b))
*[hd 3 [0 1] 3 [1 (caadr b) (cadadr b)]
[1 0] 3 [1 2 3] [1 0] 5 5 (car b)]
same))
(3 **[hd b])
(4 ?*[hd b])
(5 ^*[hd b])
(6 =*[hd b])
(t same))))
same))
(defun nockl ()
(loop
(format t "~&NOCK> ")
(finish-output nil)
(let ((form (read)))
(if (eq form :q) (quit))
(write-string (nk-print (eval form)))
)))
(defun nock-repl ()
(format t "~&Type any Nock expression, or :q to exit.~%~%")
(nockl))
(nock-repl) ; enter the REPL.
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Not quite one page, but rather small and extensible: adding "jets" (see Yarvin's article) and other optimizations will be trivial.
Next: memoization and pretty-printing.
To be continued.
It is worth noting that nothing like the above could have been written in Clojure, for it lacks user-defined reader macros.
[1] This is a "threaded" native-code compiler if and only if your Lisp system is also such a compiler - for example, SBCL. Otherwise, it is an interpreter.
Is line 59 correct? The rule
=[a a] => 0
lead me to thinka
was any noun. In that case, maybe(mk-op EQSIG (if (null tl) same (if (equal hd tl) 0 1)))
would be more appropiate?Neat link, by the way.
Slap a license on it. I recommend the Crowley Thelemic License for maximum simplicity, Open Works License for maximum "serious license" permissiveness, MIT/X11 License for maximum popularity, TESLA for maximum patent permissiveness, or Unlicense for maximum "don't bother me with licensing". I seem to recall SBCL is public domain, so maybe Unlicense is best in keeping with the conventions of what you apparently chose as the implementation Lisp.
[...] Here was my own Nock. [...]