Hi,
Neil Jerram <[EMAIL PROTECTED]> writes:
> And to get this marginal benefit we have to add a module option and
> some code which will slow down normal operation. Not noticeably
> perhaps, but it all adds up.
Following your concern (I mean the performance concern, not the
"marginal benefit" concern), I thought of another way to achieve the
same thing, a bit more generic and slightly better performance-wise
(patch attached).
The idea is to use a fluid to store the current reader.
`primitive-load' can look at the value of this fluid to know what the
current reader is. When a file is loaded, it can modify the current
reader. Once it's been loaded, its value is restored back to the
original (not unlike `current-module'...).
To illustrate this, suppose a file that does this:
(set-current-reader (lambda args
(format #t "hello~%")
(apply read args)))
(+ 2 3)
Here is what happens when it's loaded:
$ guile
guile> (+ 2 2)
4
guile> (load "paf.scm")
hello
hello
guile> (+ 2 2)
4
guile>
Now, `define-module' can use the very same mechanism to implement
per-module readers.
In terms of performance, fetching the current reader (as done in
`primitive-load') boils down to a function call (to
`scm_i_fast_fluid_ref ()') which itself is pretty fast (a couple of
pointer dereferences, roughly). But of course, this still more costly
than nothing.
What do you think?
Thanks,
Ludovic.
--- 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!
@@ -2042,10 +2047,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 +2155,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 +2555,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 +2868,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/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"
@@ -86,11 +133,23 @@
scm_frame_begin (SCM_F_FRAME_REWINDABLE);
scm_i_frame_current_load_port (port);
+ /* Make `current-reader' local to this frame's dynamic extent. */
+ scm_frame_fluid (the_reader, CURRENT_READER ());
+
while (1)
{
- SCM form = scm_read (port);
+ SCM reader, form;
+
+ 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 +560,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
