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

[ludovic.courtes@laas.fr (Ludovic Courtès)]

Hi Neil,

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

Neil Jerram <neil@ossau.uklinux.net> 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
-@deffn {Scheme Procedure} load filename
+@deffn {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
-@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.
+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
+@var{filename}.  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
 
+@deffn {Scheme Procedure} current-reader
+@deffnx {C Function} scm_current_reader ()
+Return the reader procedure used by @code{primitive-load} (and
+@code{load}) during the dynamic extent of the current frame (see
+@xref{Dynamic Wind}, and @pxref{Frames}).
+@end deffn
+
+@deffn {Scheme Procedure} set-current-reader reader
+@deffnx {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
+@var{reader}.  If @var{reader} is a procedure, is must follow the
+interface of @code{read} (@pxref{Scheme Read}).  If @var{reader} is
+@code{#f}, it is assumed that Guile's built-in @code{read} procedure
+will be used.
+@end 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)))))
 
 
 \f
@@ -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
 
 \f
+/* 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
+
+
+\f
 /* 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;
 



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel