2010年5月19日水曜日

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

0 件のコメント:

コメントを投稿