diff options
author | Andy Wingo <wingo@pobox.com> | 2010-01-05 16:15:14 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-01-05 16:15:14 +0100 |
commit | 9fdf9fd3ea7130fd85eaf0a333a965ac4d2b07c3 (patch) | |
tree | 31ac376b1ce4cfb2757e222d39794577378f8c2f /libguile/procs.c | |
parent | e809758a7e0f3f63162a0a9064b95bd1c1d10628 (diff) | |
download | guile-9fdf9fd3ea7130fd85eaf0a333a965ac4d2b07c3.tar.gz |
move subr implementation details to gsubr.[ch]
* libguile/procs.h: Move subr macros to gsubr.h.
* libguile/procs.c (scm_c_make_subr, scm_c_make_subr_with_generic)
(scm_c_define_subr, scm_c_define_subr_with_generic): Remove these,
because they deal in subr types, and now there is only one subr type.
The body of this code is now in gsubr.c.
* libguile/deprecated.h (scm_subr_p): Remove from procs.[ch] and define
as a deprecated macro. Only used internally, but who knows who's out
there.
* libguile/goops.c (scm_generic_capability_p)
(scm_enable_primitive_generic_x, scm_set_primitive_generic_x)
(scm_primitive_generic_generic): Use the new SCM_PRIMITIVE_GENERIC_P
macro instead of calling scm_subr_p.
* libguile/gsubr.h (SCM_PRIMITIVE_P, SCM_PRIMITIVE_GENERIC_P): New
macros, to replace scm_subr_p and hacky checking for generic
capability.
(SCM_SUBR_META_INFO, SCM_SUBR_NAME, SCM_SUBRF, SCM_SUBR_PROPS)
(SCM_SUBR_GENERIC, SCM_SET_SUBR_GENERIC, SCM_SET_SUBR_GENERIC_LOC)
(SCM_SUBR_ARITY_TO_TYPE): Moved here from procs.h.
* libguile/gsubr.c (create_gsubr): Inline the
scm_c_make_subr definition here, and work for generics too. Removed a
scm_remember_upto_here_1 that was added earlier in the year when
meta_info was not being traced by the GC. Adapt callers.
Diffstat (limited to 'libguile/procs.c')
-rw-r--r-- | libguile/procs.c | 62 |
1 files changed, 0 insertions, 62 deletions
diff --git a/libguile/procs.c b/libguile/procs.c index 6c0391123..e94037828 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -41,53 +41,6 @@ */ -SCM -scm_c_make_subr (const char *name, long type, SCM (*fcn) ()) -{ - register SCM z; - SCM sname; - SCM *meta_info; - - meta_info = scm_gc_malloc (2 * sizeof (*meta_info), "subr meta-info"); - sname = scm_from_locale_symbol (name); - meta_info[0] = sname; - meta_info[1] = SCM_EOL; /* properties */ - - z = scm_double_cell ((scm_t_bits) type, (scm_t_bits) fcn, - 0 /* generic */, (scm_t_bits) meta_info); - - scm_remember_upto_here_1 (sname); - - return z; -} - -SCM -scm_c_define_subr (const char *name, long type, SCM (*fcn) ()) -{ - SCM subr = scm_c_make_subr (name, type, fcn); - scm_define (SCM_SUBR_NAME (subr), subr); - return subr; -} - -SCM -scm_c_make_subr_with_generic (const char *name, - long type, SCM (*fcn) (), SCM *gf) -{ - SCM subr = scm_c_make_subr (name, type, fcn); - SCM_SET_SUBR_GENERIC_LOC (subr, gf); - return subr; -} - -SCM -scm_c_define_subr_with_generic (const char *name, - long type, SCM (*fcn) (), SCM *gf) -{ - SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf); - scm_define (SCM_SUBR_NAME (subr), subr); - return subr; -} - - SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0, (SCM obj), "Return @code{#t} if @var{obj} is a procedure.") @@ -123,21 +76,6 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0, } #undef FUNC_NAME -/* Only used internally. */ -int -scm_subr_p (SCM obj) -{ - if (SCM_NIMP (obj)) - switch (SCM_TYP7 (obj)) - { - case scm_tc7_gsubr: - return 1; - default: - ; - } - return 0; -} - SCM_SYMBOL (sym_documentation, "documentation"); SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0, |