mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* procs.c, procs.h (procedure-documentation): Moved from eval.c.

Browse source
This commit is contained in:
Mikael Djurfeldt 1998-10-31 13:07:16 +00:00
parent 27a69f9382
commit c2c82fba2f
2 changed files with 32 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

31
libguile/procs.c
View file

@ -182,6 +182,37 @@ scm_thunk_p (obj)
return SCM_BOOL_F;
}
SCM_PROC(s_procedure_documentation, "procedure-documentation", 1, 0, 0, scm_procedure_documentation);
SCM
scm_procedure_documentation (proc)
SCM proc;
{
SCM code;
SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (proc) && SCM_NIMP (proc) && SCM_TYP7 (proc) != scm_tc7_contin,
proc, SCM_ARG1, s_procedure_documentation);
switch (SCM_TYP7 (proc))
{
case scm_tcs_closures:
code = SCM_CDR (SCM_CODE (proc));
if (SCM_IMP (SCM_CDR (code)))
return SCM_BOOL_F;
code = SCM_CAR (code);
if (SCM_IMP (code))
return SCM_BOOL_F;
if (SCM_STRINGP (code))
return code;
default:
return SCM_BOOL_F;
/*
case scm_tcs_subrs:
#ifdef CCLO
case scm_tc7_cclo:
#endif
*/
}
}
void

1
libguile/procs.h
View file

@ -97,6 +97,7 @@ extern SCM scm_makcclo SCM_P ((SCM proc, long len));
extern SCM scm_procedure_p SCM_P ((SCM obj));
extern SCM scm_closure_p SCM_P ((SCM obj));
extern SCM scm_thunk_p SCM_P ((SCM obj));
extern SCM scm_procedure_documentation SCM_P ((SCM proc));
extern void scm_init_iprocs SCM_P ((scm_iproc *subra, int type));
extern void scm_init_procs SCM_P ((void));