summaryrefslogtreecommitdiff
path: root/libguile/procs.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/procs.c')
-rw-r--r--libguile/procs.c127
1 files changed, 57 insertions, 70 deletions
diff --git a/libguile/procs.c b/libguile/procs.c
index 3ca45f1f5..fcd0bfa57 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -38,6 +38,10 @@
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
#include <stdio.h>
@@ -45,6 +49,7 @@
#include "objects.h"
+#include "scm_validate.h"
#include "procs.h"
@@ -60,11 +65,7 @@ int scm_subr_table_size = 0;
int scm_subr_table_room = 750;
SCM
-scm_make_subr_opt (name, type, fcn, set)
- const char *name;
- int type;
- SCM (*fcn) ();
- int set;
+scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
{
SCM symcell;
register SCM z;
@@ -115,10 +116,7 @@ scm_free_subr_entry (SCM subr)
}
SCM
-scm_make_subr (name, type, fcn)
- const char *name;
- int type;
- SCM (*fcn) ();
+scm_make_subr (const char *name, int type, SCM (*fcn) ())
{
return scm_make_subr_opt (name, type, fcn, 1);
}
@@ -150,9 +148,7 @@ scm_mark_subr_table ()
#ifdef CCLO
SCM
-scm_makcclo (proc, len)
- SCM proc;
- long len;
+scm_makcclo (SCM proc, long len)
{
SCM s;
SCM_NEWCELL (s);
@@ -168,25 +164,23 @@ scm_makcclo (proc, len)
/* Undocumented debugging procedure */
#ifdef GUILE_DEBUG
-SCM_PROC (s_make_cclo, "make-cclo", 2, 0, 0, scm_make_cclo);
-
-SCM
-scm_make_cclo (proc, len)
- SCM proc;
- SCM len;
+GUILE_PROC (scm_make_cclo, "make-cclo", 2, 0, 0,
+ (SCM proc, SCM len),
+"")
+#define FUNC_NAME s_scm_make_cclo
{
return scm_makcclo (proc, SCM_INUM (len));
}
+#undef FUNC_NAME
#endif
#endif
-SCM_PROC(s_procedure_p, "procedure?", 1, 0, 0, scm_procedure_p);
-
-SCM
-scm_procedure_p (obj)
- SCM obj;
+GUILE_PROC(scm_procedure_p, "procedure?", 1, 0, 0,
+ (SCM obj),
+"")
+#define FUNC_NAME s_scm_procedure_p
{
if (SCM_NIMP (obj))
switch (SCM_TYP7 (obj))
@@ -207,26 +201,21 @@ scm_procedure_p (obj)
}
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC(s_closure_p, "closure?", 1, 0, 0, scm_closure_p);
-
-SCM
-scm_closure_p (obj)
- SCM obj;
+GUILE_PROC(scm_closure_p, "closure?", 1, 0, 0,
+ (SCM obj),
+"")
+#define FUNC_NAME s_scm_closure_p
{
- return SCM_NIMP (obj) && SCM_CLOSUREP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(SCM_NIMP (obj) && SCM_CLOSUREP (obj));
}
+#undef FUNC_NAME
-SCM_PROC(s_thunk_p, "thunk?", 1, 0, 0, scm_thunk_p);
-
-#ifdef __STDC__
-SCM
-scm_thunk_p (SCM obj)
-#else
-SCM
-scm_thunk_p (obj)
- SCM obj;
-#endif
+GUILE_PROC(scm_thunk_p, "thunk?", 1, 0, 0,
+ (SCM obj),
+"")
+#define FUNC_NAME s_scm_thunk_p
{
if (SCM_NIMP (obj))
{
@@ -254,6 +243,7 @@ scm_thunk_p (obj)
}
return SCM_BOOL_F;
}
+#undef FUNC_NAME
/* Only used internally. */
int
@@ -270,15 +260,14 @@ scm_subr_p (SCM obj)
return 0;
}
-SCM_PROC(s_procedure_documentation, "procedure-documentation", 1, 0, 0, scm_procedure_documentation);
-
-SCM
-scm_procedure_documentation (proc)
- SCM proc;
+GUILE_PROC(scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
+ (SCM proc),
+"")
+#define FUNC_NAME s_scm_procedure_documentation
{
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);
+ proc, SCM_ARG1, FUNC_NAME);
switch (SCM_TYP7 (proc))
{
case scm_tcs_closures:
@@ -300,31 +289,29 @@ scm_procedure_documentation (proc)
*/
}
}
+#undef FUNC_NAME
/* Procedure-with-setter
*/
-SCM_PROC (s_procedure_with_setter_p, "procedure-with-setter?", 1, 0, 0, scm_procedure_with_setter_p);
-
-SCM
-scm_procedure_with_setter_p (SCM obj)
+GUILE_PROC (scm_procedure_with_setter_p, "procedure-with-setter?", 1, 0, 0,
+ (SCM obj),
+ "")
+#define FUNC_NAME s_scm_procedure_with_setter_p
{
- return (SCM_NIMP (obj) && SCM_PROCEDURE_WITH_SETTER_P (obj)
- ? SCM_BOOL_T
- : SCM_BOOL_F);
+ return SCM_BOOL(SCM_NIMP (obj) && SCM_PROCEDURE_WITH_SETTER_P (obj));
}
+#undef FUNC_NAME
-SCM_PROC (s_make_procedure_with_setter, "make-procedure-with-setter", 2, 0, 0, scm_make_procedure_with_setter);
-
-SCM
-scm_make_procedure_with_setter (SCM procedure, SCM setter)
+GUILE_PROC (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0, 0,
+ (SCM procedure, SCM setter),
+ "")
+#define FUNC_NAME s_scm_make_procedure_with_setter
{
SCM z;
- SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (procedure)),
- procedure, SCM_ARG1, s_make_procedure_with_setter);
- SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (setter)),
- setter, SCM_ARG2, s_make_procedure_with_setter);
+ SCM_VALIDATE_PROC(1,procedure);
+ SCM_VALIDATE_PROC(2,setter);
SCM_NEWCELL (z);
SCM_ENTER_A_SECTION;
SCM_SETCDR (z, scm_cons (procedure, setter));
@@ -332,23 +319,25 @@ scm_make_procedure_with_setter (SCM procedure, SCM setter)
SCM_EXIT_A_SECTION;
return z;
}
+#undef FUNC_NAME
-SCM_PROC (s_procedure, "procedure", 1, 0, 0, scm_procedure);
-
-SCM
-scm_procedure (SCM proc)
+GUILE_PROC (scm_procedure, "procedure", 1, 0, 0,
+ (SCM proc),
+ "")
+#define FUNC_NAME s_scm_procedure
{
- SCM_ASSERT (SCM_NIMP (proc), proc, SCM_ARG1, s_procedure);
+ SCM_VALIDATE_NIMP(1,proc);
if (SCM_PROCEDURE_WITH_SETTER_P (proc))
return SCM_PROCEDURE (proc);
else if (SCM_STRUCTP (proc))
{
- SCM_ASSERT (SCM_I_OPERATORP (proc), proc, SCM_ARG1, s_procedure);
+ SCM_ASSERT (SCM_I_OPERATORP (proc), proc, SCM_ARG1, FUNC_NAME);
return proc;
}
- scm_wrong_type_arg (s_procedure, SCM_ARG1, proc);
+ SCM_WRONG_TYPE_ARG (1, proc);
return 0; /* not reached */
}
+#undef FUNC_NAME
SCM_GPROC (s_setter, "setter", 1, 0, 0, scm_setter, g_setter);
@@ -376,9 +365,7 @@ scm_setter (SCM proc)
void
-scm_init_iprocs(subra, type)
- const scm_iproc *subra;
- int type;
+scm_init_iprocs(const scm_iproc *subra, int type)
{
for(;subra->scm_string; subra++)
scm_make_subr(subra->scm_string,