Re: [PATCH] Per-module reader, take #3

[Neil Jerram]

address@hidden (Ludovic Courtès) writes:

> Agreed, this approach is consistent with the current `load' stack.
>
> The patch below does what you described.  I left the `#:reader' option
> to `define-module' as an alternative, higher-level approach to choosing
> an alternate reader.
>
> Please let me know what you think about it.  And sorry for consuming so
> much of your time!  ;-)

I still don't like the module option (no surprise there), and I think
that the other parts of the patch could be made a bit simpler (which
to my mind is a Good Thing).  To be completely concrete about what I
mean, here is a version of your patch which I prefer (untested except
by make check).  Please let me know what you think.

    Neil

Index: doc/ref/api-evaluation.texi
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/doc/ref/api-evaluation.texi,v
retrieving revision 1.5
diff -u -u -r1.5 api-evaluation.texi
--- doc/ref/api-evaluation.texi 2 Mar 2005 20:46:41 -0000       1.5
+++ doc/ref/api-evaluation.texi 16 Nov 2005 21:12:28 -0000
@@ -409,12 +409,24 @@
 @subsection Loading Scheme Code from File
 
 @rnindex load
address@hidden {Scheme Procedure} load filename
address@hidden {Scheme Procedure} load filename [reader]
 Load @var{filename} and evaluate its contents in the top-level
-environment.  The load paths are not searched.  If the variable
address@hidden is defined, it should be bound to a procedure that
-will be called before any code is loaded.  See documentation for
address@hidden later in this section.
+environment.  The load paths are not searched.
+
address@hidden if provided should be either @code{#f}, or a procedure with
+the signature @code{(lambda (port) @dots{})} which reads the next
+expression from @var{port}.  If @var{reader} is @code{#f} or absent,
+Guile's built-in @code{read} procedure is used (@pxref{Scheme Read}).
+
+The @var{reader} argument takes effect by setting the value of the
address@hidden fluid (see below) before loading the file, and
+restoring its previous value when loading is complete.  The Scheme code
+inside @var{filename} can itself change the current reader procedure on
+the fly by setting @code{current-reader} fluid.
+
+If the variable @code{%load-hook} is defined, it should be bound to a
+procedure that will be called before any code is loaded.  See
+documentation for @code{%load-hook} later in this section.
 @end deffn
 
 @deffn {Scheme Procedure} load-from-path filename
@@ -451,6 +463,15 @@
 in the @code{%load-extensions} list; @code{%search-load-path}
 will try each extension automatically.
 @end deffn
+
address@hidden current-reader
address@hidden holds the read procedure that is currently being
+used by the above loading procedures to read expressions (from the file
+that they are loading).  @code{current-reader} is a fluid, so it has an
+independent value in each dynamic root and should be read and set using
address@hidden and @code{fluid-set!} (@pxref{Fluids and Dynamic
+States}).
address@hidden defvar
 
 @defvar %load-hook
 A procedure to be called @code{(%load-hook @var{filename})} whenever a
Index: ice-9/boot-9.scm
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/ice-9/boot-9.scm,v
retrieving revision 1.351
diff -u -u -r1.351 boot-9.scm
--- ice-9/boot-9.scm    31 Jul 2005 23:36:50 -0000      1.351
+++ ice-9/boot-9.scm    16 Nov 2005 21:12:29 -0000
@@ -1635,17 +1635,19 @@
 
 (define basic-load load)
 
-(define (load-module filename)
+(define (load-module filename . reader)
   (save-module-excursion
    (lambda ()
      (let ((oldname (and (current-load-port)
                         (port-filename (current-load-port)))))
-       (basic-load (if (and oldname
-                           (> (string-length filename) 0)
-                           (not (char=? (string-ref filename 0) #\/))
-                           (not (string=? (dirname oldname) ".")))
-                      (string-append (dirname oldname) "/" filename)
-                      filename))))))
+       (apply basic-load
+             (if (and oldname
+                      (> (string-length filename) 0)
+                      (not (char=? (string-ref filename 0) #\/))
+                      (not (string=? (dirname oldname) ".")))
+                 (string-append (dirname oldname) "/" filename)
+                 filename)
+             reader)))))
 
 

Index: ice-9/r4rs.scm
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/ice-9/r4rs.scm,v
retrieving revision 1.17
diff -u -u -r1.17 r4rs.scm
--- ice-9/r4rs.scm      23 May 2005 19:57:19 -0000      1.17
+++ ice-9/r4rs.scm      16 Nov 2005 21:12:29 -0000
@@ -206,6 +206,8 @@
 
 (set! %load-hook %load-announce)
 
-(define (load name)
-  (start-stack 'load-stack
-              (primitive-load name)))
+(define (load name . reader)
+  (with-fluid* current-reader (and (pair? reader) (car reader))
+    (lambda ()
+      (start-stack 'load-stack
+                  (primitive-load name)))))
Index: libguile/load.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/load.c,v
retrieving revision 1.86
diff -u -u -r1.86 load.c
--- libguile/load.c     23 May 2005 19:57:20 -0000      1.86
+++ libguile/load.c     16 Nov 2005 21:12:29 -0000
@@ -42,6 +42,7 @@
 
 #include "libguile/validate.h"
 #include "libguile/load.h"
+#include "libguile/fluids.h"
 
 #include <sys/types.h>
 #include <sys/stat.h>
@@ -61,6 +62,10 @@
    Applied to the full name of the file.  */
 static SCM *scm_loc_load_hook;
 
+/* The current reader (a fluid).  */
+static SCM the_reader = SCM_BOOL_F;
+static size_t the_reader_fluid_num = 0;
+
 SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, 
            (SCM filename),
            "Load the file named @var{filename} and evaluate its contents in\n"
@@ -88,9 +93,19 @@
 
     while (1)
       {
-       SCM form = scm_read (port);
+       SCM reader, form;
+
+       /* Lookup and use the current reader to read the next
+          expression. */
+       reader = SCM_FAST_FLUID_REF (the_reader_fluid_num);
+       if (reader == SCM_BOOL_F)
+         form = scm_read (port);
+       else
+         form = scm_call_1 (reader, port);
+
        if (SCM_EOF_OBJECT_P (form))
          break;
+
        scm_primitive_eval_x (form);
       }
 
@@ -500,6 +515,11 @@
                                      scm_list_2 (scm_from_locale_string 
(".scm"),
                                                  scm_nullstr)));
   scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", 
SCM_BOOL_F));
+
+  the_reader = scm_make_fluid ();
+  the_reader_fluid_num = SCM_FLUID_NUM (the_reader);
+  SCM_FAST_FLUID_SET_X (the_reader_fluid_num, SCM_BOOL_F);
+  scm_c_define("current-reader", the_reader);
 
   init_build_info ();