-/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
"#nil"
};
+SCM_SYMBOL (sym_reader, "reader");
+
scm_t_option scm_print_opts[] = {
{ SCM_OPTION_SCM, "closure-hook", SCM_UNPACK (SCM_BOOL_F),
"Hook for printing closures (should handle macros as well)." },
{ SCM_OPTION_BOOLEAN, "source", 0,
- "Print closures with source." }
+ "Print closures with source." },
+ { SCM_OPTION_SCM, "highlight-prefix", (unsigned long)SCM_BOOL_F,
+ "The string to print before highlighted values." },
+ { SCM_OPTION_SCM, "highlight-suffix", (unsigned long)SCM_BOOL_F,
+ "The string to print after highlighted values." },
+ { SCM_OPTION_SCM, "quote-keywordish-symbols", (unsigned long)SCM_BOOL_F,
+ "How to print symbols that have a colon as their first or last character. "
+ "The value '#f' does not quote the colons; '#t' quotes them; "
+ "'reader' quotes them when the reader option 'keywords' is not '#f'."
+ }
};
SCM_DEFINE (scm_print_options, "print-options-interface", 0, 1, 0,
* time complexity (O (depth * N)), The printer code can be
* rewritten to be O(N).
*/
-#define PUSH_REF(pstate, obj) \
-do { \
- pstate->ref_stack[pstate->top++] = (obj); \
- if (pstate->top == pstate->ceiling) \
- grow_ref_stack (pstate); \
+#define PUSH_REF(pstate, obj) \
+do \
+{ \
+ PSTATE_STACK_SET (pstate, pstate->top, obj); \
+ pstate->top++; \
+ 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 (scm_is_eq (pstate->ref_stack[i], (obj))) \
- goto label; \
- if (pstate->fancyp) \
- { \
- if (pstate->top - pstate->list_offset >= pstate->level) \
- { \
- scm_putc ('#', port); \
- return; \
- } \
- } \
- PUSH_REF(pstate, obj); \
+#define ENTER_NESTED_DATA(pstate, obj, label) \
+do \
+{ \
+ register unsigned long i; \
+ for (i = 0; i < pstate->top; ++i) \
+ if (scm_is_eq (PSTATE_STACK_REF (pstate, i), (obj))) \
+ goto label; \
+ if (pstate->fancyp) \
+ { \
+ if (pstate->top - pstate->list_offset >= pstate->level) \
+ { \
+ scm_putc ('#', port); \
+ return; \
+ } \
+ } \
+ PUSH_REF(pstate, obj); \
} while(0)
-#define EXIT_NESTED_DATA(pstate) { --pstate->top; }
+#define EXIT_NESTED_DATA(pstate) \
+do \
+{ \
+ --pstate->top; \
+ PSTATE_STACK_SET (pstate, pstate->top, SCM_UNDEFINED); \
+} \
+while (0)
SCM scm_print_state_vtable = SCM_BOOL_F;
static SCM print_state_pool = SCM_EOL;
-SCM_MUTEX (print_state_mutex);
+scm_i_pthread_mutex_t print_state_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
#ifdef GUILE_DEBUG /* Used for debugging purposes */
= scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL);
scm_print_state *pstate = SCM_PRINT_STATE (print_state);
pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
- pstate->ref_stack = SCM_WRITABLE_VELTS (pstate->ref_vect);
- pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect);
+ pstate->ceiling = SCM_SIMPLE_VECTOR_LENGTH (pstate->ref_vect);
+ pstate->highlight_objects = SCM_EOL;
return print_state;
}
SCM answer = SCM_BOOL_F;
/* First try to allocate a print state from the pool */
- scm_i_plugin_mutex_lock (&print_state_mutex);
+ scm_i_pthread_mutex_lock (&print_state_mutex);
if (!scm_is_null (print_state_pool))
{
answer = SCM_CAR (print_state_pool);
print_state_pool = SCM_CDR (print_state_pool);
}
- scm_i_plugin_mutex_unlock (&print_state_mutex);
+ scm_i_pthread_mutex_unlock (&print_state_mutex);
return scm_is_false (answer) ? make_print_state () : answer;
}
*/
pstate->fancyp = 0;
pstate->revealed = 0;
- scm_i_plugin_mutex_lock (&print_state_mutex);
+ pstate->highlight_objects = SCM_EOL;
+ scm_i_pthread_mutex_lock (&print_state_mutex);
handle = scm_cons (print_state, print_state_pool);
print_state_pool = handle;
- scm_i_plugin_mutex_unlock (&print_state_mutex);
+ scm_i_pthread_mutex_unlock (&print_state_mutex);
}
SCM
static void
grow_ref_stack (scm_print_state *pstate)
{
- unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect);
- SCM const *old_elts = SCM_VELTS (pstate->ref_vect);
- unsigned long int new_size = 2 * pstate->ceiling;
+ SCM old_vect = pstate->ref_vect;
+ size_t old_size = SCM_SIMPLE_VECTOR_LENGTH (old_vect);
+ size_t new_size = 2 * pstate->ceiling;
SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED);
unsigned long int i;
for (i = 0; i != old_size; ++i)
- SCM_VECTOR_SET (new_vect, i, old_elts [i]);
+ SCM_SIMPLE_VECTOR_SET (new_vect, i, SCM_SIMPLE_VECTOR_REF (old_vect, i));
pstate->ref_vect = new_vect;
- pstate->ref_stack = SCM_WRITABLE_VELTS(new_vect);
pstate->ceiling = new_size;
}
+#define PSTATE_STACK_REF(p,i) SCM_SIMPLE_VECTOR_REF((p)->ref_vect, (i))
+#define PSTATE_STACK_SET(p,i,v) SCM_SIMPLE_VECTOR_SET((p)->ref_vect, (i), (v))
static void
print_circref (SCM port, scm_print_state *pstate, SCM ref)
register long i;
long self = pstate->top - 1;
i = pstate->top - 1;
- if (scm_is_pair (pstate->ref_stack[i]))
+ if (scm_is_pair (PSTATE_STACK_REF (pstate, i)))
{
while (i > 0)
{
- if (!scm_is_pair (pstate->ref_stack[i - 1])
- || !scm_is_eq (SCM_CDR (pstate->ref_stack[i - 1]),
- pstate->ref_stack[i]))
+ if (!scm_is_pair (PSTATE_STACK_REF (pstate, i-1))
+ || !scm_is_eq (SCM_CDR (PSTATE_STACK_REF (pstate, i-1)),
+ SCM_CDR (PSTATE_STACK_REF (pstate, i))))
break;
--i;
}
self = i;
}
for (i = pstate->top - 1; 1; --i)
- if (scm_is_eq (pstate->ref_stack[i], ref))
+ if (scm_is_eq (PSTATE_STACK_REF(pstate, i), ref))
break;
scm_putc ('#', port);
scm_intprint (i - self, 10, port);
/* Print the name of a symbol. */
+static int
+quote_keywordish_symbol (const char *str, size_t len)
+{
+ SCM option;
+
+ /* LEN is guaranteed to be > 0.
+ */
+ if (str[0] != ':' && str[len-1] != ':')
+ return 0;
+
+ option = SCM_PRINT_KEYWORD_STYLE;
+ if (scm_is_false (option))
+ return 0;
+ if (scm_is_eq (option, sym_reader))
+ return scm_is_true (SCM_PACK (SCM_KEYWORD_STYLE));
+ return 1;
+}
+
void
scm_print_symbol_name (const char *str, size_t len, SCM port)
{
int maybe_weird = 0;
size_t mw_pos = 0;
- if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ',' ||
- str[0] == ':' || str[len-1] == ':' || (str[0] == '.' && len == 1) ||
- scm_is_true (scm_i_mem2number(str, len, 10)))
+ if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ','
+ || quote_keywordish_symbol (str, len)
+ || (str[0] == '.' && len == 1)
+ || scm_is_true (scm_c_locale_stringn_to_number (str, len, 10)))
{
scm_lfwrite ("#{", 2, port);
weird = 1;
SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write);
SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, g_display);
+static void iprin1 (SCM exp, SCM port, scm_print_state *pstate);
+
void
scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
+{
+ if (pstate->fancyp
+ && scm_is_true (scm_memq (exp, pstate->highlight_objects)))
+ {
+ scm_display (SCM_PRINT_HIGHLIGHT_PREFIX, port);
+ iprin1 (exp, port, pstate);
+ scm_display (SCM_PRINT_HIGHLIGHT_SUFFIX, port);
+ }
+ else
+ iprin1 (exp, port, pstate);
+}
+
+static void
+iprin1 (SCM exp, SCM port, scm_print_state *pstate)
{
switch (SCM_ITAG3 (exp))
{
case scm_tc7_string:
if (SCM_WRITINGP (pstate))
{
- size_t i, len;
+ size_t i, j, len;
const char *data;
scm_putc ('"', port);
len = scm_i_string_length (exp);
data = scm_i_string_chars (exp);
- for (i = 0; i < len; ++i)
+ for (i = 0, j = 0; i < len; ++i)
{
unsigned char ch = data[i];
if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148))
{
static char const hex[]="0123456789abcdef";
- scm_putc ('\\', port);
- scm_putc ('x', port);
- scm_putc (hex [ch / 16], port);
- scm_putc (hex [ch % 16], port);
+ char buf[4];
+
+ scm_lfwrite (data+j, i-j, port);
+ buf[0] = '\\';
+ buf[1] = 'x';
+ buf[2] = hex [ch / 16];
+ buf[3] = hex [ch % 16];
+ scm_lfwrite (buf, 4, port);
+ data = scm_i_string_chars (exp);
+ j = i+1;
}
- else
+ else if (ch == '"' || ch == '\\')
{
- if (ch == '"' || ch == '\\')
- scm_putc ('\\', port);
- scm_putc (ch, port);
+ scm_lfwrite (data+j, i-j, port);
+ scm_putc ('\\', port);
+ data = scm_i_string_chars (exp);
+ j = i;
}
}
+ scm_lfwrite (data+j, i-j, port);
scm_putc ('"', port);
scm_remember_upto_here_1 (exp);
}
scm_i_symbol_length (exp),
port);
scm_putc (' ', port);
- scm_intprint ((long)exp, 16, port);
+ scm_uintprint (SCM_UNPACK (exp), 16, port);
scm_putc ('>', port);
}
break;
common_vector_printer:
{
register long i;
- long last = SCM_VECTOR_LENGTH (exp) - 1;
+ long last = SCM_SIMPLE_VECTOR_LENGTH (exp) - 1;
int cutp = 0;
- if (pstate->fancyp && SCM_VECTOR_LENGTH (exp) > pstate->length)
+ if (pstate->fancyp
+ && SCM_SIMPLE_VECTOR_LENGTH (exp) > pstate->length)
{
last = pstate->length - 1;
cutp = 1;
for (i = 0; i < last; ++i)
{
/* CHECK_INTS; */
- scm_iprin1 (SCM_VELTS (exp)[i], port, pstate);
+ scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
scm_putc (' ', port);
}
if (i == last)
{
/* CHECK_INTS; */
- scm_iprin1 (SCM_VELTS (exp)[i], port, pstate);
+ scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
}
if (cutp)
scm_puts (" ...", port);
}
EXIT_NESTED_DATA (pstate);
break;
-#if SCM_HAVE_ARRAYS
- case scm_tc7_bvect:
- case scm_tc7_byvect:
- case scm_tc7_svect:
- case scm_tc7_ivect:
- case scm_tc7_uvect:
- case scm_tc7_fvect:
- case scm_tc7_dvect:
- case scm_tc7_cvect:
-#if SCM_SIZEOF_LONG_LONG != 0
- case scm_tc7_llvect:
-#endif
- scm_raprin1 (exp, port, pstate);
- break;
-#endif
case scm_tcs_subrs:
scm_puts (SCM_SUBR_GENERIC (exp)
? "#<primitive-generic "
else
{
/* First try to allocate a print state from the pool */
- scm_i_plugin_mutex_lock (&print_state_mutex);
+ scm_i_pthread_mutex_lock (&print_state_mutex);
if (!scm_is_null (print_state_pool))
{
handle = print_state_pool;
print_state_pool = SCM_CDR (print_state_pool);
}
- scm_i_plugin_mutex_unlock (&print_state_mutex);
+ scm_i_pthread_mutex_unlock (&print_state_mutex);
if (scm_is_false (handle))
handle = scm_list_1 (make_print_state ());
pstate_scm = SCM_CAR (handle);
if (scm_is_true (handle) && !pstate->revealed)
{
- scm_i_plugin_mutex_lock (&print_state_mutex);
+ scm_i_pthread_mutex_lock (&print_state_mutex);
SCM_SETCDR (handle, print_state_pool);
print_state_pool = handle;
- scm_i_plugin_mutex_unlock (&print_state_mutex);
+ scm_i_pthread_mutex_unlock (&print_state_mutex);
}
}
*/
void
-scm_intprint (long n, int radix, SCM port)
+scm_intprint (scm_t_intmax n, int radix, SCM port)
{
char num_buf[SCM_INTBUFLEN];
scm_lfwrite (num_buf, scm_iint2str (n, radix, num_buf), port);
}
+void
+scm_uintprint (scm_t_uintmax n, int radix, SCM port)
+{
+ char num_buf[SCM_INTBUFLEN];
+ scm_lfwrite (num_buf, scm_iuint2str (n, radix, num_buf), port);
+}
+
/* Print an object of unrecognized type.
*/
if (scm_in_heap_p (ptr))
{
scm_puts (" (0x", port);
- scm_intprint (SCM_CELL_WORD_0 (ptr), 16, port);
+ scm_uintprint (SCM_CELL_WORD_0 (ptr), 16, port);
scm_puts (" . 0x", port);
- scm_intprint (SCM_CELL_WORD_1 (ptr), 16, port);
+ scm_uintprint (SCM_CELL_WORD_1 (ptr), 16, port);
scm_puts (") @", port);
}
scm_puts (" 0x", port);
- scm_intprint (SCM_UNPACK (ptr), 16, port);
+ scm_uintprint (SCM_UNPACK (ptr), 16, port);
scm_putc ('>', port);
}
register long i;
for (i = floor; i >= 0; --i)
- if (scm_is_eq (pstate->ref_stack[i], exp))
+ if (scm_is_eq (PSTATE_STACK_REF(pstate, i), exp))
goto circref;
PUSH_REF (pstate, exp);
scm_putc (' ', port);
register unsigned long i;
for (i = 0; i < pstate->top; ++i)
- if (scm_is_eq (pstate->ref_stack[i], exp))
+ if (scm_is_eq (PSTATE_STACK_REF(pstate, i), exp))
goto fancy_circref;
if (pstate->fancyp)
{
scm_write (SCM obj, SCM port)
{
if (SCM_UNBNDP (port))
- port = scm_cur_outp;
+ port = scm_current_output_port ();
SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write);
scm_display (SCM obj, SCM port)
{
if (SCM_UNBNDP (port))
- port = scm_cur_outp;
+ port = scm_current_output_port ();
SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_display);
if (scm_is_eq (destination, SCM_BOOL_T))
{
- destination = port = scm_cur_outp;
+ destination = port = scm_current_output_port ();
}
else if (scm_is_false (destination))
{
#define FUNC_NAME s_scm_newline
{
if (SCM_UNBNDP (port))
- port = scm_cur_outp;
+ port = scm_current_output_port ();
SCM_VALIDATE_OPORT_VALUE (1, port);
#define FUNC_NAME s_scm_write_char
{
if (SCM_UNBNDP (port))
- port = scm_cur_outp;
+ port = scm_current_output_port ();
SCM_VALIDATE_CHAR (1, chr);
SCM_VALIDATE_OPORT_VALUE (2, port);
scm_init_opts (scm_print_options, scm_print_opts, SCM_N_PRINT_OPTIONS);
+ scm_print_options (scm_list_4 (scm_from_locale_symbol ("highlight-prefix"),
+ scm_from_locale_string ("{"),
+ scm_from_locale_symbol ("highlight-suffix"),
+ scm_from_locale_string ("}")));
+
scm_gc_register_root (&print_state_pool);
scm_gc_register_root (&scm_print_state_vtable);
vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
scm_tc16_port_with_ps = scm_make_smob_type (0, 0);
scm_set_smob_mark (scm_tc16_port_with_ps, scm_markcdr);
scm_set_smob_print (scm_tc16_port_with_ps, port_with_ps_print);
-
+
#include "libguile/print.x"
+
+ scm_print_opts[SCM_PRINT_KEYWORD_STYLE_I].val = SCM_UNPACK (sym_reader);
}
/*
HCoop / bpt / guile.git / blobdiff