guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 02/04: primitive-read handles only default reader option


From: Andy Wingo
Subject: [Guile-commits] 02/04: primitive-read handles only default reader options
Date: Wed, 3 Mar 2021 16:33:17 -0500 (EST)

wingo pushed a commit to branch master
in repository guile.

commit 38abf6b247f7c8c3c73c5d288c9b79c06c34cce7
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Wed Mar 3 22:17:16 2021 +0100

    primitive-read handles only default reader options
    
    * libguile/read.c: Remove support for all non-default reader options.
    Also remove support for source positions.  The idea is that
    primitive-read should just be a stripped-down, easy-to-understand reader
    that is enough to bootstrap the C reader.  Probably more refactoring
    will follow.
---
 libguile/read.c | 778 +++++++++-----------------------------------------------
 1 file changed, 122 insertions(+), 656 deletions(-)

diff --git a/libguile/read.c b/libguile/read.c
index 1d7ca78..fd5ba47 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -69,16 +69,9 @@
 
 
 SCM_GLOBAL_SYMBOL (scm_sym_dot, ".");
-SCM_SYMBOL (scm_keyword_prefix, "prefix");
-SCM_SYMBOL (scm_keyword_postfix, "postfix");
 SCM_SYMBOL (sym_nil, "nil");
 SCM_SYMBOL (sym_ISO_8859_1, "ISO-8859-1");
 
-/* 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, "positions", 1,
@@ -100,47 +93,6 @@ scm_t_option scm_read_opts[] =
     { 0, },
   };
  
-/* Internal read options structure.  This is initialized by 'scm_read'
-   from the global and per-port read options, and a pointer is passed
-   down to all helper functions. */
-
-enum t_keyword_style
-  {
-    KEYWORD_STYLE_HASH_PREFIX,
-    KEYWORD_STYLE_PREFIX,
-    KEYWORD_STYLE_POSTFIX
-  };
-
-struct t_read_opts
-{
-  enum t_keyword_style keyword_style;
-  unsigned int record_positions_p   : 1;
-  unsigned int case_insensitive_p   : 1;
-  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;
-
-
-/*
-  Give meaningful error messages for errors
-
-  We use the format
-
-  FILE:LINE:COL: MESSAGE
-  This happened in ....
-
-  This is not standard GNU format, but the test-suite likes the real
-  message to be in front.
-
- */
-
-
 void
 scm_i_input_error (char const *function,
                   SCM port, const char *message, SCM arg)
@@ -179,22 +131,6 @@ SCM_DEFINE (scm_read_options, "read-options-interface", 0, 
1, 0,
 }
 #undef FUNC_NAME
 
-/* A fluid referring to an association list mapping extra hash
-   characters to procedures.  */
-static SCM *scm_i_read_hash_procedures;
-
-static SCM
-scm_i_read_hash_procedures_ref (void)
-{
-  return scm_fluid_ref (*scm_i_read_hash_procedures);
-}
-
-static void
-scm_i_read_hash_procedures_set_x (SCM value)
-{
-  scm_fluid_set_x (*scm_i_read_hash_procedures, value);
-}
-
 
 /* Token readers.  */
 
@@ -233,9 +169,7 @@ scm_i_read_hash_procedures_set_x (SCM value)
 
 #define CHAR_IS_DELIMITER(c)                                    \
   (CHAR_IS_R5RS_DELIMITER (c)                                   \
-   || (((c) == ']' || (c) == '[') && (opts->square_brackets_p   \
-                                      || opts->curly_infix_p))  \
-   || (((c) == '}' || (c) == '{') && opts->curly_infix_p))
+   || (((c) == ']' || (c) == '[')))
 
 /* Exponent markers, as defined in section 7.1.1 of R5RS, ``Lexical
    Structure''.  */
@@ -246,8 +180,8 @@ scm_i_read_hash_procedures_set_x (SCM value)
 /* Read an SCSH block comment.  */
 static SCM scm_read_scsh_block_comment (scm_t_wchar, SCM);
 static SCM scm_read_r6rs_block_comment (scm_t_wchar, SCM);
-static SCM scm_read_commented_expression (scm_t_wchar, SCM, scm_t_read_opts *);
-static SCM scm_read_shebang (scm_t_wchar, SCM, scm_t_read_opts *);
+static SCM scm_read_commented_expression (scm_t_wchar, SCM);
+static SCM scm_read_shebang (scm_t_wchar, SCM);
 static SCM scm_get_hash_procedure (int);
 
 /* Read from PORT until a delimiter (e.g., a whitespace) is read.  Put the
@@ -255,8 +189,7 @@ static SCM scm_get_hash_procedure (int);
    fewer than BUF_SIZE bytes, non-zero otherwise. READ will be set the number 
of
    bytes actually read.  */
 static int
-read_token (SCM port, scm_t_read_opts *opts,
-            char *buf, size_t buf_size, size_t *read)
+read_token (SCM port, char *buf, size_t buf_size, size_t *read)
 {
    *read = 0;
 
@@ -286,8 +219,7 @@ read_token (SCM port, scm_t_read_opts *opts,
 /* Like `read_token', but return either BUFFER, or a GC-allocated buffer
    if the token doesn't fit in BUFFER_SIZE bytes.  */
 static char *
-read_complete_token (SCM port, scm_t_read_opts *opts,
-                     char *buffer, size_t buffer_size, size_t *read)
+read_complete_token (SCM port, char *buffer, size_t buffer_size, size_t *read)
 {
   int overflow = 0;
   size_t bytes_read, overflow_size = 0;
@@ -295,7 +227,7 @@ read_complete_token (SCM port, scm_t_read_opts *opts,
 
   do
     {
-      overflow = read_token (port, opts, buffer, buffer_size, &bytes_read);
+      overflow = read_token (port, buffer, buffer_size, &bytes_read);
       if (bytes_read == 0)
         break;
       if (overflow || overflow_size != 0)
@@ -332,7 +264,7 @@ read_complete_token (SCM port, scm_t_read_opts *opts,
 /* Skip whitespace from PORT and return the first non-whitespace character
    read.  Raise an error on end-of-file.  */
 static int
-flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
+flush_ws (SCM port, const char *eoferr)
 {
   scm_t_wchar c;
   while (1)
@@ -369,10 +301,10 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char 
*eoferr)
            eoferr = "read_sharp";
            goto goteof;
          case '!':
-           scm_read_shebang (c, port, opts);
+           scm_read_shebang (c, port);
            break;
          case ';':
-           scm_read_commented_expression (c, port, opts);
+           scm_read_commented_expression (c, port);
            break;
          case '|':
            if (scm_is_false (scm_get_hash_procedure (c)))
@@ -403,60 +335,32 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char 
*eoferr)
 
 /* Token readers.  */
 
-static SCM scm_read_expression (SCM port, scm_t_read_opts *opts);
-static SCM scm_read_sharp (int chr, SCM port, scm_t_read_opts *opts,
-                           SCM line, SCM column);
+static SCM scm_read_expression (SCM port);
+static SCM scm_read_sharp (int chr, SCM port, SCM line, SCM column);
 
 
 static SCM
-maybe_annotate_source (SCM x, SCM port, scm_t_read_opts *opts,
-                       SCM line, SCM column)
-{
-  if ((SCM_I_INUMP (line) && SCM_I_INUM (line) < 0)
-      || (SCM_I_INUMP (column) && SCM_I_INUM (column) < 1))
-    /* This condition can be caused by a user calling
-       set-port-column!.  */
-    return x;
-
-  if (opts->record_positions_p)
-    {
-      /* We always capture the column after one char of lookahead;
-         subtract off that lookahead value.  */
-      column = scm_oneminus (column);
-      scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port));
-    }
-  return x;
-}
-
-static SCM
-scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
+scm_read_sexp (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_i_lreadparen"
 {
   int c;
   SCM tmp, tl, ans = SCM_EOL;
-  const int curly_list_p = (chr == '{') && opts->curly_infix_p;
-  const int terminating_char = ((chr == '{') ? '}'
-                                : ((chr == '[') ? ']'
-                                   : ')'));
+  const int terminating_char = (chr == '[') ? ']' : ')';
 
-  /* Need to capture line and column numbers here. */
-  SCM line = scm_port_line (port);
-  SCM column = scm_port_column (port);
-
-  c = flush_ws (port, opts, FUNC_NAME);
+  c = flush_ws (port, FUNC_NAME);
   if (terminating_char == c)
     return SCM_EOL;
 
   scm_ungetc (c, port);
-  tmp = scm_read_expression (port, opts);
+  tmp = scm_read_expression (port);
 
   /* Note that it is possible for scm_read_expression to return
      scm_sym_dot, but not as part of a dotted pair: as in #{.}#.  So
      check that it's a real dot by checking `c'.  */
   if (c == '.' && scm_is_eq (scm_sym_dot, tmp))
     {
-      ans = scm_read_expression (port, opts);
-      if (terminating_char != (c = flush_ws (port, opts, FUNC_NAME)))
+      ans = scm_read_expression (port);
+      if (terminating_char != (c = flush_ws (port, FUNC_NAME)))
        scm_i_input_error (FUNC_NAME, port, "missing close paren",
                           SCM_EOL);
       return ans;
@@ -465,25 +369,24 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts 
*opts)
   /* Build the head of the list structure. */
   ans = tl = scm_cons (tmp, SCM_EOL);
 
-  while (terminating_char != (c = flush_ws (port, opts, FUNC_NAME)))
+  while (terminating_char != (c = flush_ws (port, FUNC_NAME)))
     {
       SCM new_tail;
 
-      if (c == ')' || (c == ']' && opts->square_brackets_p)
-          || ((c == '}' || c == ']') && opts->curly_infix_p))
+      if (c == ')' || c == ']')
         scm_i_input_error (FUNC_NAME, port,
                            "in pair: mismatched close paren: ~A",
                            scm_list_1 (SCM_MAKE_CHAR (c)));
 
       scm_ungetc (c, port);
-      tmp = scm_read_expression (port, opts);
+      tmp = scm_read_expression (port);
 
       /* See above note about scm_sym_dot.  */
       if (c == '.' && scm_is_eq (scm_sym_dot, tmp))
        {
-         SCM_SETCDR (tl, scm_read_expression (port, opts));
+         SCM_SETCDR (tl, scm_read_expression (port));
 
-         c = flush_ws (port, opts, FUNC_NAME);
+         c = flush_ws (port, FUNC_NAME);
          if (terminating_char != c)
            scm_i_input_error (FUNC_NAME, port,
                               "in pair: missing close paren", SCM_EOL);
@@ -495,60 +398,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts 
*opts)
       tl = new_tail;
     }
 
-  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);
+  return ans;
 }
 #undef FUNC_NAME
 
@@ -587,27 +437,11 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts 
*opts)
         }                                                          \
     } while (0)
 
-static void
-skip_intraline_whitespace (SCM port)
-{
-  scm_t_wchar c;
-  
-  do
-    {
-      c = scm_getc (port);
-      if (c == EOF)
-        return;
-    }
-  while (c == '\t' || uc_is_general_category (c, UC_SPACE_SEPARATOR));
-
-  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_like_syntax (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_string_like_syntax (int chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   /* For strings smaller than C_STR, this function creates only one Scheme
@@ -617,10 +451,6 @@ scm_read_string_like_syntax (int chr, SCM port, 
scm_t_read_opts *opts)
   size_t c_str_len = 0;
   scm_t_wchar c, c_str[READER_STRING_BUFFER_SIZE];
 
-  /* Need to capture line and column numbers here. */
-  SCM line = scm_port_line (port);
-  SCM column = scm_port_column (port);
-
   while (chr != (c = scm_getc (port)))
     {
       if (c == EOF)
@@ -652,8 +482,6 @@ scm_read_string_like_syntax (int chr, SCM port, 
scm_t_read_opts *opts)
                          lisp modes.  */
               break;
             case '\n':
-              if (opts->hungry_eol_escapes_p)
-                skip_intraline_whitespace (port);
               continue;
             case '0':
               c = '\0';
@@ -680,23 +508,14 @@ scm_read_string_like_syntax (int chr, SCM port, 
scm_t_read_opts *opts)
               c = '\010';
               break;
             case 'x':
-              if (opts->r6rs_escapes_p || chr == '|')
-                SCM_READ_HEX_ESCAPE (10, ';');
-              else
-                SCM_READ_HEX_ESCAPE (2, '\0');
+              SCM_READ_HEX_ESCAPE (2, '\0');
               break;
             case 'u':
-              if (!opts->r6rs_escapes_p)
-                {
-                  SCM_READ_HEX_ESCAPE (4, '\0');
-                  break;
-                }
+              SCM_READ_HEX_ESCAPE (4, '\0');
+              break;
             case 'U':
-              if (!opts->r6rs_escapes_p)
-                {
-                  SCM_READ_HEX_ESCAPE (6, '\0');
-                  break;
-                }
+              SCM_READ_HEX_ESCAPE (6, '\0');
+              break;
             default:
               if (c == chr)
                 break;
@@ -721,35 +540,25 @@ scm_read_string_like_syntax (int chr, SCM port, 
scm_t_read_opts *opts)
       str = scm_string_concatenate_reverse (str, SCM_UNDEFINED, SCM_UNDEFINED);
     }
 
-  return maybe_annotate_source (str, port, opts, line, column);
+  return str;
 }
 #undef FUNC_NAME
 
 static SCM
-scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_string (int chr, SCM port)
 {
-  return scm_read_string_like_syntax (chr, port, opts);
+  return scm_read_string_like_syntax (chr, port);
 }
 
 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)
+scm_read_number (scm_t_wchar chr, SCM port)
 {
   SCM result, str = SCM_EOL;
   char local_buffer[READER_BUFFER_SIZE], *buffer;
   size_t bytes_read;
 
-  /* Need to capture line and column numbers here. */
-  SCM line = scm_port_line (port);
-  SCM column = scm_port_column (port);
-
   scm_ungetc (chr, port);
-  buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
                                &bytes_read);
 
   str = scm_from_port_stringn (buffer, bytes_read, port);
@@ -758,12 +567,8 @@ scm_read_number (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
   if (scm_is_false (result))
     {
       /* Return a symbol instead of a number */
-      if (opts->case_insensitive_p)
-        str = scm_string_downcase_x (str);
       result = scm_string_to_symbol (str);
     }
-  else if (SCM_NIMP (result))
-    result = maybe_annotate_source (result, port, opts, line, column);
 
   scm_set_port_column_x (port,
                          scm_sum (scm_port_column (port),
@@ -772,37 +577,19 @@ scm_read_number (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
 }
 
 static SCM
-scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
+scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
 {
   SCM result;
-  int ends_with_colon = 0;
   size_t bytes_read;
-  int postfix = (opts->keyword_style == KEYWORD_STYLE_POSTFIX);
   char local_buffer[READER_BUFFER_SIZE], *buffer;
   SCM str;
 
   scm_ungetc (chr, port);
-  buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
                                &bytes_read);
-  if (bytes_read > 0)
-    ends_with_colon = buffer[bytes_read - 1] == ':';
-
-  if (postfix && ends_with_colon && (bytes_read > 1))
-    {
-      str = scm_from_port_stringn (buffer, bytes_read - 1, port);
-
-      if (opts->case_insensitive_p)
-        str = scm_string_downcase_x (str);
-      result = scm_symbol_to_keyword (scm_string_to_symbol (str));
-    }
-  else
-    {
-      str = scm_from_port_stringn (buffer, bytes_read, port);
 
-      if (opts->case_insensitive_p)
-        str = scm_string_downcase_x (str);
-      result = scm_string_to_symbol (str);
-    }
+  str = scm_from_port_stringn (buffer, bytes_read, port);
+  result = scm_string_to_symbol (str);
 
   scm_set_port_column_x (port,
                          scm_sum (scm_port_column (port),
@@ -811,7 +598,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
 }
 
 static SCM
-scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
+scm_read_number_and_radix (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
@@ -848,7 +635,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
       radix = 10;
     }
 
-  buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
                                &read);
 
   str = scm_from_port_stringn (buffer, read, port);
@@ -869,11 +656,9 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
 #undef FUNC_NAME
 
 static SCM
-scm_read_quote (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_quote (int chr, SCM port)
 {
   SCM p;
-  SCM line = scm_port_line (port);
-  SCM column = scm_port_column (port);
 
   switch (chr)
     {
@@ -906,8 +691,7 @@ scm_read_quote (int chr, SCM port, scm_t_read_opts *opts)
       abort ();
     }
 
-  p = scm_cons2 (p, scm_read_expression (port, opts), SCM_EOL);
-  return maybe_annotate_source (p, port, opts, line, column);
+  return scm_cons2 (p, scm_read_expression (port), SCM_EOL);
 }
 
 SCM_SYMBOL (sym_syntax, "syntax");
@@ -916,11 +700,9 @@ SCM_SYMBOL (sym_unsyntax, "unsyntax");
 SCM_SYMBOL (sym_unsyntax_splicing, "unsyntax-splicing");
 
 static SCM
-scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_syntax (int chr, SCM port)
 {
   SCM p;
-  SCM line = scm_port_line (port);
-  SCM column = scm_port_column (port);
 
   switch (chr)
     {
@@ -953,14 +735,13 @@ scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts)
       abort ();
     }
 
-  p = scm_cons2 (p, scm_read_expression (port, opts), SCM_EOL);
-  return maybe_annotate_source (p, port, opts, line, column);
+  return scm_cons2 (p, scm_read_expression (port), SCM_EOL);
 }
 
 static SCM
-scm_read_nil (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_nil (int chr, SCM port)
 {
-  SCM id = scm_read_mixed_case_symbol (chr, port, opts);
+  SCM id = scm_read_mixed_case_symbol (chr, port);
 
   if (!scm_is_eq (id, sym_nil))
     scm_i_input_error ("scm_read_nil", port,
@@ -1045,7 +826,7 @@ scm_read_boolean (int chr, SCM port)
 }
 
 static SCM
-scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
+scm_read_character (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   char buffer[READER_CHAR_NAME_MAX_SIZE];
@@ -1055,7 +836,7 @@ scm_read_character (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
   int overflow;
   scm_t_port *pt;
 
-  overflow = read_token (port, opts, buffer, READER_CHAR_NAME_MAX_SIZE,
+  overflow = read_token (port, buffer, READER_CHAR_NAME_MAX_SIZE,
                          &bytes_read);
   if (overflow)
     scm_i_input_error (FUNC_NAME, port, "character name too long", SCM_EOL);
@@ -1155,7 +936,7 @@ scm_read_character (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
 #undef FUNC_NAME
 
 static SCM
-scm_read_keyword (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_keyword (int chr, SCM port)
 {
   SCM symbol;
 
@@ -1164,7 +945,7 @@ scm_read_keyword (int chr, SCM port, scm_t_read_opts *opts)
      to adapt to the delimiters currently valid of symbols.
 
      XXX: This implementation allows sloppy syntaxes like `#:  key'.  */
-  symbol = scm_read_expression (port, opts);
+  symbol = scm_read_expression (port);
   if (!scm_is_symbol (symbol))
     scm_i_input_error ("scm_read_keyword", port,
                       "keyword prefix `~a' not followed by a symbol: ~s",
@@ -1174,15 +955,13 @@ scm_read_keyword (int chr, SCM port, scm_t_read_opts 
*opts)
 }
 
 static SCM
-scm_read_vector (int chr, SCM port, scm_t_read_opts *opts,
-                 SCM line, SCM column)
+scm_read_vector (int chr, SCM port, SCM line, SCM column)
 {
   /* Note: We call `scm_read_sexp ()' rather than READER here in order to
      guarantee that it's going to do what we want.  After all, this is an
      implementation detail of `scm_read_vector ()', not a desirable
      property.  */
-  return maybe_annotate_source (scm_vector (scm_read_sexp (chr, port, opts)),
-                                port, opts, line, column);
+  return scm_vector (scm_read_sexp (chr, port));
 }
 
 /* Helper used by scm_read_array */
@@ -1220,19 +999,19 @@ read_decimal_integer (SCM port, int c, ssize_t *resp)
 
    C is the first character read after the '#'. */
 static SCM
-scm_read_array (int c, SCM port, scm_t_read_opts *opts, SCM line, SCM column)
+scm_read_array (int c, SCM port, SCM line, SCM column)
 {
   ssize_t rank;
   scm_t_wchar tag_buf[8];
   int tag_len;
 
-  SCM tag, shape = SCM_BOOL_F, elements, array;
+  SCM tag, shape = SCM_BOOL_F, elements;
 
   /* 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. */
   if (c == '(')
-    return scm_read_vector (c, port, opts, line, column);
+    return scm_read_vector (c, port, line, column);
 
   /* Disambiguate between '#f' and uniform floating point vectors. */
   if (c == 'f')
@@ -1319,7 +1098,7 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, 
SCM line, SCM column)
     scm_i_input_error (NULL, port,
                       "missing '(' in vector or array literal",
                       SCM_EOL);
-  elements = scm_read_sexp (c, port, opts);
+  elements = scm_read_sexp (c, port);
 
   if (scm_is_false (shape))
     shape = scm_from_ssize_t (rank);
@@ -1345,20 +1124,17 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, 
SCM line, SCM column)
     }
 
   /* Construct array, annotate with source location, and return. */
-  array = scm_list_to_typed_array (tag, shape, elements);
-  return maybe_annotate_source (array, port, opts, line, column);
+  return scm_list_to_typed_array (tag, shape, elements);
 }
 
 static SCM
-scm_read_srfi4_vector (int chr, SCM port, scm_t_read_opts *opts,
-                       SCM line, SCM column)
+scm_read_srfi4_vector (int chr, SCM port, SCM line, SCM column)
 {
-  return scm_read_array (chr, port, opts, line, column);
+  return scm_read_array (chr, port, line, column);
 }
 
 static SCM
-scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
-                     SCM line, SCM column)
+scm_read_bytevector (scm_t_wchar chr, SCM port, SCM line, SCM column)
 {
   chr = scm_getc (port);
   if (chr != 'u')
@@ -1372,9 +1148,7 @@ scm_read_bytevector (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts,
   if (chr != '(')
     goto syntax;
 
-  return maybe_annotate_source
-    (scm_u8_list_to_bytevector (scm_read_sexp (chr, port, opts)),
-     port, opts, line, column);
+  return scm_u8_list_to_bytevector (scm_read_sexp (chr, port));
 
  syntax:
   scm_i_input_error ("read_bytevector", port,
@@ -1384,8 +1158,7 @@ scm_read_bytevector (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts,
 }
 
 static SCM
-scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
-                           SCM line, SCM column)
+scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, SCM line, SCM column)
 {
   /* Read the `#*10101'-style read syntax for bit vectors in Guile.  This is
      terribly inefficient but who cares?  */
@@ -1401,9 +1174,7 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts,
   if (chr != EOF)
     scm_ungetc (chr, port);
 
-  return maybe_annotate_source
-    (scm_list_to_bitvector (scm_reverse_x (s_bits, SCM_EOL)),
-     port, opts, line, column);
+  return scm_list_to_bitvector (scm_reverse_x (s_bits, SCM_EOL));
 }
 
 static SCM
@@ -1430,21 +1201,8 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
   return SCM_UNSPECIFIED;
 }
 
-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 void set_port_r6rs_hex_escapes_p (SCM port, scm_t_read_opts *opts,
-                                         int value);
-static void set_port_hungry_eol_escapes_p (SCM port, scm_t_read_opts *opts,
-                                           int value);
-static void set_port_keyword_style (SCM port, scm_t_read_opts *opts,
-                                    enum t_keyword_style value);
-
 static SCM
-scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
+scm_read_shebang (scm_t_wchar chr, SCM port)
 {
   char name[READER_DIRECTIVE_NAME_MAX_SIZE + 1];
   int c;
@@ -1462,29 +1220,15 @@ scm_read_shebang (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
         {
           scm_ungetc (c, port);
           name[i] = '\0';
-          if (0 == strcmp ("r6rs", name))
-            {
-              set_port_case_insensitive_p (port, opts, 0);
-              set_port_r6rs_hex_escapes_p (port, opts, 1);
-              set_port_square_brackets_p (port, opts, 1);
-              set_port_keyword_style (port, opts, KEYWORD_STYLE_HASH_PREFIX);
-              set_port_hungry_eol_escapes_p (port, opts, 1);
-            }
-          else if (0 == strcmp ("fold-case", name))
-            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;
+          if (0 == strcmp ("r6rs", name)
+              || 0 == strcmp ("fold-case", name)
+              || 0 == strcmp ("no-fold-case", name)
+              || 0 == strcmp ("curly-infix", name)
+              || 0 == strcmp ("curly-infix-and-bracket-lists", name))
+            scm_i_input_error ("skip_block_comment", port,
+                               "unsupported directive: ~s",
+                               scm_list_1 (scm_from_latin1_string (name)));
+          break;
         }
       else
         {
@@ -1536,17 +1280,16 @@ scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port)
 }
 
 static SCM
-scm_read_commented_expression (scm_t_wchar chr, SCM port,
-                               scm_t_read_opts *opts)
+scm_read_commented_expression (scm_t_wchar chr, SCM port)
 {
   scm_t_wchar c;
   
-  c = flush_ws (port, opts, (char *) NULL);
+  c = flush_ws (port, (char *) NULL);
   if (EOF == c)
     scm_i_input_error ("read_commented_expression", port,
                        "no expression after #; comment", SCM_EOL);
   scm_ungetc (c, port);
-  scm_read_expression (port, opts);
+  scm_read_expression (port);
   return SCM_UNSPECIFIED;
 }
 
@@ -1646,25 +1389,13 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
 /* Top-level token readers, i.e., dispatchers.  */
 
 static SCM
-scm_read_sharp_extension (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_sharp_extension (int chr, SCM port)
 {
   SCM proc;
 
   proc = scm_get_hash_procedure (chr);
   if (scm_is_true (scm_procedure_p (proc)))
-    {
-      SCM line = scm_port_line (port);
-      SCM column = scm_oneminus (scm_port_column (port));
-      SCM got;
-
-      got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port);
-
-      if (opts->record_positions_p && SCM_NIMP (got)
-          && !scm_i_has_source_properties (got))
-        scm_i_set_source_properties_x (got, line, column, SCM_FILENAME (port));
-      
-      return got;
-    }
+    return scm_call_2 (proc, SCM_MAKE_CHAR (chr), port);
 
   return SCM_UNSPECIFIED;
 }
@@ -1672,44 +1403,43 @@ scm_read_sharp_extension (int chr, SCM port, 
scm_t_read_opts *opts)
 /* The reader for the sharp `#' character.  It basically dispatches reads
    among the above token readers.   */
 static SCM
-scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
-                SCM line, SCM column)
+scm_read_sharp (scm_t_wchar chr, SCM port, SCM line, SCM column)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
 
   chr = scm_getc (port);
 
-  result = scm_read_sharp_extension (chr, port, opts);
+  result = scm_read_sharp_extension (chr, port);
   if (!scm_is_eq (result, SCM_UNSPECIFIED))
     return result;
 
   switch (chr)
     {
     case '\\':
-      return (scm_read_character (chr, port, opts));
+      return (scm_read_character (chr, port));
     case '(':
-      return (scm_read_vector (chr, port, opts, line, column));
+      return (scm_read_vector (chr, port, line, column));
     case 's':
     case 'u':
     case 'f':
     case 'c':
       /* This one may return either a boolean or an SRFI-4 vector.  */
-      return (scm_read_srfi4_vector (chr, port, opts, line, column));
+      return (scm_read_srfi4_vector (chr, port, line, column));
     case 'v':
-      return (scm_read_bytevector (chr, port, opts, line, column));
+      return (scm_read_bytevector (chr, port, line, column));
     case '*':
-      return (scm_read_guile_bit_vector (chr, port, opts, line, column));
+      return (scm_read_guile_bit_vector (chr, port, line, column));
     case 't':
     case 'T':
     case 'F':
       return (scm_read_boolean (chr, port));
     case ':':
-      return (scm_read_keyword (chr, port, opts));
+      return (scm_read_keyword (chr, port));
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
     case '@':
-      return (scm_read_array (chr, port, opts, line, column));
+      return (scm_read_array (chr, port, line, column));
 
     case 'i':
     case 'e':
@@ -1723,21 +1453,21 @@ scm_read_sharp (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts,
     case 'X':
     case 'I':
     case 'E':
-      return (scm_read_number_and_radix (chr, port, opts));
+      return (scm_read_number_and_radix (chr, port));
     case '{':
       return (scm_read_extended_symbol (chr, port));
     case '!':
-      return (scm_read_shebang (chr, port, opts));
+      return (scm_read_shebang (chr, port));
     case ';':
-      return (scm_read_commented_expression (chr, port, opts));
+      return (scm_read_commented_expression (chr, port));
     case '`':
     case '\'':
     case ',':
-      return (scm_read_syntax (chr, port, opts));
+      return (scm_read_syntax (chr, port));
     case 'n':
-      return (scm_read_nil (chr, port, opts));
+      return (scm_read_nil (chr, port));
     default:
-      result = scm_read_sharp_extension (chr, port, opts);
+      result = scm_read_sharp_extension (chr, port);
       if (scm_is_eq (result, SCM_UNSPECIFIED))
        {
          /* To remain compatible with 1.8 and earlier, the following
@@ -1761,8 +1491,8 @@ scm_read_sharp (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts,
 #undef FUNC_NAME
 
 static SCM
-read_inner_expression (SCM port, scm_t_read_opts *opts)
-#define FUNC_NAME "read_inner_expression"
+scm_read_expression (SCM port)
+#define FUNC_NAME "scm_read_expression"
 {
   while (1)
     {
@@ -1776,62 +1506,22 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
        case SCM_LINE_INCREMENTORS:
          break;
        case ';':
-         (void) scm_read_semicolon_comment (chr, port);
+         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_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$ ...) */
-              SCM line = scm_port_line (port);
-              SCM column = scm_port_column (port);
-              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));
+          return scm_read_sexp (chr, port);
        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);
+         return scm_read_string (chr, port);
        case '\'':
        case '`':
        case ',':
-         return (scm_read_quote (chr, port, opts));
+         return scm_read_quote (chr, port);
        case '#':
          {
             SCM line = scm_port_line (port);
             SCM column = scm_port_column (port);
-           SCM result = scm_read_sharp (chr, port, opts, line, column);
+           SCM result = scm_read_sharp (chr, port, line, column);
            if (scm_is_eq (result, SCM_UNSPECIFIED))
              /* We read a comment or some such.  */
              break;
@@ -1841,108 +1531,28 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
        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);
-          /* otherwise fall through */
+          scm_i_input_error (FUNC_NAME, port, "unexpected \"]\"", SCM_EOL);
+          break;
        case EOF:
          return SCM_EOF_VAL;
-       case ':':
-         if (opts->keyword_style == KEYWORD_STYLE_PREFIX)
-           return scm_symbol_to_keyword (scm_read_expression (port, opts));
-         /* Fall through.  */
 
        default:
          {
            if (((chr >= '0') && (chr <= '9'))
                || (strchr ("+-.", chr)))
-             return (scm_read_number (chr, port, opts));
+             return scm_read_number (chr, port);
            else
-             return (scm_read_mixed_case_symbol (chr, port, opts));
+             return scm_read_mixed_case_symbol (chr, port);
          }
        }
     }
 }
 #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
-    {
-      SCM line = SCM_INUM0;
-      SCM column = SCM_INUM1;
-      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;
-          line = scm_port_line (port);
-          column = scm_port_column (port);
-          scm_ungetc (c, 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
-
 
 /* Actual reader.  */
 
-static void init_read_options (SCM port, scm_t_read_opts *opts);
-
 SCM_DEFINE (scm_primitive_read, "primitive-read", 0, 1, 0,
             (SCM port),
            "Read an s-expression from the input port @var{port}, or from\n"
@@ -1950,21 +1560,18 @@ SCM_DEFINE (scm_primitive_read, "primitive-read", 0, 1, 
0,
            "Any whitespace before the next token is discarded.")
 #define FUNC_NAME s_scm_primitive_read
 {
-  scm_t_read_opts opts;
   int c;
 
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   SCM_VALIDATE_OPINPORT (1, port);
 
-  init_read_options (port, &opts);
-
-  c = flush_ws (port, &opts, (char *) NULL);
+  c = flush_ws (port, (char *) NULL);
   if (EOF == c)
     return SCM_EOF_VAL;
   scm_ungetc (c, port);
 
-  return (scm_read_expression (port, &opts));
+  return scm_read_expression (port);
 }
 #undef FUNC_NAME
 
@@ -1984,6 +1591,22 @@ scm_read (SCM port)
 
 
 
+/* A fluid referring to an association list mapping extra hash
+   characters to procedures.  */
+static SCM *scm_i_read_hash_procedures;
+
+static SCM
+scm_i_read_hash_procedures_ref (void)
+{
+  return scm_fluid_ref (*scm_i_read_hash_procedures);
+}
+
+static void
+scm_i_read_hash_procedures_set_x (SCM value)
+{
+  scm_fluid_set_x (*scm_i_read_hash_procedures, value);
+}
+
 /* 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,
@@ -2242,163 +1865,6 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
 #undef FUNC_NAME
 
 
-/* Per-port read options.
-
-   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
-   global read option.  Otherwise, the bit field contains the value of
-   the read option.  For boolean read options that have been set
-   per-port, the possible values are 0 or 1.  If the 'keyword_style'
-   read option has been set per-port, its possible values are those in
-   'enum t_keyword_style'. */
-
-/* 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_RECORD_POSITIONS_P     0
-#define READ_OPTION_CASE_INSENSITIVE_P     2
-#define READ_OPTION_KEYWORD_STYLE          4
-#define READ_OPTION_R6RS_ESCAPES_P         6
-#define READ_OPTION_SQUARE_BRACKETS_P      8
-#define READ_OPTION_HUNGRY_EOL_ESCAPES_P  10
-#define READ_OPTION_CURLY_INFIX_P         12
-#define READ_OPTION_R7RS_SYMBOLS_P        14
-
-/* The total width in bits of the per-port overrides */
-#define READ_OPTIONS_NUM_BITS             16
-
-#define READ_OPTIONS_INHERIT_ALL  ((1UL << READ_OPTIONS_NUM_BITS) - 1)
-#define READ_OPTIONS_MAX_VALUE    READ_OPTIONS_INHERIT_ALL
-
-#define READ_OPTION_MASK     3
-#define READ_OPTION_INHERIT  3
-
-static void
-set_port_read_option (SCM port, int option, int new_value)
-{
-  SCM scm_read_options;
-  unsigned int read_options;
-
-  new_value &= READ_OPTION_MASK;
-
-  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_OPTIONS_INHERIT_ALL;
-  read_options &= ~(READ_OPTION_MASK << option);
-  read_options |= new_value << option;
-  scm_read_options = scm_from_uint (read_options);
-  scm_i_set_port_property_x (port, sym_port_read_options, scm_read_options);
-}
-
-/* Set OPTS and PORT's case-insensitivity according to VALUE. */
-static void
-set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts, int value)
-{
-  value = !!value;
-  opts->case_insensitive_p = 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);
-}
-
-/* Set OPTS and PORT's r6rs_hex_escapes_p option according to VALUE. */
-static void
-set_port_r6rs_hex_escapes_p (SCM port, scm_t_read_opts *opts, int value)
-{
-  value = !!value;
-  opts->r6rs_escapes_p = value;
-  set_port_read_option (port, READ_OPTION_R6RS_ESCAPES_P, value);
-}
-
-static void
-set_port_hungry_eol_escapes_p (SCM port, scm_t_read_opts *opts, int value)
-{
-  value = !!value;
-  opts->hungry_eol_escapes_p = value;
-  set_port_read_option (port, READ_OPTION_HUNGRY_EOL_ESCAPES_P, value);
-}
-
-static void
-set_port_keyword_style (SCM port, scm_t_read_opts *opts, enum t_keyword_style 
value)
-{
-  opts->keyword_style = value;
-  set_port_read_option (port, READ_OPTION_KEYWORD_STYLE, 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 val, scm_read_options;
-  unsigned int read_options, x;
-
-  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_OPTIONS_INHERIT_ALL;
-
-  x = READ_OPTION_MASK & (read_options >> READ_OPTION_KEYWORD_STYLE);
-  if (x == READ_OPTION_INHERIT)
-    {
-      val = SCM_PACK (SCM_KEYWORD_STYLE);
-      if (scm_is_eq (val, scm_keyword_prefix))
-        x = KEYWORD_STYLE_PREFIX;
-      else if (scm_is_eq (val, scm_keyword_postfix))
-        x = KEYWORD_STYLE_POSTFIX;
-      else
-        x = KEYWORD_STYLE_HASH_PREFIX;
-    }
-  opts->keyword_style = x;
-
-#define RESOLVE_BOOLEAN_OPTION(NAME, name)                              \
-  do                                                                    \
-    {                                                                   \
-      x = READ_OPTION_MASK & (read_options >> READ_OPTION_ ## NAME);    \
-      if (x == READ_OPTION_INHERIT)                                     \
-        x = !!SCM_ ## NAME;                                             \
-          opts->name = x;                                               \
-    }                                                                   \
-  while (0)
-
-  RESOLVE_BOOLEAN_OPTION (RECORD_POSITIONS_P,   record_positions_p);
-  RESOLVE_BOOLEAN_OPTION (CASE_INSENSITIVE_P,   case_insensitive_p);
-  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
 scm_init_read ()



reply via email to

[Prev in Thread] Current Thread [Next in Thread]