mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

move subr implementation details to gsubr.[ch]

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2010-01-05 16:15:14 +01:00
parent e809758a7e
commit 9fdf9fd3ea
6 changed files with 53 additions and 133 deletions
Download patch file Download diff file Expand all files Collapse all files

62
libguile/procs.c
View file

@ -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,