[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-54-g9331ffd

[Mark H Weaver]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=9331ffd891d03bc736f98bf92628b4b2fa714e68

The branch, stable-2.0 has been updated
       via  9331ffd891d03bc736f98bf92628b4b2fa714e68 (commit)
       via  ea8c97615590ec60f2df0f7f356b04aa0a174eef (commit)
      from  851c3cd16e6b9caee069581aa34e198d1df14c71 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 9331ffd891d03bc736f98bf92628b4b2fa714e68
Author: Mark H Weaver <address@hidden>
Date:   Wed Oct 24 14:37:36 2012 -0400

    Implement #!fold-case and #!no-fold-case reader directives.
    
    * libguile/read.c (set_port_case_insensitive_p): New function.
    
      (scm_read_shebang): Handle #!fold-case and #!no-fold-case.
    
    * doc/ref/api-evaluation.texi (Case Sensitivity, Scheme Read): Document
      the #!fold-case and #!no-fold-case reader directives.
    
    * test-suite/tests/reader.test ("per-port-read-options"): Add tests.

commit ea8c97615590ec60f2df0f7f356b04aa0a174eef
Author: Mark H Weaver <address@hidden>
Date:   Tue Oct 23 17:28:43 2012 -0400

    Implement per-port read options.
    
    * libguile/read.c (scm_t_read_opts): Update comment to mention the
      per-port read options.
    
      (sym_port_read_options): New variable.
    
      (set_port_read_option): New function.
    
      (init_read_options): Add new 'port' parameter, and consult the
      per-port read option overrides when initializing the 'scm_t_read_opts'
      struct.  Move to bottom of file.
    
      (scm_read): Pass 'port' parameter to init_read_options.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-evaluation.texi  |   22 ++++--
 libguile/read.c              |  177 +++++++++++++++++++++++++++++++++---------
 test-suite/tests/reader.test |   13 +++
 3 files changed, 167 insertions(+), 45 deletions(-)

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 6112832..c7bf97a 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -254,6 +254,8 @@ Encoding of Source Files}.
 
 @node Case Sensitivity
 @subsubsection Case Sensitivity
address@hidden fold-case
address@hidden no-fold-case
 
 @c FIXME::martin: Review me!
 
@@ -275,9 +277,9 @@ options, @xref{Scheme Read}.
 (read-enable 'case-insensitive)
 @end lisp
 
-Note that this is seldom a problem, because Scheme programmers tend not
-to use uppercase letters in their identifiers anyway.
-
+It is also possible to disable (or enable) case sensitivity within a
+single file by placing the reader directives @code{#!fold-case} (or
address@hidden) within the file itself.
 
 @node Keyword Syntax
 @subsubsection Keyword Syntax
@@ -315,10 +317,10 @@ its read options.
 @cindex options - read
 @cindex read options
 @deffn {Scheme Procedure} read-options [setting]
-Display the current settings of the read options.  If @var{setting} is
-omitted, only a short form of the current read options is printed.
-Otherwise if @var{setting} is the symbol @code{help}, a complete options
-description is displayed.
+Display the current settings of the global read options.  If
address@hidden is omitted, only a short form of the current read options
+is printed.  Otherwise if @var{setting} is the symbol @code{help}, a
+complete options description is displayed.
 @end deffn
 
 The set of available options, and their default values, may be had by
@@ -338,6 +340,12 @@ hungry-eol-escapes no   In strings, consume leading 
whitespace after an
                         escaped end-of-line.
 @end smalllisp
 
+Note that Guile also includes a preliminary mechanism for setting read
+options on a per-port basis.  For instance, the @code{case-insensitive}
+read option is set (or unset) on the port when the reader encounters the
address@hidden or @code{#!no-fold-case} reader directives.  There is
+currently no other way to access or set the per-port read options.
+
 The boolean options may be toggled with @code{read-enable} and
 @code{read-disable}. The non-boolean @code{keywords} option must be set
 using @code{read-set!}.
diff --git a/libguile/read.c b/libguile/read.c
index 6c91613..ec1d394 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -82,15 +82,18 @@ scm_t_option scm_read_opts[] = {
 };
  
 /* Internal read options structure.  This is initialized by 'scm_read'
-   from the global 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
-};
+   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 {
+struct t_read_opts
+{
   enum t_keyword_style keyword_style;
   unsigned int copy_source_p        : 1;
   unsigned int record_positions_p   : 1;
@@ -102,35 +105,6 @@ struct t_read_opts {
 
 typedef struct t_read_opts scm_t_read_opts;
 
-/* Initialize OPTS from the global read options. */
-static void
-init_read_options (scm_t_read_opts *opts)
-{
-  SCM val;
-  int x;
-
-  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)      \
-  (opts->name = !!SCM_ ## NAME)
-
-  RESOLVE_BOOLEAN_OPTION (COPY_SOURCE_P,        copy_source_p);
-  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);
-
-#undef RESOLVE_BOOLEAN_OPTION
-}
-
 
 /*
   Give meaningful error messages for errors
@@ -1305,6 +1279,9 @@ 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 SCM
 scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 {
@@ -1326,6 +1303,10 @@ scm_read_shebang (scm_t_wchar chr, SCM port, 
scm_t_read_opts *opts)
           name[i] = '\0';
           if (0 == strcmp ("r6rs", name))
             ;  /* Silently ignore */
+          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
             break;
 
@@ -1692,6 +1673,8 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
 
 /* Actual reader.  */
 
+static void init_read_options (SCM port, scm_t_read_opts *opts);
+
 SCM_DEFINE (scm_read, "read", 0, 1, 0, 
             (SCM port),
            "Read an s-expression from the input port @var{port}, or from\n"
@@ -1706,7 +1689,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
     port = scm_current_input_port ();
   SCM_VALIDATE_OPINPORT (1, port);
 
-  init_read_options (&opts);
+  init_read_options (port, &opts);
 
   c = flush_ws (port, &opts, (char *) NULL);
   if (EOF == c)
@@ -1970,6 +1953,124 @@ 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' 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.
+
+   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 per-port alists. */
+SCM_SYMBOL (sym_port_read_options, "port-read-options");
+
+/* Offsets of bit fields for each per-port override */
+#define READ_OPTION_COPY_SOURCE_P          0
+#define READ_OPTION_RECORD_POSITIONS_P     2
+#define READ_OPTION_CASE_INSENSITIVE_P     4
+#define READ_OPTION_KEYWORD_STYLE          6
+#define READ_OPTION_R6RS_ESCAPES_P         8
+#define READ_OPTION_SQUARE_BRACKETS_P     10
+#define READ_OPTION_HUNGRY_EOL_ESCAPES_P  12
+
+#define READ_OPTIONS_NUM_BITS             14
+
+#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 alist, 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);
+  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);
+  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);
+}
+
+/* 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);
+}
+
+/* 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;
+  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);
+
+  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 (COPY_SOURCE_P,        copy_source_p);
+  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);
+
+#undef RESOLVE_BOOLEAN_OPTION
+}
+
 void
 scm_init_read ()
 {
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 60c853c..6e02255 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -401,6 +401,19 @@
         (lambda ()
           (read-disable 'hungry-eol-escapes))))))
 
+(with-test-prefix "per-port-read-options"
+  (pass-if "case-sensitive"
+    (equal? '(guile GuiLe gUIle)
+            (with-read-options '(case-insensitive)
+              (lambda ()
+                (with-input-from-string "GUIle #!no-fold-case GuiLe gUIle"
+                  (lambda ()
+                    (list (read) (read) (read))))))))
+  (pass-if "case-insensitive"
+    (equal? '(GUIle guile guile)
+            (with-input-from-string "GUIle #!fold-case GuiLe gUIle"
+              (lambda ()
+                (list (read) (read) (read)))))))
 
 (with-test-prefix "#;"
   (for-each


hooks/post-receive
-- 
GNU Guile