summaryrefslogtreecommitdiff
path: root/libguile/procs.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-08-28 19:01:19 +0200
committerLudovic Courtès <ludo@gnu.org>2009-08-28 19:16:46 +0200
commit7af531508c5931261ff8957708642cac67bf86a5 (patch)
treebd36d27d9f7a11d954093d4121ccb9e645f5c59f /libguile/procs.c
parentf86f3b5b113b4cb383c531150b13bef9b2789221 (diff)
parentce3ed0125fcfb9ad09da815f133a2320102d164c (diff)
downloadguile-7af531508c5931261ff8957708642cac67bf86a5.tar.gz
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts: libguile/Makefile.am libguile/bytevectors.c libguile/gc-card.c libguile/gc-mark.c libguile/programs.c libguile/srcprop.c libguile/srfi-14.c libguile/symbols.c libguile/threads.c libguile/unif.c libguile/vm.c
Diffstat (limited to 'libguile/procs.c')
-rw-r--r--libguile/procs.c9
1 files changed, 9 insertions, 0 deletions
diff --git a/libguile/procs.c b/libguile/procs.c
index b67bfd90b..40d6231bb 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -103,6 +103,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
case scm_tcs_closures:
case scm_tcs_subrs:
case scm_tc7_pws:
+ case scm_tc7_program:
return SCM_BOOL_T;
case scm_tc7_smob:
return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply);
@@ -142,6 +143,10 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
return SCM_BOOL_T;
case scm_tc7_gsubr:
return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0);
+ case scm_tc7_program:
+ return scm_from_bool (SCM_PROGRAM_DATA (obj)->nargs == 0
+ || (SCM_PROGRAM_DATA (obj)->nargs == 1
+ && SCM_PROGRAM_DATA (obj)->nrest));
case scm_tc7_pws:
obj = SCM_PROCEDURE (obj);
goto again;
@@ -170,6 +175,8 @@ scm_subr_p (SCM obj)
return 0;
}
+SCM_SYMBOL (sym_documentation, "documentation");
+
SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
(SCM proc),
"Return the documentation string associated with @code{proc}. By\n"
@@ -181,6 +188,8 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
SCM code;
SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
proc, SCM_ARG1, FUNC_NAME);
+ if (SCM_PROGRAM_P (proc))
+ return scm_assq_ref (scm_program_properties (proc), sym_documentation);
switch (SCM_TYP7 (proc))
{
case scm_tcs_closures: