gencomp 確認 (6)

俯瞰だ、と言いつつ gencomp をぱらぱら見たり scmlib.scm と scmlib.c を見比べてたりしたんですが、なんとなく手がかり足がかりになるホールドが極小レベル。
なにかないか、と言いつつさばりついたのが の定義なソレ。define-syntax とか define-class とか理解が微妙なので丁度良い?
中略で引用してみます。

;;================================================================
;; Compiler-specific literal handling definitions
;;       
(define-cgen-literal <cgen-scheme-code> <compiled-code>
  ((code-name   :init-keyword :code-name)
   (code-vector-c-name :init-keyword :code-vector-c-name)
   (literals    :init-keyword :literals)
   )
  (make (value)
;; 中略
   )
  (init (self)
;; 中略
   )
  (static (self) #t)
  )

define-cgen-literal は lib/gauche/cgen/literal.scm にて定義されてます。これ、全部引用するのはキツいので順に (?) 要点のみ。

(define-syntax define-cgen-literal
  (syntax-rules (make cexpr extern decl body init static)
    ;; loop for generating methods

これ以降、syntax-rules の引数で指定されているナニとマッチしたケイスのソレが記述されております。最初はマッチしない形 ("methods" というソレ指定) になっているので最初にマッチするのは以下 (のはず)。

    ;; Main entry
    ((define-cgen-literal class scheme-class slots . methods)
     (begin
       (define-class class (<cgen-literal>) slots)
       (define-cgen-literal "methods" class scheme-class . methods)))

Main entry ってコメントあるし大丈夫のはず。
最初に を継承したクラス定義な模様。上記の例だと

(define-class <cgen-scheme-code> (<cgen-literal>)
  ((code-name   :init-keyword :code-name)
   (code-vector-c-name :init-keyword :code-vector-c-name)
   (literals    :init-keyword :literals)
   ))

と置き換えられる模様。ちなみにこの の定義は以下なカンジに展開されるのでしょうか。

(begin
  (define-class <cgen-scheme-code> (<cgen-literal>)
    ((code-name   :init-keyword :code-name)
     (code-vector-c-name :init-keyword :code-vector-c-name)
     (literals    :init-keyword :literals)
     ))
  (begin
    (define-method cgen-make-literal ((value <cgen-scheme-code>)) . hoge)
    (begin
      (define-method cgen-emit-init ((self <cgen-scheme-code>)) . hoge)
      (begin
	(define-method cgen-literal-static? ((self <cgen-scheme-code>)) . hoge)
	#f))))

むむむ。cgen-make-literal って何だ、と言いつつ grep してみたら以下がナニ

;; method cgen-literal returns a <cgen-literal> node for the
;; literal value of given Scheme value.  It first scans the current
;; unit's toplevel nodes with the same value, and returns it if found.
;; Otherwise, it creates a new node and register it to the toplevel if
;; necessary.
;; The check of value's class is a bit of kludge.  We want to share
;; equal strings or vectors; but there may be some objects which defines
;; object-equal? that returns #t with different class's instances.

(define (cgen-literal value)
  (or (and-let* ((unit (cgen-current-unit)))
        (lookup-literal-value unit value))
      (cgen-make-literal value)))

ちょっとコメントきちんと読めてない。最後のナニは若干微妙な気がするのは気のせいなのかなぁ。とりあえず元気が続けば literal.scm の中身を精査なソレを投入予定。

ぬぬ

明日にナニなネタ。literal.scm のアタマにある以下のソレ。

;; NB: a small experiment to see how I feel this...
;;  [@ a b c d] => (ref (ref (ref a b) c) d)
;; In string interpolations I have to use ,(@ ...) instead of ,[@ ...], for
;; the previous versions of interpolation code doesn't like #`",[...]".
;; Ideally this should be a compiler-macro (we can't make it a macro,
;; for we want to say (set! [@ x'y] val).
(define @
  (getter-with-setter
   (case-lambda
     ((obj selector) (ref obj selector))
     ((obj selector . more) (apply @ (ref obj selector) more)))
   (case-lambda
     ((obj selector val) ((setter ref) obj selector val))
     ((obj selector selector2 . rest)
      (apply (setter ref) (ref obj selector) selector2 rest)))))
;; end experiment

結構 @ って多用されてます。getter-with-setter って? と言いつつ find|xargs grep してみたら src/scmlib.scm にて発見。なんか順番的に微妙? ながらも明日の材料がてら以下

;;;=======================================================
;;; srfi-17
;;;
(define (getter-with-setter get set)
  (let ((proc (lambda x (apply get x))))
    (set! (setter proc) set)
    proc))

case-lambda は lib/gauche/procedure.scm で定義?

;; case-lambda (srfi-16) ---------------------------------------

;; This is a temporary implementation.  There's a plan to replace it
;; for more efficient dispatching mechanism.  (But I'm not sure when).

(define-syntax case-lambda
  (syntax-rules ()
    ((case-lambda (arg . body) ...)
     (make-dispatcher (list (lambda arg . body) ...)))
    ((case-lambda . _)
     (syntax-error "malformed case-lambda" (case-lambda . _)))))

ええと、以降は明日 (を