summaryrefslogtreecommitdiff
path: root/libguile/procs.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/procs.c')
-rw-r--r--libguile/procs.c72
1 files changed, 1 insertions, 71 deletions
diff --git a/libguile/procs.c b/libguile/procs.c
index 6c0391123..10ae8855f 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.")
@@ -100,7 +53,6 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
if (!((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_PURE_GENERIC)
|| SCM_STRUCT_APPLICABLE_P (obj)))
break;
- case scm_tc7_gsubr:
case scm_tc7_program:
return SCM_BOOL_T;
case scm_tc7_smob:
@@ -123,21 +75,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,
@@ -187,14 +124,7 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
/* don't use procedure_name, because don't care enough to do a reverse
lookup */
- switch (SCM_TYP7 (procedure)) {
- case scm_tc7_gsubr:
- name = SCM_SUBR_NAME (procedure);
- break;
- default:
- name = scm_procedure_property (procedure, scm_sym_name);
- break;
- }
+ name = scm_procedure_property (procedure, scm_sym_name);
if (scm_is_true (name))
scm_set_procedure_property_x (ret, scm_sym_name, name);
return ret;