ネストしたquasiquoteの悪夢

S式 -> Cのトランスレータを書こうと前々から思っていじってはいるが、結局うまい方法を思いつけずに挫折ということを繰り返している。

今の考えはマクロ -> make-instance -> emitという流れにしようというもの。とりあえずマクロとオブジェクトの定義部分を書こうとして、自分でも理解しきれないネストしたquasiquoteを書いたのでネタとして載せておく。

myパッケージは自分の使うOn LispやANSI Common Lispその他から拝借した関数などをまとめたパッケージ。

(cl:defpackage :trans
  (:import-from :common-lisp &optional &rest &body &key))

(in-package :trans)

(cl:defun remove-lambda-keywords (lst)
  (cl:mapcar
   #'(cl:lambda (x)
       (cl:car (my:mklist x)))
   (cl:remove-if
    #'(cl:lambda (x) (cl:member x '(&body &optional &key &rest)))
    lst)))

(cl:defun make-accessor-sym (sym)
  (my:symb sym "-OF"))

(cl:defun make-keyword (sym)
  (cl:intern (my:mkstr sym) :keyword))

(cl:defun make-slot (arg)
  `(,arg :accessor ,(make-accessor-sym arg)
	 :initarg ,(make-keyword arg)
	 :initform cl:nil))

;;引数のデフォルト値はnil
(cl:defmacro define-c-class (name (&rest args))
  (cl:let ((args-symbols (remove-lambda-keywords args)))
  `(cl:progn
     (cl:defclass ,name ()
       ,(cl:mapcar #'make-slot args-symbols))
     (cl:defmacro ,name (,@args)
       `(cl:make-instance
	 ',',name
	 ,,@(cl:mapcan
	    #'(cl:lambda (arg)
		`(,(make-keyword arg)
		   (cl:if (cl:listp ,arg)
			   `(list ,@,arg)
			   ,arg)))
	    args-symbols))))))


(define-c-class if (test then &optional else))
(define-c-class block (&body body))
(define-c-class for (init test update &body body))

リーダマクロでlambdaを短縮する

Clojureでは無名関数を作るために用いるのは、lambdaでは無くfnという特殊式なため Common Lispより3文字短い。3文字程度なら良いのだけど、Clojureにはさらに無名関数のためのリーダマクロが用意されている。

;;この式が
#(list %1 %2)

;;こうなる(イメージ)
(fn [%1 %2] (list %1 %2))

Clojureに心引かれる箇所は色々あるけれど、このリーダマクロなら多少は自分で書いてみることができるのでは無いかと思ったので、試しに書いてみた。

展開されるようにした。また、引数は%nではなく$nで表現した。

(defun dollar-symbol-p (sym)
  (and (symbolp sym) (char= #\$ (char (symbol-name sym) 0))))

(defun dollar-symbol-index (sym)
  (and (dollar-symbol-p sym)
       (parse-integer
	(symbol-name sym)
	:start 1 :junk-allowed t)))

(defun short-lambda-reader (stream ch1 ch2)
  (declare (ignore ch1 ch2))
  (let* ((body  (read-delimited-list #\} stream t))
	 (dollars (remove-if-not #'dollar-symbol-p (my:flatten body)))
	 (rest-p (find "$R" dollars :test #'string= :key #'symbol-name))
	 (largest
	  (apply #'max (or (remove nil (mapcar #'dollar-symbol-index dollars))
			   '(0)))))
    (let ((args (loop :for i from 1 to largest
		   :collect (my:symb "$" i))))
      `(lambda ,(if rest-p
		    `(,@args &rest ,rest-p)
		    `(,@args))
	 ,@body))))

(defun enable-short-lambda-reader ()
  (set-macro-character #\} (get-macro-character #\)))
  (set-dispatch-macro-character #\# #\{ #'short-lambda-reader))

(enable-short-lambda-reader)

;;example
;;$1が第1引数を表す。$rは$nの中で最大のもの以降の残りの要素に束縛される。
(#{(list $1 $2 $4 $r)} 1 2 3 4 5 6)
=> (1 2 4 (5 6))

'#{(list $1 $2 $4 $r)}
=> (LAMBDA ($1 $2 $3 $4 &REST $R) (LIST $1 $2 $4 $R))

(remove-if #{(member $1 '(a b c))} '(a b c d e f g))
=>(D E F G)

(#{(mapcar #{(print $1) (mod $1 2)} (remove-if-not #'numberp $1))}
	    '(a b 1 2 3 4 f "hoge"))
1
2
3
4
=>(1 0 1 0)

うーん、結構見づらいような。 1つの式のみ書けるようにして、#{list $1}としたほうが見やすいかもしれない。