ネストした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))