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

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

Hi,

Neil Jerram <neil@ossau.uklinux.net> 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
 
 \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"
@@ -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