X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/fed9c9a2d43b6a44090dfd89e713a8d154d71d9c..6f29dc6d2f5837a612fe55afe995373d99c67d67:/libguile/read.c diff --git a/libguile/read.c b/libguile/read.c index c71cf77fc..7af3b735d 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997, 1999 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -12,7 +12,8 @@ * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA * * As a special exception, the Free Software Foundation gives permission * for additional uses of the text contained in its release of GUILE. @@ -36,87 +37,90 @@ * * 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. - */ + * 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 "extchrs.h" #include #include "_scm.h" #include "chars.h" -#include "genio.h" #include "eval.h" #include "unif.h" -#include "mbstrings.h" -#include "kw.h" +#include "keywords.h" #include "alist.h" #include "srcprop.h" #include "hashtab.h" #include "hash.h" +#include "ports.h" +#include "root.h" +#include "strings.h" +#include "vectors.h" +#include "validate.h" #include "read.h" +SCM_SYMBOL (scm_keyword_prefix, "prefix"); + scm_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "copy", 0, "Copy source code expressions." }, { SCM_OPTION_BOOLEAN, "positions", 0, "Record positions of source code expressions." }, { SCM_OPTION_BOOLEAN, "case-insensitive", 0, - "Convert symbols to lower case."} + "Convert symbols to lower case."}, + { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), + "Style of keyword recognition: #f or 'prefix"} }; -SCM_PROC (s_read_options, "read-options-interface", 0, 1, 0, scm_read_options); - -SCM -scm_read_options (setting) - SCM setting; +SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, + (SCM setting), +"") +#define FUNC_NAME s_scm_read_options { SCM ans = scm_options (setting, scm_read_opts, SCM_N_READ_OPTIONS, - s_read_options); + FUNC_NAME); if (SCM_COPY_SOURCE_P) SCM_RECORD_POSITIONS_P = 1; return ans; } +#undef FUNC_NAME -/* CDR contains an association list mapping extra hash characters to - procedures. */ -static SCM scm_read_hash_procedures; - -SCM_PROC (s_read, "read", 0, 1, 0, scm_read); +/* An association list mapping extra hash characters to procedures. */ +static SCM *scm_read_hash_procedures; -SCM -scm_read (port) - SCM port; +SCM_DEFINE (scm_read, "read", 0, 1, 0, + (SCM port), +"") +#define FUNC_NAME s_scm_read { int c; SCM tok_buf, copy; if (SCM_UNBNDP (port)) port = scm_cur_inp; - else - SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), - port, - SCM_ARG1, - s_read); + SCM_VALIDATE_OPINPORT (1,port); c = scm_flush_ws (port, (char *) NULL); if (EOF == c) return SCM_EOF_VAL; - scm_gen_ungetc (c, port); + scm_ungetc (c, port); tok_buf = scm_makstr (30L, 0); return scm_lreadr (&tok_buf, port, ©); } +#undef FUNC_NAME char * -scm_grow_tok_buf (tok_buf) - SCM * tok_buf; +scm_grow_tok_buf (SCM *tok_buf) { scm_vector_set_length_x (*tok_buf, SCM_MAKINUM (2 * SCM_LENGTH (*tok_buf))); return SCM_CHARS (*tok_buf); @@ -125,13 +129,11 @@ scm_grow_tok_buf (tok_buf) int -scm_flush_ws (port, eoferr) - SCM port; - char *eoferr; +scm_flush_ws (SCM port, const char *eoferr) { register int c; while (1) - switch (c = scm_gen_getc (port)) + switch (c = scm_getc (port)) { case EOF: goteof: @@ -140,7 +142,7 @@ scm_flush_ws (port, eoferr) return c; case ';': lp: - switch (c = scm_gen_getc (port)) + switch (c = scm_getc (port)) { case EOF: goto goteof; @@ -162,9 +164,7 @@ scm_flush_ws (port, eoferr) int -scm_casei_streq (s1, s2) - char * s1; - char * s2; +scm_casei_streq (char *s1, char *s2) { while (*s1 && *s2) if (scm_downcase((int)*s1) != scm_downcase((int)*s2)) @@ -181,15 +181,11 @@ scm_casei_streq (s1, s2) /* recsexpr is used when recording expressions * constructed by read:sharp. */ - -static SCM recsexpr SCM_P ((SCM obj, int line, int column, SCM filename)); - +#ifndef DEBUG_EXTENSIONS +#define recsexpr(obj, line, column, filename) (obj) +#else static SCM -recsexpr (obj, line, column, filename) - SCM obj; - int line; - int column; - SCM filename; +recsexpr (SCM obj,int line,int column,SCM filename) { if (SCM_IMP (obj) || SCM_NCONSP(obj)) return obj; @@ -204,7 +200,7 @@ recsexpr (obj, line, column, filename) { copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename), SCM_UNDEFINED); - while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) + while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) { SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp), line, @@ -218,7 +214,7 @@ recsexpr (obj, line, column, filename) else { recsexpr (SCM_CAR (obj), line, column, filename); - while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) + while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) recsexpr (SCM_CAR (tmp), line, column, filename); copy = SCM_UNDEFINED; } @@ -233,48 +229,47 @@ recsexpr (obj, line, column, filename) return obj; } } - +#endif /* Consume an SCSH-style block comment. Assume that we've already - read the initial `#!', and eat characters until the matching `!#'. */ + read the initial `#!', and eat characters until we get a + newline/exclamation-point/sharp-sign/newline sequence. */ static void -skip_scsh_block_comment (port) - SCM port; +skip_scsh_block_comment (SCM port) { - char last_c = '\0'; + /* Is this portable? Dear God, spare me from the non-eight-bit + characters. But is it tasteful? */ + long history = 0; for (;;) { - int c = scm_gen_getc (port); + int c = scm_getc (port); if (c == EOF) scm_wta (SCM_UNDEFINED, "unterminated `#! ... !#' comment", "read"); - else if (c == '#' && last_c == '!') - return; + history = ((history << 8) | (c & 0xff)) & 0xffffffff; - last_c = c; + /* Were the last four characters read "\n!#\n"? */ + if (history == (('\n' << 24) | ('!' << 16) | ('#' << 8) | '\n')) + return; } } -static SCM -scm_get_hash_procedure SCM_P ((int c)); +static SCM scm_get_hash_procedure(int c); static char s_list[]="list"; SCM -scm_lreadr (tok_buf, port, copy) - SCM *tok_buf; - SCM port; - SCM *copy; +scm_lreadr (SCM *tok_buf,SCM port,SCM *copy) { int c; scm_sizet j; SCM p; tryagain: - c = scm_flush_ws (port, s_read); + c = scm_flush_ws (port, s_scm_read); tryagain_no_flush_ws: switch (c) { @@ -290,19 +285,19 @@ tryagain_no_flush_ws: goto tryagain; case '\'': - p = scm_i_quote; + p = scm_sym_quote; goto recquote; case '`': - p = scm_i_quasiquote; + p = scm_sym_quasiquote; goto recquote; case ',': - c = scm_gen_getc (port); + c = scm_getc (port); if ('@' == c) - p = scm_i_uq_splicing; + p = scm_sym_uq_splicing; else { - scm_gen_ungetc (c, port); - p = scm_i_unquote; + scm_ungetc (c, port); + p = scm_sym_unquote; } recquote: p = scm_cons2 (p, @@ -322,7 +317,7 @@ tryagain_no_flush_ws: SCM_EOL)); return p; case '#': - c = scm_gen_getc (port); + c = scm_getc (port); switch (c) { case '(': @@ -348,7 +343,7 @@ tryagain_no_flush_ws: case 'I': case 'e': case 'E': - scm_gen_ungetc (c, port); + scm_ungetc (c, port); c = '#'; goto num; @@ -360,6 +355,7 @@ tryagain_no_flush_ws: c = scm_flush_ws (port, (char *)NULL); goto tryagain_no_flush_ws; +#ifdef HAVE_ARRAYS case '*': j = scm_read_token (c, tok_buf, port, 0); p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1)); @@ -367,31 +363,35 @@ tryagain_no_flush_ws: return p; else goto unkshrp; +#endif case '{': j = scm_read_token (c, tok_buf, port, 1); p = scm_intern (SCM_CHARS (*tok_buf), j); - if (SCM_PORT_REPRESENTATION (port) != scm_regular_port) - scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T); return SCM_CAR (p); case '\\': - c = scm_gen_getc (port); + c = scm_getc (port); j = scm_read_token (c, tok_buf, port, 0); if (j == 1) - return SCM_MAKICHR (c); + return SCM_MAKE_CHAR (c); if (c >= '0' && c < '8') { p = scm_istr2int (SCM_CHARS (*tok_buf), (long) j, 8); if (SCM_NFALSEP (p)) - return SCM_MAKICHR (SCM_INUM (p)); + return SCM_MAKE_CHAR (SCM_INUM (p)); } for (c = 0; c < scm_n_charnames; c++) if (scm_charnames[c] && (scm_casei_streq (scm_charnames[c], SCM_CHARS (*tok_buf)))) - return SCM_MAKICHR (scm_charnums[c]); + return SCM_MAKE_CHAR (scm_charnums[c]); scm_wta (SCM_UNDEFINED, "unknown # object: #\\", SCM_CHARS (*tok_buf)); + /* #:SYMBOL is a syntax for keywords supported in all contexts. */ + case ':': + j = scm_read_token ('-', tok_buf, port, 0); + p = scm_intern (SCM_CHARS (*tok_buf), j); + return scm_make_keyword_from_dash_symbol (SCM_CAR (p)); default: callshrp: @@ -405,7 +405,7 @@ tryagain_no_flush_ws: SCM got; got = scm_apply (sharp, - SCM_MAKICHR (c), + SCM_MAKE_CHAR (c), scm_acons (port, SCM_EOL, SCM_EOL)); if (SCM_UNSPECIFIED == got) goto unkshrp; @@ -417,21 +417,21 @@ tryagain_no_flush_ws: } } unkshrp: - scm_misc_error (s_read, "Unknown # object: %S", - scm_listify (SCM_MAKICHR (c), SCM_UNDEFINED)); + scm_misc_error (s_scm_read, "Unknown # object: ~S", + scm_listify (SCM_MAKE_CHAR (c), SCM_UNDEFINED)); } case '"': j = 0; - while ('"' != (c = scm_gen_getc (port))) + while ('"' != (c = scm_getc (port))) { SCM_ASSERT (EOF != c, SCM_UNDEFINED, "end of file in ", "string"); - while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf)) + while (j + 2 >= SCM_LENGTH (*tok_buf)) scm_grow_tok_buf (tok_buf); if (c == '\\') - switch (c = scm_gen_getc (port)) + switch (c = scm_getc (port)) { case '\n': continue; @@ -457,20 +457,8 @@ tryagain_no_flush_ws: c = '\v'; break; } - if (SCM_PORT_REPRESENTATION(port) == scm_regular_port) - { - SCM_CHARS (*tok_buf)[j] = c; - ++j; - } - else - { - int len; - len = xwctomb (SCM_CHARS (*tok_buf) + j, c); - if (len == 0) - len = 1; - SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read"); - j += len; - } + SCM_CHARS (*tok_buf)[j] = c; + ++j; } if (j == 0) return scm_nullstr; @@ -478,10 +466,6 @@ tryagain_no_flush_ws: { SCM str; str = scm_makfromstr (SCM_CHARS (*tok_buf), j, 0); - if (SCM_PORT_REPRESENTATION(port) != scm_regular_port) - { - SCM_SETLENGTH (str, SCM_LENGTH (str), scm_tc7_mb_string); - } return str; } @@ -497,9 +481,9 @@ tryagain_no_flush_ws: return p; if (c == '#') { - if ((j == 2) && (scm_gen_getc (port) == '(')) + if ((j == 2) && (scm_getc (port) == '(')) { - scm_gen_ungetc ('(', port); + scm_ungetc ('(', port); c = SCM_CHARS (*tok_buf)[1]; goto callshrp; } @@ -508,20 +492,19 @@ tryagain_no_flush_ws: goto tok; case ':': - j = scm_read_token ('-', tok_buf, port, 0); - p = scm_intern (SCM_CHARS (*tok_buf), j); - if (SCM_PORT_REPRESENTATION (port) != scm_regular_port) - scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T); - return scm_make_keyword_from_dash_symbol (SCM_CAR (p)); - + if (SCM_PACK (SCM_KEYWORD_STYLE) == scm_keyword_prefix) + { + j = scm_read_token ('-', tok_buf, port, 0); + p = scm_intern (SCM_CHARS (*tok_buf), j); + return scm_make_keyword_from_dash_symbol (SCM_CAR (p)); + } + /* fallthrough */ default: j = scm_read_token (c, tok_buf, port, 0); /* fallthrough */ tok: p = scm_intern (SCM_CHARS (*tok_buf), j); - if (SCM_PORT_REPRESENTATION (port) != scm_regular_port) - scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T); return SCM_CAR (p); } } @@ -531,11 +514,7 @@ _Pragma ("noopt"); /* # pragma _CRI noopt */ #endif scm_sizet -scm_read_token (ic, tok_buf, port, weird) - int ic; - SCM *tok_buf; - SCM port; - int weird; +scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) { register scm_sizet j; register int c; @@ -549,29 +528,17 @@ scm_read_token (ic, tok_buf, port, weird) else { j = 0; - while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf)) + while (j + 2 >= SCM_LENGTH (*tok_buf)) p = scm_grow_tok_buf (tok_buf); - if (SCM_PORT_REPRESENTATION(port) == scm_regular_port) - { - p[j] = c; - ++j; - } - else - { - int len; - len = xwctomb (p + j, c); - if (len == 0) - len = 1; - SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read"); - j += len; - } + p[j] = c; + ++j; } while (1) { - while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf)) + while (j + 2 >= SCM_LENGTH (*tok_buf)) p = scm_grow_tok_buf (tok_buf); - c = scm_gen_getc (port); + c = scm_getc (port); switch (c) { case '(': @@ -583,7 +550,7 @@ scm_read_token (ic, tok_buf, port, weird) if (weird) goto default_case; - scm_gen_ungetc (c, port); + scm_ungetc (c, port); case EOF: eof_case: p[j] = 0; @@ -593,7 +560,7 @@ scm_read_token (ic, tok_buf, port, weird) goto default_case; else { - c = scm_gen_getc (port); + c = scm_getc (port); if (c == EOF) goto eof_case; else @@ -603,7 +570,7 @@ scm_read_token (ic, tok_buf, port, weird) if (!weird) goto default_case; - c = scm_gen_getc (port); + c = scm_getc (port); if (c == '#') { p[j] = 0; @@ -611,7 +578,7 @@ scm_read_token (ic, tok_buf, port, weird) } else { - scm_gen_ungetc (c, port); + scm_ungetc (c, port); c = '}'; goto default_case; } @@ -620,20 +587,8 @@ scm_read_token (ic, tok_buf, port, weird) default_case: { c = (SCM_CASE_INSENSITIVE_P ? scm_downcase(c) : c); - if (SCM_PORT_REPRESENTATION(port) == scm_regular_port) - { - p[j] = c; - ++j; - } - else - { - int len; - len = xwctomb (p + j, c); - if (len == 0) - len = 1; - SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read"); - j += len; - } + p[j] = c; + ++j; } } @@ -645,11 +600,7 @@ _Pragma ("opt"); /* # pragma _CRI opt */ #endif SCM -scm_lreadparen (tok_buf, port, name, copy) - SCM *tok_buf; - SCM port; - char *name; - SCM *copy; +scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy) { SCM tmp; SCM tl; @@ -659,8 +610,8 @@ scm_lreadparen (tok_buf, port, name, copy) c = scm_flush_ws (port, name); if (')' == c) return SCM_EOL; - scm_gen_ungetc (c, port); - if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy))) + scm_ungetc (c, port); + if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy))) { ans = scm_lreadr (tok_buf, port, copy); closeit: @@ -671,8 +622,8 @@ scm_lreadparen (tok_buf, port, name, copy) ans = tl = scm_cons (tmp, SCM_EOL); while (')' != (c = scm_flush_ws (port, name))) { - scm_gen_ungetc (c, port); - if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy))) + scm_ungetc (c, port); + if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy))) { SCM_SETCDR (tl, scm_lreadr (tok_buf, port, copy)); goto closeit; @@ -685,11 +636,7 @@ scm_lreadparen (tok_buf, port, name, copy) SCM -scm_lreadrecparen (tok_buf, port, name, copy) - SCM *tok_buf; - SCM port; - char *name; - SCM *copy; +scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) { register int c; register SCM tmp; @@ -702,8 +649,8 @@ scm_lreadrecparen (tok_buf, port, name, copy) c = scm_flush_ws (port, name); if (')' == c) return SCM_EOL; - scm_gen_ungetc (c, port); - if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy))) + scm_ungetc (c, port); + if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy))) { ans = scm_lreadr (tok_buf, port, copy); if (')' != (c = scm_flush_ws (port, name))) @@ -713,18 +660,18 @@ scm_lreadrecparen (tok_buf, port, name, copy) /* Build the head of the list structure. */ ans = tl = scm_cons (tmp, SCM_EOL); if (SCM_COPY_SOURCE_P) - ans2 = tl2 = scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) + ans2 = tl2 = scm_cons (SCM_CONSP (tmp) ? *copy : tmp, SCM_EOL); while (')' != (c = scm_flush_ws (port, name))) { - scm_gen_ungetc (c, port); - if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy))) + scm_ungetc (c, port); + if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy))) { SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy)); if (SCM_COPY_SOURCE_P) - SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) + SCM_SETCDR (tl2, scm_cons (SCM_CONSP (tmp) ? *copy : tmp, SCM_EOL)); @@ -734,7 +681,7 @@ scm_lreadrecparen (tok_buf, port, name, copy) } tl = SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL)); if (SCM_COPY_SOURCE_P) - tl2 = SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) + tl2 = SCM_SETCDR (tl2, scm_cons (SCM_CONSP (tmp) ? *copy : tmp, SCM_EOL)); @@ -755,24 +702,23 @@ exit: -/* Register a procedure for extended # object processing and the character - that will trigger it. */ -SCM_PROC (s_read_hash_extend, "read-hash-extend", 2, 0, 0, scm_read_hash_extend); -SCM -scm_read_hash_extend (chr, proc) - SCM chr; - SCM proc; +/* Manipulate the read-hash-procedures alist. This could be written in + Scheme, but maybe it will also be used by C code during initialisation. */ +SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, + (SCM chr, SCM proc), +"") +#define FUNC_NAME s_scm_read_hash_extend { SCM this; SCM prev; - SCM_ASSERT (SCM_ICHRP(chr), chr, SCM_ARG1, s_read_hash_extend); + SCM_VALIDATE_CHAR (1,chr); SCM_ASSERT (SCM_FALSEP (proc) || SCM_NIMP(proc), proc, SCM_ARG2, - s_read_hash_extend); + FUNC_NAME); - /* See it this chr is already in the alist. */ - this = SCM_CDR (scm_read_hash_procedures); - prev = scm_read_hash_procedures; + /* Check if chr is already in the alist. */ + this = *scm_read_hash_procedures; + prev = SCM_BOOL_F; while (1) { if (SCM_NULLP (this)) @@ -780,9 +726,8 @@ scm_read_hash_extend (chr, proc) /* not found, so add it to the beginning. */ if (SCM_NFALSEP (proc)) { - scm_set_cdr_x (scm_read_hash_procedures, - scm_cons (scm_cons (chr, proc), - SCM_CDR (scm_read_hash_procedures))); + *scm_read_hash_procedures = + scm_cons (scm_cons (chr, proc), *scm_read_hash_procedures); } break; } @@ -790,9 +735,21 @@ scm_read_hash_extend (chr, proc) { /* already in the alist. */ if (SCM_FALSEP (proc)) - scm_set_cdr_x (prev, SCM_CDR (this)); /* remove it. */ + { + /* remove it. */ + if (prev == SCM_BOOL_F) + { + *scm_read_hash_procedures = + SCM_CDR (*scm_read_hash_procedures); + } + else + scm_set_cdr_x (prev, SCM_CDR (this)); + } else - scm_set_cdr_x (SCM_CAR (this), proc); /* replace it. */ + { + /* replace it. */ + scm_set_cdr_x (SCM_CAR (this), proc); + } break; } prev = this; @@ -801,20 +758,20 @@ scm_read_hash_extend (chr, proc) return SCM_UNSPECIFIED; } +#undef FUNC_NAME /* Recover the read-hash procedure corresponding to char c. */ static SCM -scm_get_hash_procedure (c) - int c; +scm_get_hash_procedure (int c) { - SCM rest = SCM_CDR (scm_read_hash_procedures); + SCM rest = *scm_read_hash_procedures; while (1) { if (SCM_NULLP (rest)) return SCM_BOOL_F; - if (SCM_ICHR (SCM_CAAR (rest)) == c) + if (SCM_CHAR (SCM_CAAR (rest)) == c) return SCM_CDAR (rest); rest = SCM_CDR (rest); @@ -824,9 +781,15 @@ scm_get_hash_procedure (c) void scm_init_read () { - scm_read_hash_procedures = scm_cons (SCM_BOOL_F, SCM_EOL); - scm_permanent_object (scm_read_hash_procedures); + scm_read_hash_procedures = + SCM_CDRLOC (scm_sysintern ("read-hash-procedures", SCM_EOL)); scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS); #include "read.x" } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/