summaryrefslogtreecommitdiff
path: root/libguile/print.c
diff options
context:
space:
mode:
authorGreg J. Badros <gjb@cs.washington.edu>1999-12-12 02:36:16 +0000
committerGreg J. Badros <gjb@cs.washington.edu>1999-12-12 02:36:16 +0000
commit1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11 (patch)
tree79120a96365e0fa3324174bfd08d731ca8311d64 /libguile/print.c
parent6e7069385db8cf96dfbe51cf65ace161942a32c9 (diff)
downloadguile-1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11.tar.gz
* *.c: Pervasive software-engineering-motivated rewrite of
function headers and argument checking. Switched SCM_PROC, SCM_PROC1 macros to be GUILE_PROC, GUILE_PROC1 (may change names later, but was useful to keep old versions around while migrate) that has docstrings and argument lists embedded in the GUILE_PROC macro invocations that expand into a function header. Use lots of new SCM_VALIDATE_* macros to simplify error checking and reduce tons of redundancy. This is very similar to what I did for Scwm. Note that none of the extraction of the docstrings, nor software engineering checks of Scwm is yet added to Guile. I'll work on that tomorrow, I expect. * Makefile.am: Added scm_validate.h to modinclude_HEADERS. * chars.c: Added docstrings for the primitives defined in here. * snarf.h: Added GUILE_PROC, GUILE_PROC1. Added SCM_REGISTER_PROC to be like old SCM_PROC, though old SCM_PROC still remains for now. Changed naming convention for the s_foo string name of the primitive to be s_scm_foo for ease of use with the macro. * scm_validate.h: Lots of new SCM_VALIDATE macros to simplify argument checking through guile. Maybe some of these should be folded into the header file for the types they check, but for now it was easiest to just stick them all in one place.
Diffstat (limited to 'libguile/print.c')
-rw-r--r--libguile/print.c142
1 files changed, 58 insertions, 84 deletions
diff --git a/libguile/print.c b/libguile/print.c
index ac19075b7..b28a86aa2 100644
--- a/libguile/print.c
+++ b/libguile/print.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>
@@ -55,6 +59,7 @@
#include "struct.h"
#include "objects.h"
+#include "scm_validate.h"
#include "print.h"
@@ -121,18 +126,18 @@ scm_option scm_print_opts[] = {
"Print closures with source." }
};
-SCM_PROC (s_print_options, "print-options-interface", 0, 1, 0, scm_print_options);
-
-SCM
-scm_print_options (setting)
- SCM setting;
+GUILE_PROC (scm_print_options, "print-options-interface", 0, 1, 0,
+ (SCM setting),
+"")
+#define FUNC_NAME s_scm_print_options
{
SCM ans = scm_options (setting,
scm_print_opts,
SCM_N_PRINT_OPTIONS,
- s_print_options);
+ FUNC_NAME);
return ans;
}
+#undef FUNC_NAME
/* {Printing of Scheme Objects}
@@ -146,14 +151,14 @@ scm_print_options (setting)
* will be O(N).
*/
#define PUSH_REF(pstate, obj) \
-{ \
+do { \
pstate->ref_stack[pstate->top++] = (obj); \
if (pstate->top == pstate->ceiling) \
grow_ref_stack (pstate); \
-}
+} while(0)
#define ENTER_NESTED_DATA(pstate, obj, label) \
-{ \
+do { \
register unsigned long i; \
for (i = 0; i < pstate->top; ++i) \
if (pstate->ref_stack[i] == (obj)) \
@@ -167,7 +172,7 @@ scm_print_options (setting)
} \
} \
PUSH_REF(pstate, obj); \
-} \
+} while(0)
#define EXIT_NESTED_DATA(pstate) { --pstate->top; }
@@ -176,21 +181,22 @@ SCM scm_print_state_vtable;
static SCM print_state_pool;
#ifdef GUILE_DEBUG /* Used for debugging purposes */
-SCM_PROC(s_current_pstate, "current-pstate", 0, 0, 0, scm_current_pstate);
-SCM
-scm_current_pstate ()
+GUILE_PROC(scm_current_pstate, "current-pstate", 0, 0, 0,
+ (),
+ "")
+#define FUNC_NAME s_scm_current_pstate
{
return SCM_CADR (print_state_pool);
}
+#undef FUNC_NAME
+
#endif
#define PSTATE_SIZE 50L
-static SCM make_print_state SCM_P ((void));
-
static SCM
-make_print_state ()
+make_print_state (void)
{
SCM print_state = scm_make_struct (SCM_CAR (print_state_pool), /* pstate type */
SCM_INUM0,
@@ -241,11 +247,8 @@ scm_free_print_state (print_state)
SCM_ALLOW_INTS;
}
-static void grow_ref_stack SCM_P ((scm_print_state *pstate));
-
static void
-grow_ref_stack (pstate)
- scm_print_state *pstate;
+grow_ref_stack (scm_print_state *pstate)
{
int new_size = 2 * pstate->ceiling;
scm_vector_set_length_x (pstate->ref_vect, SCM_MAKINUM (new_size));
@@ -254,13 +257,8 @@ grow_ref_stack (pstate)
}
-static void print_circref SCM_P ((SCM port, scm_print_state *pstate, SCM ref));
-
static void
-print_circref (port, pstate, ref)
- SCM port;
- scm_print_state *pstate;
- SCM ref;
+print_circref (SCM port,scm_print_state *pstate,SCM ref)
{
register int i;
int self = pstate->top - 1;
@@ -290,10 +288,7 @@ SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write);
SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, g_display);
void
-scm_iprin1 (exp, port, pstate)
- SCM exp;
- SCM port;
- scm_print_state *pstate;
+scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
{
taloop:
switch (7 & (int) exp)
@@ -703,10 +698,7 @@ taloop:
* useful for continuing a chain of print calls from Scheme. */
void
-scm_prin1 (exp, port, writingp)
- SCM exp;
- SCM port;
- int writingp;
+scm_prin1 (SCM exp, SCM port, int writingp)
{
SCM handle = SCM_BOOL_F; /* Will GC protect the handle whilst unlinked */
SCM pstate_scm;
@@ -756,10 +748,7 @@ scm_prin1 (exp, port, writingp)
*/
void
-scm_intprint (n, radix, port)
- long n;
- int radix;
- SCM port;
+scm_intprint (long n, int radix, SCM port)
{
char num_buf[SCM_INTBUFLEN];
scm_lfwrite (num_buf, scm_iint2str (n, radix, num_buf), port);
@@ -769,10 +758,7 @@ scm_intprint (n, radix, port)
*/
void
-scm_ipruk (hdr, ptr, port)
- char *hdr;
- SCM ptr;
- SCM port;
+scm_ipruk (char *hdr, SCM ptr, SCM port)
{
scm_puts ("#<unknown-", port);
scm_puts (hdr, port);
@@ -794,12 +780,7 @@ scm_ipruk (hdr, ptr, port)
void
-scm_iprlist (hdr, exp, tlr, port, pstate)
- char *hdr;
- SCM exp;
- int tlr;
- SCM port;
- scm_print_state *pstate;
+scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
{
register SCM hare, tortoise;
int floor = pstate->top - 2;
@@ -915,9 +896,7 @@ scm_valid_oport_value_p (SCM val)
/* SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write); */
SCM
-scm_write (obj, port)
- SCM obj;
- SCM port;
+scm_write (SCM obj, SCM port)
{
if (SCM_UNBNDP (port))
port = scm_cur_outp;
@@ -938,9 +917,7 @@ scm_write (obj, port)
/* SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, g_display); */
SCM
-scm_display (obj, port)
- SCM obj;
- SCM port;
+scm_display (SCM obj, SCM port)
{
if (SCM_UNBNDP (port))
port = scm_cur_outp;
@@ -957,34 +934,32 @@ scm_display (obj, port)
return SCM_UNSPECIFIED;
}
-SCM_PROC(s_newline, "newline", 0, 1, 0, scm_newline);
-
-SCM
-scm_newline (port)
- SCM port;
+GUILE_PROC(scm_newline, "newline", 0, 1, 0,
+ (SCM port),
+"")
+#define FUNC_NAME s_scm_newline
{
if (SCM_UNBNDP (port))
port = scm_cur_outp;
- SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG1, s_newline);
+ SCM_VALIDATE_OPORT_VALUE(1,port);
scm_putc ('\n', SCM_COERCE_OUTPORT (port));
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC(s_write_char, "write-char", 1, 1, 0, scm_write_char);
-
-SCM
-scm_write_char (chr, port)
- SCM chr;
- SCM port;
+GUILE_PROC(scm_write_char, "write-char", 1, 1, 0,
+ (SCM chr, SCM port),
+"")
+#define FUNC_NAME s_scm_write_char
{
if (SCM_UNBNDP (port))
port = scm_cur_outp;
- SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write_char);
+ SCM_VALIDATE_CHAR(1,chr);
+ SCM_VALIDATE_OPORT_VALUE(2,port);
- SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG1, s_write_char);
scm_putc ((int) SCM_ICHR (chr), SCM_COERCE_OUTPORT (port));
#ifdef HAVE_PIPE
# ifdef EPIPE
@@ -994,6 +969,7 @@ scm_write_char (chr, port)
#endif
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
@@ -1017,9 +993,7 @@ print_port_with_ps (SCM obj, SCM port, scm_print_state *pstate)
}
SCM
-scm_printer_apply (proc, exp, port, pstate)
- SCM proc, exp, port;
- scm_print_state *pstate;
+scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *pstate)
{
SCM pwps;
SCM pair = scm_cons (port, pstate->handle);
@@ -1028,25 +1002,24 @@ scm_printer_apply (proc, exp, port, pstate)
return scm_apply (proc, exp, scm_cons (pwps, scm_listofnull));
}
-SCM_PROC (s_port_with_print_state, "port-with-print-state", 2, 0, 0, scm_port_with_print_state);
-
-SCM
-scm_port_with_print_state (SCM port, SCM pstate)
+GUILE_PROC (scm_port_with_print_state, "port-with-print-state", 2, 0, 0,
+ (SCM port, SCM pstate),
+"")
+#define FUNC_NAME s_scm_port_with_print_state
{
SCM pwps;
- SCM_ASSERT (scm_valid_oport_value_p (port),
- port, SCM_ARG1, s_port_with_print_state);
- SCM_ASSERT (SCM_NIMP (pstate) && SCM_PRINT_STATE_P (pstate),
- pstate, SCM_ARG2, s_port_with_print_state);
+ SCM_VALIDATE_OPORT_VALUE(1,port);
+ SCM_VALIDATE_PRINTSTATE(2,pstate);
port = SCM_COERCE_OUTPORT (port);
SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, scm_cons (port, pstate));
return pwps;
}
+#undef FUNC_NAME
-SCM_PROC (s_get_print_state, "get-print-state", 1, 0, 0, scm_get_print_state);
-
-SCM
-scm_get_print_state (SCM port)
+GUILE_PROC (scm_get_print_state, "get-print-state", 1, 0, 0,
+ (SCM port),
+"")
+#define FUNC_NAME s_scm_get_print_state
{
if (SCM_NIMP (port))
{
@@ -1055,8 +1028,9 @@ scm_get_print_state (SCM port)
if (SCM_OUTPORTP (port))
return SCM_BOOL_F;
}
- return scm_wta (port, (char *) SCM_ARG1, s_get_print_state);
+ RETURN_SCM_WTA (1,port);
}
+#undef FUNC_NAME