Guile C interface & GOOPS question

[Andreas Rottmann]

Hi!

I already posted this on -user, but got no replies, so I'm trying
again (with one more question), x-posting to -devel.

I'd like to create a closure from C, so I could have a C function
invoked in its environment and access its variables from within the C
function. I guess it works somehow by calling scm_closure(), but I
can't figure out its calling semantics (especially how its env
argument should look like). 

Another (GOOPSy) thing: I'm hacking up a C++ <-> GOOPS interface and
stumbled across a problem I can't resolve, even after digging around
in the sources for some hours. I want to invoke a C function as a
method of a generic function (the initialize goops gf, in this case). I
use this code (taken from the FAQ and adapated):

//--------------------------------------
// get initialize gf
SCM initialize = scm_apply(
          SCM_CDR(scm_intern0("module-variable")),
          SCM_LIST2(scm_module_goops,
                    guile_str2symbol("initialize")), SCM_EOL);
initialize = scm_variable_ref(initialize);

// add a C method
SCM constructor = scm_make_subr_opt("internal-constructor", scm_tc7_subr_3,
                                      (SCM (*)())&guile_call_constructor, 0);
SCM meth = scm_make(SCM_LIST5(scm_class_method,
                              scm_c_make_keyword("specializers"),
                              SCM_LIST2(sobj_, scm_class_top),
                              scm_c_make_keyword("procedure"),
                              constructor));
scm_add_method(initialize, meth);
//--------------------------------------

However, when I try to invoke the GF, I get this error:

ERROR: In procedure cadr in expression (source-formals src):
ERROR: Wrong type argument in position 1: #f

Backtrace: see PS.

The strange thing is, if I use lambda, instead of make_subr_opt, like this:

---------------
SCM constructor = scm_eval_0str("(lambda (next obj args) (display 
"foobar!"))");---------------

it works, and the lambda is invoked.

Can anybody help me out? I'm really stuck with this. :-(

Regards, Andy

PS:

The backtrace is (WARNING: long lines):

 0* [initialize #<foreign-object <MyObject> 403eec60> ()]
 1* [memoize-method! #<<generic> initialize (16)> (#<foreign-object <MyObject> 
403eec60> ()) (address@hidden args 3 #((no-method)) #<<generic> initialize 
(16)>)]
 2* (let ((applicable (# gf args))) (cond (applicable (let* # # res)) ((null? 
args) (lookup-create-cmethod no-applicable-method #)) (#t (set-cdr! args #) 
(set-car! args gf) (lookup-create-cmethod no-applicable-method args))))
 3  (cond (applicable (let* (# #) (set-cdr! # #) res)) ((null? args) 
(lookup-create-cmethod no-applicable-method (list gf #))) (#t (set-cdr! args 
(list #)) (set-car! args gf) (lookup-create-cmethod no-applicable-method args)))
 4  (let* ((new (list-copy exp)) (res (cond # # #))) (set-cdr! (cdr exp) (cddr 
new)) res)
 5* (cond ((method-cache-hashed? new) (method-cache-install! 
hashed-method-cache-insert! new ...)) ((passed-hash-threshold? new) 
(method-cache-install! hashed-method-cache-insert! (method-cache->hashed! new) 
...)) ...)
 6  [method-cache-install! #<procedure method-cache-insert! (exp entry)> 
(address@hidden args 3 ...) ...]
    ...
 7  (let* ((types (map class-of #)) (entry+cmethod (compute-entry-with-cmethod 
applicable types))) (insert! exp (car entry+cmethod)) (cdr entry+cmethod))
 8* [compute-entry-with-cmethod (#<<method> (<MyObject> <top>) 4042b738> 
#<<method> (<foreign-object> <top>) 403ff500> #<<method> (<object> <top>) 
403f3948>) (#<<class> <MyObject> 404223b0> #<<class> <null> 404012e8>)]
 9  (or (code-table-lookup (slot-ref (car methods) (quote code-table)) types) 
(let* ((method #) (place-holder #) (entry #)) (slot-set! (car methods) (quote 
code-table) (cons entry #)) (let (#) (set-car! place-holder #) (set-cdr! 
place-holder #)) (cons entry place-holder)))
10  (let* ((method (car methods)) (place-holder (list #f)) (entry (append types 
place-holder))) (slot-set! (car methods) (quote code-table) (cons entry 
(slot-ref # #))) (let ((cmethod #)) (set-car! place-holder (car cmethod)) 
(set-cdr! place-holder (cdr cmethod))) (cons entry place-holder))
11* (let ((cmethod (compile-method methods types))) (set-car! place-holder (car 
cmethod)) (set-cdr! place-holder (cdr cmethod)))
12* [compile-method (#<<method> (<MyObject> <top>) 4042b738> #<<method> 
(<foreign-object> <top>) 403ff500> #<<method> (<object> <top>) 403f3948>) 
(#<<class> <MyObject> 404223b0> #<<class> <null> 404012e8>)]
13  (let* ((proc (method-procedure #)) (src (procedure-source proc)) (formals 
(source-formals src)) (body (source-body src))) (if (next-method? body) (let 
(#) (set-cdr! vcell #) (quasiquote #)) (cons (procedure-environment proc) (cons 
formals #))))
14* [cadr #f]
-- 
Andreas Rottmann         | address@hidden        | address@hidden | 
address@hidden
http://www.8ung.at/rotty | GnuPG Key: http://www.8ung.at/rotty/gpg.asc
Fingerprint              | DFB4 4EB4 78A4 5EEE 6219  F228 F92F CFC5 01FD 5B62