Takahiro Horii
horii****@ike*****
2006年 2月 28日 (火) 16:40:30 JST
こんにちは。堀井です。
Gauche-0.8.6 の genstub に関してです。
define-cgeneric を使って、ジェネリック関数のセッターを設定しようとする
と、定義していない変数名が出てきます。(それ以前に変数名の typo でエラー
が出ますが、それは修正したものとして話を進めます。)
以下にスタブとそれから生成されたコードを示します。
;; foo.stub
(define-cgeneric foo "Foo")
(define-cgeneric bar "Bar"
(setter foo))
/* foo.c */
static SCM_DEFINE_GENERIC(Foo, NULL, NULL);
static SCM_DEFINE_GENERIC(Bar, NULL, NULL);
void Scm_Init_foo(ScmModule *module)
{
Scm_InitBuiltinGeneric(&Bar, "bar", module);
Scm_SetterSet(SCM_PROCEDURE(&Bar__STUB), SCM_PROCEDURE(&foo_foo__STUB), TRUE);
Scm_InitBuiltinGeneric(&Foo, "foo", module);
}
Scm_SetterSet() に、定義していない変数名があるので、このコードはコンパ
イルできません。
とりあえず、#define を使って、この問題を解決するパッチを作ってみました。
パッチ適用後は、foo.c は以下のようになります。
/* foo.c */
#define Bar__STUB Bar
#define foo_bar__STUB Bar
#define Foo__STUB Foo
#define foo_foo__STUB Foo
static SCM_DEFINE_GENERIC(Foo, NULL, NULL);
static SCM_DEFINE_GENERIC(Bar, NULL, NULL);
void Scm_Init_foo(ScmModule *module)
{
Scm_InitBuiltinGeneric(&Bar, "bar", module);
Scm_SetterSet(SCM_PROCEDURE(&Bar__STUB), SCM_PROCEDURE(&foo_foo__STUB), TRUE);
Scm_InitBuiltinGeneric(&Foo, "foo", module);
}
以下パッチです。
変数名、コメントの typo 等も含んでます。
--- genstub.orig 2006-02-28 16:21:41.753406652 +0900
+++ genstub 2006-02-28 16:21:45.718852430 +0900
@@ -511,7 +511,7 @@
;; Literal is used to embed Scheme value in C file.
;; Class <literal> is subclassed to each Scheme object types.
;; Besides the standard stub protocol, a subclass has to define
-;; value-getter-of that returns a C expression ot retrieve the
+;; value-getter-of that returns a C expression to retrieve the
;; Scheme value.
(define-class <literal> (<instance-pool-mixin>)
@@ -553,11 +553,11 @@
(f #`"static ScmObj ,(c-name-of self) = SCM_UNBOUND;"))
(define-method emit-initializer ((self <bignum-literal>))
(cgen-init (format " ~a = ~a(~a)"
- (c-name-of a)
- (if (positive? (value-of a))
+ (c-name-of self)
+ (if (positive? (value-of self))
"Scm_MakeIntegerFromUI"
"Scm_MakeInteger")
- (value-of a))))
+ (value-of self))))
;; boolean literals
(define-literal-binding <boolean> <boolean-literal>)
@@ -1206,13 +1206,18 @@
))
(define-method emit-definition ((self <cgeneric>))
- (unless (extern? self) (display "static "))
+ (unless (extern? self) (cgen-body "static "))
(f "SCM_DEFINE_GENERIC(~a, ~a, NULL);" (c-name-of self) (fallback-of self))
(cgen-body ""))
(define-method emit-initializer ((self <cgeneric>))
(cgen-init (format " Scm_InitBuiltinGeneric(&~a, ~s, module);"
(c-name-of self) (symbol->string (scheme-name-of self))))
+ ;; for setter
+ (cgen-define #`",(c-name-of self)__STUB" (c-name-of self))
+ (cgen-define (format "~a__STUB"
+ (get-c-name *file-prefix* (scheme-name-of self)))
+ (c-name-of self))
(next-method))
(define-form-parser define-cgeneric (scheme-name c-name . body)
@@ -1236,7 +1241,7 @@
(with-cpp-condition gf
(emit-definition gf))))
-(define-method process-setter ((gf <cgeneric>) setter)
+(define-method process-setter ((gf <cgeneric>) decl)
(cond
((symbol? (car decl))
(set! (setter-of gf) (car decl))
@@ -1581,7 +1586,7 @@
(cgen-body #`" ,(c-type-of class-type) obj = ,(unbox-expr class-type \"OBJARG\");")
(cond ((string? (getter-of slot)) (cgen-body (getter-of slot)))
((string? (c-spec-of slot))
- (f " return ~a;" (box-expr type c-spec-of slot)))
+ (f " return ~a;" (box-expr type (c-spec-of slot))))
(else
(f " return ~a;" (box-expr type #`"obj->,(c-name-of slot)"))))
(cgen-body "}")
--
Takahiro Horii <horii****@ike*****>