inline #6 一旦まとめ

xyzzy-lisp
  • lisp/evalmacs.l::defun を変更
    • 関数定義の lambda expression を（とりあえず symbol-plist に）保存
    • # defun の定義が2つあるので注意
  • どっかで function-lambda-expression を定義
  • どっかで expand-inline を定義
  • lisp package から inline を export しておく
    • compile.l で inline という symbol を使ってて、inline を export した file を compile するのに compile.l を読み込むのでそこで衝突するが、export した状態で compile.l を読み込んでから compile しなおせばだいじょぶ。
  • proclaim と declaim を変更（まだやってない
    • inline 指定された関数の compiler::optimize-form property に expand-inline をセット
  • lisp/compile.l::compile-form を変更
    • optimize-form した後、必要なら special-form の方に投げる

/lisp/ 以下のファイルを変更しちゃう感じなので、自分トコで動かしてる分にはいいんだけど、公開するとかなるとどうすっかなー、と思案中。

以下作りかけのコード

;;; http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/fun_function-_a-expression.html
(defun function-lambda-expression (fn)
  "Returns information about function as follows:
 a) function defining lambda-expression, or nil
 b) non-nil if function has some non-null lexical environment.
 c) name of function"
  (labels ((closure-p (def)
             (or (si:closure-variable def)
                 (si:closure-function def)
                 (si:closure-frame def))))
    (if (symbolp fn)
        (values (get fn 'lisp::function-definition)
                (closure-p (symbol-function fn))
                fn)
      (values (unless (compiled-function-p fn)
                (si:closure-body fn))
              (closure-p fn)
              nil))))

;; TODO:
;; - supplied-p-parameter for &optional/&key
;; - &aux
;; - ((:key var) default) in &key parameters
(defun expand-inline (form)
  (let ((fn (car form))
        (*vals (cdr form)))
    (multiple-value-bind (*vars body)
        (multiple-value-bind (lambda-expr closure-p)
            (function-lambda-expression fn)
          (if (or (null lambda-expr)
                  closure-p)
              (return-from expand-inline)
            (values (cadr lambda-expr) (cddr lambda-expr))))
      (let ((vars *vars)
            (vals *vals)
            var
            (state :required)
            (allowed-llks '(&optional &rest &key &aux))
            (pri-binds nil)
            rest-var
            (key-binds nil))
        (macrolet ((!invalid () '(error 'invalid-lambda-list :datum *vars))
                   (!few-args () '(error 'too-few-arguments :datum form))
                   (var/default ()
                     `(if (symbolp var) var
                        (values (car var) (cdr var))))
                   (pop? (list &optional error)
                     `(or (pop ,list) ,(when error `(,error)))))
          (while (setq var (pop vars))
            (if (member var lambda-list-keywords)
                (let ((left (member var allowed-llks)))
                  (unless left (!invalid))
                  (setf state        var
                        allowed-llks (cdr left)))
              (case state
                (:required
                 (push `(,var ,(pop? vals !few-args))
                       pri-binds))
                (&optional
                 (multiple-value-bind (var default)
                     (var/default)
                   (push `(,var ,(or (pop vals) default))
                         pri-binds)))
                (&rest
                 (setq rest-var (pop? vars !invalid))
                 (when (not (member (car vars) allowed-llks))
                   (!invalid)))
                (&key
                 (unless rest-var
                   (setq rest-var '#:rest))
                 (multiple-value-bind (var default)
                     (var/default)
                   (push `(,var (or (getf ,rest-var ,(keyword var))
                                    ,default))
                         key-binds)))
                (t (error "unkown state: ~S" state)))))
          `(let (,@(nreverse pri-binds)
                 ,@(when rest-var `((,rest-var (list ,@vals)))))
             ,@(if (and rest-var key-binds)
                   `((let ,(nreverse key-binds) ,@body))
                 body)))))))