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

[Ludovic Courtès]

Hi Neil,

Thanks for your detailed analysis of the `load' procedure stack.

Neil Jerram <address@hidden> writes:

> So one possibility for adding custom reader support to all this is...
>
> - Don't put any current-reader framing code in primitive-load.  In
>   other words, don't reset current-reader to #f (or anything else) at
>   the start of primitive-load, and don't use framing to restore the
>   value of the current-reader at the end if the loaded code has
>   changed it.  This means that primitive-load keeps its existing
>   primitiveness - i.e. it isn't much more than just a read eval loop.
>
> - Add an optional reader arg to both r4rs's load and boot-9's
>   load-module, and treat as #f if not specified.  In r4rs load, do
>   (with-fluids ((the-reader reader)) ...) around the existing code.  In
>   load-module, just pass the reader through to basic-load.
>
> This would preserve existing behaviour for any calls to load or
> use-modules, which are the mainline cases, even when the caller has
> installed a non-default reader, but it also allows developers to
> achieve different behaviour when they want it by using primitive-load
> and the optional reader arg to load.

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!  ;-)

Thanks,
Ludovic.

PS: I can prepare ChangeLog entries if it looks good to commit.


--- orig/doc/ref/api-evaluation.texi
+++ mod/doc/ref/api-evaluation.texi
@@ -409,12 +409,21 @@
 @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.  If @var{reader} is
+provided, then it should be either @code{#f}, in which case the
+built-in @code{read} procedure (@pxref{Scheme Read}) is used to load
+the file, or a reader procedure to use when reading data from file
address@hidden  Such a reader procedure must work like @code{read}
+(@pxref{Scheme Read}).
+
+The Scheme code in file @var{filename} may change the reader procedure
+used by @code{load} using @code{set-current-reader} (see below).
+
+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
@@ -431,6 +440,8 @@
 @code{%load-hook} is defined, it should be bound to a procedure
 that will be called before any code is loaded.  See the
 documentation for @code{%load-hook} later in this section.
+The reader procedure used to read the file named @var{filename} is the
+one specified using @code{set-current-reader} (see below).
 @end deffn
 
 @deffn {Scheme Procedure} primitive-load-path filename
@@ -475,6 +486,23 @@
 The load port is used internally by @code{primitive-load}.
 @end deffn
 
address@hidden {Scheme Procedure} current-reader
address@hidden {C Function} scm_current_reader ()
+Return the reader procedure used by @code{primitive-load} (and
address@hidden) during the dynamic extent of the current frame (see
address@hidden Wind}, and @pxref{Frames}).
address@hidden deffn
+
address@hidden {Scheme Procedure} set-current-reader reader
address@hidden {C Function} scm_set_current_reader (reader)
+During the dynamic extent of the current frame, set the reader
+procedure used by @code{primitive-load} (and @code{load}) to
address@hidden  If @var{reader} is a procedure, is must follow the
+interface of @code{read} (@pxref{Scheme Read}).  If @var{reader} is
address@hidden, it is assumed that Guile's built-in @code{read} procedure
+will be used.
address@hidden deffn
+
 @defvar %load-extensions
 A list of default file extensions for files containing Scheme code.
 @code{%search-load-path} tries each of these extensions when looking for


--- orig/ice-9/boot-9.scm
+++ mod/ice-9/boot-9.scm
@@ -1185,7 +1185,8 @@
   (make-record-type 'module
                    '(obarray uses binder eval-closure transformer name kind
                      duplicates-handlers duplicates-interface
-                     observers weak-observers observer-id)
+                     observers weak-observers observer-id
+                     reader)
                    %print-module))
 
 ;; make-module &opt size uses binder
@@ -1221,7 +1222,9 @@
                                          uses binder #f #f #f #f #f #f
                                          '()
                                          (make-weak-value-hash-table 31)
-                                         0)))
+                                         0
+                                         #f ;; the default reader
+                                         )))
 
          ;; We can't pass this as an argument to module-constructor,
          ;; because we need it to close over a pointer to the module
@@ -1247,6 +1250,8 @@
 (define set-module-name! (record-modifier module-type 'name))
 (define module-kind (record-accessor module-type 'kind))
 (define set-module-kind! (record-modifier module-type 'kind))
+(define module-reader (record-accessor module-type 'reader))
+(define set-module-reader! (record-modifier module-type 'reader))
 (define module-duplicates-handlers
   (record-accessor module-type 'duplicates-handlers))
 (define set-module-duplicates-handlers!
@@ -1633,19 +1638,28 @@
                    (set-current-module outer-module)
                    (set! outer-module #f)))))
 
+;; Rename R4RS' `load'.
 (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)))))
+                        (port-filename (current-load-port))))
+          (reader (if (null? reader)
+                      #f
+                      (if (null? (cdr reader))
+                          (car reader)
+                          (scm-error 'wrong-number-of-args "load-module"
+                                     "too many arguments: ~A"
+                                     (list reader) #f)))))
        (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))))))
+                      filename)
+                  reader)))))
 
 
 
@@ -2042,10 +2056,22 @@
          (call-with-deferred-observers
           (lambda ()
             (module-use-interfaces! module (reverse reversed-interfaces))
+            ;; Evaluate the `#:reader' argument in the context of the module
+            ;; being defined.
+            (set-module-reader! module
+                                (eval (module-reader module) module))
             (module-export! module exports)
             (module-replace! module replacements)
             (module-re-export! module re-exports)))
          (case (car kws)
+           ((#:reader)
+            ;; The argument to `#:reader' will be evaluated eventually.
+            (set-module-reader! module (cadr kws))
+            (loop (cddr kws)
+                  reversed-interfaces
+                  exports
+                  re-exports
+                  replacements))
            ((#:use-module #:use-syntax)
             (or (pair? (cdr kws))
                 (unrecognized kws))
@@ -2138,7 +2164,7 @@
                    (set-car! (memq a (module-uses module)) i)
                    (module-local-variable i sym))))))
     (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f #f
-                       '() (make-weak-value-hash-table 31) 0)))
+                       '() (make-weak-value-hash-table 31) 0 read)))
 
 ;;; {Compiled module}
 
@@ -2538,7 +2564,7 @@
     (display prompt)
     (force-output)
     (run-hook before-read-hook)
-    (read (current-input-port))))
+    ((or (current-reader) read) (current-input-port))))
 
 (define (scm-style-repl)
 
@@ -2851,6 +2877,7 @@
      (let ((m (process-define-module
               (list ,@(compile-define-module-args args)))))
        (set-current-module m)
+       (set-current-reader (module-reader m))
        m))
     (else
      (error "define-module can only be used at the top level"))))


--- orig/ice-9/r4rs.scm
+++ mod/ice-9/r4rs.scm
@@ -206,6 +206,19 @@
 
 (set! %load-hook %load-announce)
 
-(define (load name)
-  (start-stack 'load-stack
-              (primitive-load name)))
+(define (load name . reader)
+  (let ((previous-reader (current-reader))
+       (reader (if (null? reader)
+                   #f ;; use the built-in reader
+                   (if (null? (cdr reader))
+                       (car reader)
+                       (scm-error 'wrong-number-of-args "load-module"
+                                  "too many arguments: ~A"
+                                  (list reader) #f)))))
+    (dynamic-wind
+       (lambda () (set-current-reader reader))
+       (lambda ()
+         (start-stack 'load-stack
+                      (primitive-load name)))
+       (lambda () (set-current-reader previous-reader)))))
+


--- orig/libguile/load.c
+++ mod/libguile/load.c
@@ -42,6 +42,7 @@
 
 #include "libguile/validate.h"
 #include "libguile/load.h"
+#include "libguile/fluids.h"
 
 #include <sys/types.h>
 #include <sys/stat.h>
@@ -55,13 +56,59 @@
 #endif
 
 
+/* The current reader (a fluid).  */
+
+static SCM the_reader = SCM_BOOL_F;
+static size_t the_reader_fluid_num = 0;
+
+#define CURRENT_READER()  SCM_FAST_FLUID_REF (the_reader_fluid_num)
+#define SET_CURRENT_READER(_val)                       \
+do                                                     \
+{                                                      \
+  SCM_FAST_FLUID_SET_X (the_reader_fluid_num, (_val)); \
+}                                                      \
+while (0)
+
+
+SCM_DEFINE (scm_current_reader, "current-reader", 0, 0, 0,
+           (void),
+           "Return the current reader.")
+#define FUNC_NAME s_scm_current_reader
+{
+  return CURRENT_READER ();
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_current_reader, "set-current-reader", 1, 0, 0,
+           (SCM reader),
+           "Set the current reader to @var{reader} and return the "
+           "previous current reader.")
+#define FUNC_NAME s_scm_set_current_reader
+{
+  SCM previous;
+
+  /* The value `#f' is a special allowed value for READER which means ``use
+     Guile's built-in reader''.  See how `primitive-load' uses it as an
+     optimization.  */
+  if (reader != SCM_BOOL_F)
+    SCM_VALIDATE_PROC (1, reader);
+
+  previous = CURRENT_READER ();
+  SET_CURRENT_READER (reader);
+
+  return previous;
+}
+#undef FUNC_NAME
+
+
+
 /* Loading a file, given an absolute filename.  */
 
 /* Hook to run when we load a file, perhaps to announce the fact somewhere.
    Applied to the full name of the file.  */
 static SCM *scm_loc_load_hook;
 
-SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 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"
            "the top-level environment. The load paths are not searched;\n"
@@ -88,9 +135,19 @@
 
     while (1)
       {
-       SCM form = scm_read (port);
+       SCM reader, form;
+
+       /* Use whatever the current reader is.  */
+       reader = CURRENT_READER ();
+
+       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);
       }
 
@@ -501,6 +558,10 @@
                                                  scm_nullstr)));
   scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", 
SCM_BOOL_F));
 
+  the_reader = scm_permanent_object (scm_make_fluid ());
+  the_reader_fluid_num = SCM_FLUID_NUM (the_reader);
+  SET_CURRENT_READER (SCM_BOOL_F);
+
   init_build_info ();
 
 #include "libguile/load.x"


--- orig/libguile/load.h
+++ mod/libguile/load.h
@@ -38,6 +38,9 @@
 SCM_API SCM scm_c_primitive_load_path (const char *filename);
 SCM_API void scm_init_load (void);
 
+SCM_API SCM scm_current_reader (void);
+SCM_API SCM scm_set_current_reader (SCM reader);
+
 #endif  /* SCM_LOAD_H */
 
 /*


--- orig/libguile/modules.h
+++ mod/libguile/modules.h
@@ -45,6 +45,7 @@
 #define scm_module_index_binder                2
 #define scm_module_index_eval_closure  3
 #define scm_module_index_transformer   4
+#define scm_module_index_reader        12
 
 #define SCM_MODULE_OBARRAY(module) \
   SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_obarray])
@@ -56,6 +57,8 @@
   SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
 #define SCM_MODULE_TRANSFORMER(module) \
   SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_transformer])
+#define SCM_MODULE_READER(module) \
+  SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_reader])
 
 SCM_API scm_t_bits scm_tc16_eval_closure;