-/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2003, 2004, 2006,
- * 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1997, 1999-2001, 2003, 2004, 2006-2012, 2014
+ * 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 License
#include <unistd.h>
#include <unicase.h>
#include <unictype.h>
+#include <c-strcase.h>
+#include <c-ctype.h>
#include "libguile/_scm.h"
#include "libguile/bytevectors.h"
SCM_SYMBOL (scm_keyword_postfix, "postfix");
SCM_SYMBOL (sym_nil, "nil");
-scm_t_option scm_read_opts[] = {
- { SCM_OPTION_BOOLEAN, "copy", 0,
- "Copy source code expressions." },
- { SCM_OPTION_BOOLEAN, "positions", 1,
- "Record positions of source code expressions." },
- { SCM_OPTION_BOOLEAN, "case-insensitive", 0,
- "Convert symbols to lower case."},
- { SCM_OPTION_SCM, "keywords", (scm_t_bits) SCM_BOOL_F_BITS,
- "Style of keyword recognition: #f, 'prefix or 'postfix."},
- { SCM_OPTION_BOOLEAN, "r6rs-hex-escapes", 0,
- "Use R6RS variable-length character and string hex escapes."},
- { SCM_OPTION_BOOLEAN, "square-brackets", 1,
- "Treat `[' and `]' as parentheses, for R6RS compatibility."},
- { SCM_OPTION_BOOLEAN, "hungry-eol-escapes", 0,
- "In strings, consume leading whitespace after an escaped end-of-line."},
- { 0, },
-};
+/* SRFI-105 curly infix expression support */
+SCM_SYMBOL (sym_nfx, "$nfx$");
+SCM_SYMBOL (sym_bracket_list, "$bracket-list$");
+SCM_SYMBOL (sym_bracket_apply, "$bracket-apply$");
+
+scm_t_option scm_read_opts[] =
+ {
+ { SCM_OPTION_BOOLEAN, "copy", 0,
+ "Copy source code expressions." },
+ { SCM_OPTION_BOOLEAN, "positions", 1,
+ "Record positions of source code expressions." },
+ { SCM_OPTION_BOOLEAN, "case-insensitive", 0,
+ "Convert symbols to lower case."},
+ { SCM_OPTION_SCM, "keywords", (scm_t_bits) SCM_BOOL_F_BITS,
+ "Style of keyword recognition: #f, 'prefix or 'postfix."},
+ { SCM_OPTION_BOOLEAN, "r6rs-hex-escapes", 0,
+ "Use R6RS variable-length character and string hex escapes."},
+ { SCM_OPTION_BOOLEAN, "square-brackets", 1,
+ "Treat `[' and `]' as parentheses, for R6RS compatibility."},
+ { SCM_OPTION_BOOLEAN, "hungry-eol-escapes", 0,
+ "In strings, consume leading whitespace after an escaped end-of-line."},
+ { SCM_OPTION_BOOLEAN, "curly-infix", 0,
+ "Support SRFI-105 curly infix expressions."},
+ { SCM_OPTION_BOOLEAN, "r7rs-symbols", 0,
+ "Support R7RS |...| symbol notation."},
+ { 0, },
+ };
/* Internal read options structure. This is initialized by 'scm_read'
from the global and per-port read options, and a pointer is passed
unsigned int r6rs_escapes_p : 1;
unsigned int square_brackets_p : 1;
unsigned int hungry_eol_escapes_p : 1;
+ unsigned int curly_infix_p : 1;
+ unsigned int neoteric_p : 1;
+ unsigned int r7rs_symbols_p : 1;
};
typedef struct t_read_opts scm_t_read_opts;
#define CHAR_IS_DELIMITER(c) \
(CHAR_IS_R5RS_DELIMITER (c) \
- || (((c) == ']' || (c) == '[') && opts->square_brackets_p))
+ || (((c) == ']' || (c) == '[') && (opts->square_brackets_p \
+ || opts->curly_infix_p)) \
+ || (((c) == '}' || (c) == '{') && opts->curly_infix_p))
/* Exponent markers, as defined in section 7.1.1 of R5RS, ``Lexical
Structure''. */
{
int c;
SCM tmp, tl, ans = SCM_EOL;
- const int terminating_char = ((chr == '[') ? ']' : ')');
+ const int curly_list_p = (chr == '{') && opts->curly_infix_p;
+ const int terminating_char = ((chr == '{') ? '}'
+ : ((chr == '[') ? ']'
+ : ')'));
/* Need to capture line and column numbers here. */
long line = SCM_LINUM (port);
{
SCM new_tail;
- if (c == ')' || (c == ']' && opts->square_brackets_p))
+ if (c == ')' || (c == ']' && opts->square_brackets_p)
+ || ((c == '}' || c == ']') && opts->curly_infix_p))
scm_i_input_error (FUNC_NAME, port,
"in pair: mismatched close paren: ~A",
scm_list_1 (SCM_MAKE_CHAR (c)));
if (terminating_char != c)
scm_i_input_error (FUNC_NAME, port,
"in pair: missing close paren", SCM_EOL);
- goto exit;
+ break;
}
new_tail = scm_cons (tmp, SCM_EOL);
tl = new_tail;
}
- exit:
+ if (curly_list_p)
+ {
+ /* In addition to finding the length, 'scm_ilength' checks for
+ improper or circular lists, in which case it returns -1. */
+ int len = scm_ilength (ans);
+
+ /* The (len == 0) case is handled above */
+ if (len == 1)
+ /* Return directly to avoid re-annotating the element's source
+ location with the position of the outer brace. Also, it
+ might not be possible to annotate the element. */
+ return scm_car (ans); /* {e} => e */
+ else if (len == 2)
+ ; /* Leave the list unchanged: {e1 e2} => (e1 e2) */
+ else if (len >= 3 && (len & 1))
+ {
+ /* It's a proper list whose length is odd and at least 3. If
+ the elements at odd indices (the infix operator positions)
+ are all 'equal?', then it's a simple curly-infix list.
+ Otherwise it's a mixed curly-infix list. */
+ SCM op = scm_cadr (ans);
+
+ /* Check to see if the elements at odd indices are 'equal?' */
+ for (tl = scm_cdddr (ans); ; tl = scm_cddr (tl))
+ {
+ if (scm_is_null (tl))
+ {
+ /* Convert simple curly-infix list to prefix:
+ {a <op> b <op> ...} => (<op> a b ...) */
+ tl = ans;
+ while (scm_is_pair (scm_cdr (tl)))
+ {
+ tmp = scm_cddr (tl);
+ SCM_SETCDR (tl, tmp);
+ tl = tmp;
+ }
+ ans = scm_cons (op, ans);
+ break;
+ }
+ else if (scm_is_false (scm_equal_p (op, scm_car (tl))))
+ {
+ /* Mixed curly-infix list: {e ...} => ($nfx$ e ...) */
+ ans = scm_cons (sym_nfx, ans);
+ break;
+ }
+ }
+ }
+ else
+ /* Mixed curly-infix (possibly improper) list:
+ {e . tail} => ($nfx$ e . tail) */
+ ans = scm_cons (sym_nfx, ans);
+ }
+
return maybe_annotate_source (ans, port, opts, line, column);
}
#undef FUNC_NAME
scm_ungetc (c, port);
}
+/* Read either a double-quoted string or an R7RS-style symbol delimited
+ by vertical lines, depending on the value of 'chr' ('"' or '|').
+ Regardless, the result is always returned as a string. */
static SCM
-scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_string_like_syntax (int chr, SCM port, scm_t_read_opts *opts)
#define FUNC_NAME "scm_lreadr"
{
/* For strings smaller than C_STR, this function creates only one Scheme
long line = SCM_LINUM (port);
int column = SCM_COL (port) - 1;
- while ('"' != (c = scm_getc (port)))
+ while (chr != (c = scm_getc (port)))
{
if (c == EOF)
{
str_eof:
scm_i_input_error (FUNC_NAME, port,
- "end of file in string constant", SCM_EOL);
+ (chr == '|'
+ ? "end of file in symbol"
+ : "end of file in string constant"),
+ SCM_EOL);
}
if (c_str_len + 1 >= READER_STRING_BUFFER_SIZE)
{
case EOF:
goto str_eof;
- case '"':
+ case '|':
case '\\':
+ case '(': /* Accept "\(" for use at the beginning of lines
+ in multiline strings to avoid confusing emacs
+ lisp modes. */
break;
case '\n':
if (opts->hungry_eol_escapes_p)
c = '\010';
break;
case 'x':
- if (opts->r6rs_escapes_p)
+ if (opts->r6rs_escapes_p || chr == '|')
SCM_READ_HEX_ESCAPE (10, ';');
else
SCM_READ_HEX_ESCAPE (2, '\0');
break;
}
default:
+ if (c == chr)
+ break;
bad_escaped:
scm_i_input_error (FUNC_NAME, port,
"illegal character in escape sequence: ~S",
}
#undef FUNC_NAME
+static SCM
+scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
+{
+ return scm_read_string_like_syntax (chr, port, opts);
+}
+
+static SCM
+scm_read_r7rs_symbol (int chr, SCM port, scm_t_read_opts *opts)
+{
+ return scm_string_to_symbol (scm_read_string_like_syntax (chr, port, opts));
+}
static SCM
scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
return SCM_UNSPECIFIED;
}
+/* If the EXPECTED_CHARS are the next ones available from PORT, then
+ consume them and return 1. Otherwise leave the port position where
+ it was and return 0. EXPECTED_CHARS should be all lowercase, and
+ will be matched case-insensitively against the characters read from
+ PORT. */
+static int
+try_read_ci_chars (SCM port, const char *expected_chars)
+{
+ int num_chars_wanted = strlen (expected_chars);
+ int num_chars_read = 0;
+ char *chars_read = alloca (num_chars_wanted);
+ int c;
+
+ while (num_chars_read < num_chars_wanted)
+ {
+ c = scm_getc (port);
+ if (c == EOF)
+ break;
+ else if (c_tolower (c) != expected_chars[num_chars_read])
+ {
+ scm_ungetc (c, port);
+ break;
+ }
+ else
+ chars_read[num_chars_read++] = c;
+ }
+
+ if (num_chars_read == num_chars_wanted)
+ return 1;
+ else
+ {
+ while (num_chars_read > 0)
+ scm_ungetc (chars_read[--num_chars_read], port);
+ return 0;
+ }
+}
+
\f
/* Sharp readers, i.e. readers called after a `#' sign has been read. */
{
case 't':
case 'T':
+ try_read_ci_chars (port, "rue");
return SCM_BOOL_T;
case 'f':
case 'F':
+ try_read_ci_chars (port, "alse");
return SCM_BOOL_F;
}
while ('0' <= c && c <= '9')
{
+ if (((SSIZE_MAX - (c-'0')) / 10) <= res)
+ scm_i_input_error ("read_decimal_integer", port,
+ "number too large", SCM_EOL);
res = 10*res + c-'0';
got_it = 1;
c = scm_getc (port);
vectors. Also, the conflict between '#f' and '#f32' and '#f64' is
handled here.
- C is the first character read after the '#'.
-*/
+ C is the first character read after the '#'. */
static SCM
scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
{
/* XXX - shortcut for ordinary vectors. Shouldn't be necessary but
the array code can not deal with zero-length dimensions yet, and
- we want to allow zero-length vectors, of course.
- */
+ we want to allow zero-length vectors, of course. */
if (c == '(')
return scm_read_vector (c, port, opts, line, column);
- /* Disambiguate between '#f' and uniform floating point vectors.
- */
+ /* Disambiguate between '#f' and uniform floating point vectors. */
if (c == 'f')
{
c = scm_getc (port);
if (c != '3' && c != '6')
{
- if (c != EOF)
- scm_ungetc (c, port);
+ if (c == 'a' && try_read_ci_chars (port, "lse"))
+ return SCM_BOOL_F;
+ else if (c != EOF)
+ scm_ungetc (c, port);
return SCM_BOOL_F;
}
rank = 1;
static void set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts,
int value);
+static void set_port_square_brackets_p (SCM port, scm_t_read_opts *opts,
+ int value);
+static void set_port_curly_infix_p (SCM port, scm_t_read_opts *opts,
+ int value);
static SCM
scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
set_port_case_insensitive_p (port, opts, 1);
else if (0 == strcmp ("no-fold-case", name))
set_port_case_insensitive_p (port, opts, 0);
+ else if (0 == strcmp ("curly-infix", name))
+ set_port_curly_infix_p (port, opts, 1);
+ else if (0 == strcmp ("curly-infix-and-bracket-lists", name))
+ {
+ set_port_curly_infix_p (port, opts, 1);
+ set_port_square_brackets_p (port, opts, 0);
+ }
else
break;
return SCM_UNSPECIFIED;
}
+ else
+ {
+ scm_ungetc (c, port);
+ break;
+ }
}
while (i > 0)
scm_ungetc (name[--i], port);
#undef FUNC_NAME
static SCM
-scm_read_expression (SCM port, scm_t_read_opts *opts)
-#define FUNC_NAME "scm_read_expression"
+read_inner_expression (SCM port, scm_t_read_opts *opts)
+#define FUNC_NAME "read_inner_expression"
{
while (1)
{
case ';':
(void) scm_read_semicolon_comment (chr, port);
break;
+ case '{':
+ if (opts->curly_infix_p)
+ {
+ if (opts->neoteric_p)
+ return scm_read_sexp (chr, port, opts);
+ else
+ {
+ SCM expr;
+
+ /* Enable neoteric expressions within curly braces */
+ opts->neoteric_p = 1;
+ expr = scm_read_sexp (chr, port, opts);
+ opts->neoteric_p = 0;
+ return expr;
+ }
+ }
+ else
+ return scm_read_mixed_case_symbol (chr, port, opts);
case '[':
- if (!opts->square_brackets_p)
- return (scm_read_mixed_case_symbol (chr, port, opts));
- /* otherwise fall through */
+ if (opts->square_brackets_p)
+ return scm_read_sexp (chr, port, opts);
+ else if (opts->curly_infix_p)
+ {
+ /* The syntax of neoteric expressions requires that '[' be
+ a delimiter when curly-infix is enabled, so it cannot
+ be part of an unescaped symbol. We might as well do
+ something useful with it, so we adopt Kawa's convention:
+ [...] => ($bracket-list$ ...) */
+ long line = SCM_LINUM (port);
+ int column = SCM_COL (port) - 1;
+ return maybe_annotate_source
+ (scm_cons (sym_bracket_list, scm_read_sexp (chr, port, opts)),
+ port, opts, line, column);
+ }
+ else
+ return scm_read_mixed_case_symbol (chr, port, opts);
case '(':
return (scm_read_sexp (chr, port, opts));
case '"':
return (scm_read_string (chr, port, opts));
+ case '|':
+ if (opts->r7rs_symbols_p)
+ return scm_read_r7rs_symbol (chr, port, opts);
+ else
+ return scm_read_mixed_case_symbol (chr, port, opts);
case '\'':
case '`':
case ',':
case ')':
scm_i_input_error (FUNC_NAME, port, "unexpected \")\"", SCM_EOL);
break;
+ case '}':
+ if (opts->curly_infix_p)
+ scm_i_input_error (FUNC_NAME, port, "unexpected \"}\"", SCM_EOL);
+ else
+ return scm_read_mixed_case_symbol (chr, port, opts);
case ']':
if (opts->square_brackets_p)
scm_i_input_error (FUNC_NAME, port, "unexpected \"]\"", SCM_EOL);
}
#undef FUNC_NAME
+static SCM
+scm_read_expression (SCM port, scm_t_read_opts *opts)
+#define FUNC_NAME "scm_read_expression"
+{
+ if (!opts->neoteric_p)
+ return read_inner_expression (port, opts);
+ else
+ {
+ long line = 0;
+ int column = 0;
+ SCM expr;
+
+ if (opts->record_positions_p)
+ {
+ /* We need to get the position of the first non-whitespace
+ character in order to correctly annotate neoteric
+ expressions. For example, for the expression 'f(x)', the
+ first call to 'read_inner_expression' reads the 'f' (which
+ cannot be annotated), and then we later read the '(x)' and
+ use it to construct the new list (f x). */
+ int c = flush_ws (port, opts, (char *) NULL);
+ if (c == EOF)
+ return SCM_EOF_VAL;
+ scm_ungetc (c, port);
+ line = SCM_LINUM (port);
+ column = SCM_COL (port);
+ }
+
+ expr = read_inner_expression (port, opts);
+
+ /* 'expr' is the first component of the neoteric expression. Now
+ we loop, and as long as the next character is '(', '[', or '{',
+ (without any intervening whitespace), we use it to construct a
+ new expression. For example, f{n - 1}(x) => ((f (- n 1)) x). */
+ for (;;)
+ {
+ int chr = scm_getc (port);
+
+ if (chr == '(')
+ /* e(...) => (e ...) */
+ expr = scm_cons (expr, scm_read_sexp (chr, port, opts));
+ else if (chr == '[')
+ /* e[...] => ($bracket-apply$ e ...) */
+ expr = scm_cons (sym_bracket_apply,
+ scm_cons (expr,
+ scm_read_sexp (chr, port, opts)));
+ else if (chr == '{')
+ {
+ SCM arg = scm_read_sexp (chr, port, opts);
+
+ if (scm_is_null (arg))
+ expr = scm_list_1 (expr); /* e{} => (e) */
+ else
+ expr = scm_list_2 (expr, arg); /* e{...} => (e {...}) */
+ }
+ else
+ {
+ if (chr != EOF)
+ scm_ungetc (chr, port);
+ break;
+ }
+ maybe_annotate_source (expr, port, opts, line, column);
+ }
+ return expr;
+ }
+}
+#undef FUNC_NAME
+
\f
/* Actual reader. */
}
}
-#define SCM_ENCODING_SEARCH_SIZE (500)
+/* Maximum size of an encoding name. This is a bit more than the
+ longest name listed at
+ <http://www.iana.org/assignments/character-sets> ("ISO-2022-JP-2", 13
+ characters.) */
+#define ENCODING_NAME_MAX_SIZE 20
-/* Search the first few hundred characters of a file for an Emacs-like coding
- declaration. Returns either NULL or a string whose storage has been
- allocated with `scm_gc_malloc ()'. */
+/* Number of bytes at the beginning or end of a file that are scanned
+ for a "coding:" declaration. */
+#define SCM_ENCODING_SEARCH_SIZE (500 + ENCODING_NAME_MAX_SIZE)
+
+
+/* Search the SCM_ENCODING_SEARCH_SIZE bytes of a file for an Emacs-like
+ coding declaration. Returns either NULL or a string whose storage
+ has been allocated with `scm_gc_malloc'. */
char *
scm_i_scan_for_encoding (SCM port)
{
char header[SCM_ENCODING_SEARCH_SIZE+1];
size_t bytes_read, encoding_length, i;
char *encoding = NULL;
- int utf8_bom = 0;
char *pos, *encoding_start;
int in_comment;
scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
}
- if (bytes_read > 3
- && header[0] == '\xef' && header[1] == '\xbb' && header[2] == '\xbf')
- utf8_bom = 1;
-
/* search past "coding[:=]" */
pos = header;
while (1)
if ((pos = strstr(pos, "coding")) == NULL)
return NULL;
- pos += strlen("coding");
- if (pos - header >= SCM_ENCODING_SEARCH_SIZE ||
+ pos += strlen ("coding");
+ if (pos - header >= SCM_ENCODING_SEARCH_SIZE ||
(*pos == ':' || *pos == '='))
{
pos ++;
}
/* skip spaces */
- while (pos - header <= SCM_ENCODING_SEARCH_SIZE &&
+ while (pos - header <= SCM_ENCODING_SEARCH_SIZE &&
(*pos == ' ' || *pos == '\t'))
pos ++;
+ if (pos - header >= SCM_ENCODING_SEARCH_SIZE - ENCODING_NAME_MAX_SIZE)
+ /* We found the "coding:" string, but there is probably not enough
+ room to store an encoding name in its entirety, so ignore it.
+ This makes sure we do not end up returning a truncated encoding
+ name. */
+ return NULL;
+
/* grab the next token */
encoding_start = pos;
i = 0;
/* This wasn't in a comment */
return NULL;
- if (utf8_bom && strcmp(encoding, "UTF-8"))
- scm_misc_error (NULL,
- "the port input declares the encoding ~s but is encoded as UTF-8",
- scm_list_1 (scm_from_locale_string (encoding)));
-
return encoding;
}
\f
/* Per-port read options.
- We store per-port read options in the 'port-read-options' key of the
- port's alist, which is stored in 'scm_i_port_weak_hash'. The value
- stored in the alist is a single integer that contains a two-bit field
- for each read option.
+ We store per-port read options in the 'port-read-options' port
+ property, which is stored in the internal port structure. The value
+ stored is a single integer that contains a two-bit field for each
+ read option.
If a bit field contains READ_OPTION_INHERIT (3), that indicates that
the applicable value should be inherited from the corresponding
read option has been set per-port, its possible values are those in
'enum t_keyword_style'. */
-/* Key to read options in per-port alists. */
+/* Key to read options in port properties. */
SCM_SYMBOL (sym_port_read_options, "port-read-options");
/* Offsets of bit fields for each per-port override */
#define READ_OPTION_R6RS_ESCAPES_P 8
#define READ_OPTION_SQUARE_BRACKETS_P 10
#define READ_OPTION_HUNGRY_EOL_ESCAPES_P 12
+#define READ_OPTION_CURLY_INFIX_P 14
+#define READ_OPTION_R7RS_SYMBOLS_P 16
-#define READ_OPTIONS_NUM_BITS 14
+/* The total width in bits of the per-port overrides */
+#define READ_OPTIONS_NUM_BITS 18
#define READ_OPTIONS_INHERIT_ALL ((1UL << READ_OPTIONS_NUM_BITS) - 1)
#define READ_OPTIONS_MAX_VALUE READ_OPTIONS_INHERIT_ALL
static void
set_port_read_option (SCM port, int option, int new_value)
{
- SCM alist, scm_read_options;
+ SCM scm_read_options;
unsigned int read_options;
new_value &= READ_OPTION_MASK;
- scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
- alist = scm_hashq_ref (scm_i_port_weak_hash, port, SCM_BOOL_F);
- scm_read_options = scm_assq_ref (alist, sym_port_read_options);
+ scm_read_options = scm_i_port_property (port, sym_port_read_options);
if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
read_options = scm_to_uint (scm_read_options);
else
read_options &= ~(READ_OPTION_MASK << option);
read_options |= new_value << option;
scm_read_options = scm_from_uint (read_options);
- alist = scm_assq_set_x (alist, sym_port_read_options, scm_read_options);
- scm_hashq_set_x (scm_i_port_weak_hash, port, alist);
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+ scm_i_set_port_property_x (port, sym_port_read_options, scm_read_options);
}
/* Set OPTS and PORT's case-insensitivity according to VALUE. */
set_port_read_option (port, READ_OPTION_CASE_INSENSITIVE_P, value);
}
+/* Set OPTS and PORT's square_brackets_p option according to VALUE. */
+static void
+set_port_square_brackets_p (SCM port, scm_t_read_opts *opts, int value)
+{
+ value = !!value;
+ opts->square_brackets_p = value;
+ set_port_read_option (port, READ_OPTION_SQUARE_BRACKETS_P, value);
+}
+
+/* Set OPTS and PORT's curly_infix_p option according to VALUE. */
+static void
+set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, int value)
+{
+ value = !!value;
+ opts->curly_infix_p = value;
+ set_port_read_option (port, READ_OPTION_CURLY_INFIX_P, value);
+}
+
/* Initialize OPTS based on PORT's read options and the global read
options. */
static void
init_read_options (SCM port, scm_t_read_opts *opts)
{
- SCM alist, val, scm_read_options;
+ SCM val, scm_read_options;
unsigned int read_options, x;
- scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
- alist = scm_hashq_ref (scm_i_port_weak_hash, port, SCM_BOOL_F);
- scm_read_options = scm_assq_ref (alist, sym_port_read_options);
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+ scm_read_options = scm_i_port_property (port, sym_port_read_options);
if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
read_options = scm_to_uint (scm_read_options);
RESOLVE_BOOLEAN_OPTION (R6RS_ESCAPES_P, r6rs_escapes_p);
RESOLVE_BOOLEAN_OPTION (SQUARE_BRACKETS_P, square_brackets_p);
RESOLVE_BOOLEAN_OPTION (HUNGRY_EOL_ESCAPES_P, hungry_eol_escapes_p);
+ RESOLVE_BOOLEAN_OPTION (CURLY_INFIX_P, curly_infix_p);
+ RESOLVE_BOOLEAN_OPTION (R7RS_SYMBOLS_P, r7rs_symbols_p);
#undef RESOLVE_BOOLEAN_OPTION
+
+ opts->neoteric_p = 0;
}
void
HCoop / bpt / guile.git / blobdiff