mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-15 18:20:42 +02:00
add formals',
body', and `compile-env' slots to <method>
* ice-9/boot-9.scm (compile-time-environment): Return #f instead of erroring under the interpreter, a bit more sane. * libguile/goops.c (create_standard_classes): * libguile/goops.h (scm_si_formals, scm_si_body, scm_si_compile_env): * oop/goops.scm (method, initialize): Add `formals', `body', and `compile-env' slots to <method>.
This commit is contained in:
parent
ae9ce4b786
commit
21497600d2
4 changed files with 20 additions and 6 deletions
|
@ -126,8 +126,9 @@
|
|||
(define (compile-time-environment)
|
||||
"A special function known to the compiler that, when compiled, will
|
||||
return a representation of the lexical environment in place at compile
|
||||
time. Useful for supporting some forms of dynamic compilation."
|
||||
(error "compile-time-environment and the interpreter do not mix"))
|
||||
time. Useful for supporting some forms of dynamic compilation. Returns
|
||||
#f if called from the interpreter."
|
||||
#f)
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -2420,10 +2420,14 @@ static void
|
|||
create_standard_classes (void)
|
||||
{
|
||||
SCM slots;
|
||||
SCM method_slots = scm_list_4 (scm_from_locale_symbol ("generic-function"),
|
||||
SCM method_slots = scm_list_n (scm_from_locale_symbol ("generic-function"),
|
||||
scm_from_locale_symbol ("specializers"),
|
||||
sym_procedure,
|
||||
scm_from_locale_symbol ("code-table"));
|
||||
scm_from_locale_symbol ("code-table"),
|
||||
scm_from_locale_symbol ("formals"),
|
||||
scm_from_locale_symbol ("body"),
|
||||
scm_from_locale_symbol ("compile-env"),
|
||||
SCM_UNDEFINED);
|
||||
SCM amethod_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("slot-definition"),
|
||||
k_init_keyword,
|
||||
k_slot_definition));
|
||||
|
|
|
@ -151,9 +151,11 @@ typedef struct scm_t_method {
|
|||
|
||||
#define scm_si_generic_function 0 /* offset of gf slot in a <method> */
|
||||
#define scm_si_specializers 1 /* offset of spec. slot in a <method> */
|
||||
|
||||
#define scm_si_procedure 2 /* offset of proc. slot in a <method> */
|
||||
#define scm_si_code_table 3 /* offset of code. slot in a <method> */
|
||||
#define scm_si_formals 4 /* offset of form. slot in a <method> */
|
||||
#define scm_si_body 5 /* offset of body slot in a <method> */
|
||||
#define scm_si_compile_env 6 /* offset of comp. slot in a <method> */
|
||||
|
||||
/* C interface */
|
||||
SCM_API SCM scm_class_boolean;
|
||||
|
|
|
@ -484,6 +484,9 @@
|
|||
ls))))
|
||||
`(make <method>
|
||||
#:specializers (cons* ,@(specializers args))
|
||||
#:formals ',(formals args)
|
||||
#:body ',body
|
||||
#:compile-env (compile-time-environment)
|
||||
#:procedure (lambda ,(formals args)
|
||||
,@(if (null? body)
|
||||
(list *unspecified*)
|
||||
|
@ -1427,7 +1430,11 @@
|
|||
(slot-set! method 'specializers (get-keyword #:specializers initargs '()))
|
||||
(slot-set! method 'procedure
|
||||
(get-keyword #:procedure initargs dummy-procedure))
|
||||
(slot-set! method 'code-table '()))
|
||||
(slot-set! method 'code-table '())
|
||||
(slot-set! method 'formals (get-keyword #:formals initargs '()))
|
||||
(slot-set! method 'body (get-keyword #:body initargs '()))
|
||||
(slot-set! method 'compile-env (get-keyword #:compile-env initargs #f)))
|
||||
|
||||
|
||||
(define-method (initialize (obj <foreign-object>) initargs))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue