parens language (in common lisp)

parens-lang.lisp

;;; -*- mode:lisp; package:parens-lang -*-

(defpackage parens-lang
  (:use #+:common-lisp :cl #+:xyzy :lisp))

(in-package :parens-lang)
(export '(parens parens2lisp parens2jsstr))

(defmacro $ (&rest fns)
  (reduce #'(lambda (a b) `(funcall ,a ,b)) fns))

(defmacro w/uniq (names &body body)
  `(let ,(mapcar #'(lambda (s) `(,s (make-symbol ,(symbol-name s))))
		 names)
     ,@body))


(defvar S (lambda (x) (lambda (y) (lambda (z) ($ x z ($ y z))))))
(defvar K (lambda (x) (lambda (y) x)))
(defvar U (lambda (x) ($ x S K)))

(macrolet
    ((expand (name base compose)
       (w/uniq (code r c a b)
	 `(defun ,name (,code)
	    (labels ((,r (,c)
		       (unless (listp ,c)
			 (error (make-condition 'type-error
						:datum ,c :expected-type 'list)))
		       (reduce #'(lambda (,a ,b) (,compose ,a (,r ,b))) ,c
			       :initial-value ,base)))
	      (,r ,code))))))
  (expand parens U $)
  (expand parens2lisp 'U (lambda (x y) (list '$ x y)))
  (expand parens2jsstr "U" (lambda (x y) (format nil "~A(~A)" x y))))