Hi Neil,
Thanks for your detailed analysis of the `load' procedure stack.
Neil Jerram <[EMAIL PROTECTED]> 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
[EMAIL PROTECTED] {Scheme Procedure} load filename
[EMAIL PROTECTED] {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
[EMAIL PROTECTED] is defined, it should be bound to a procedure that
-will be called before any code is loaded. See documentation for
[EMAIL PROTECTED] 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
[EMAIL PROTECTED] 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
[EMAIL PROTECTED] {Scheme Procedure} current-reader
[EMAIL PROTECTED] {C Function} scm_current_reader ()
+Return the reader procedure used by @code{primitive-load} (and
[EMAIL PROTECTED]) during the dynamic extent of the current frame (see
[EMAIL PROTECTED] Wind}, and @pxref{Frames}).
[EMAIL PROTECTED] deffn
+
[EMAIL PROTECTED] {Scheme Procedure} set-current-reader reader
[EMAIL PROTECTED] {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
[EMAIL PROTECTED] If @var{reader} is a procedure, is must follow the
+interface of @code{read} (@pxref{Scheme Read}). If @var{reader} is
[EMAIL PROTECTED], it is assumed that Guile's built-in @code{read} procedure
+will be used.
[EMAIL PROTECTED] 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;
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel
