From: Andreas Rottmann Subject: Use a fluid for the list of the reader's "hash procedures" This allows customizing the reader behavior for a dynamic extent more easily. * libguile/read.c (scm_read_hash_procedures): Renamed to `scm_i_read_hash_procedures'. (scm_i_read_hash_procedures_ref, scm_i_read_hash_procedures_set_x): New (internal) accessor functions for the fluid. (scm_read_hash_extend, scm_get_hash_procedure): Use these accessor functions. (scm_init_read): Create the fluid, named `%read-hash-procedures' instead of the previous plain list `read-hash-procedures'. * test-suite/tests/reader.test: Adapt the "R6RS/SRFI-30 block comment syntax overridden" test to make use of the fluid. * module/ice-9/deprecated.scm (read-hash-procedures): New identifier macro -- backward-compatibility shim. --- libguile/read.c | 38 ++++++++++++++++++++++++++++---------- module/ice-9/deprecated.scm | 17 ++++++++++++++++- test-suite/tests/reader.test | 21 ++++++++------------- 3 files changed, 52 insertions(+), 24 deletions(-) diff --git a/libguile/read.c b/libguile/read.c index c9219bc..53ab128 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -135,9 +135,21 @@ SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, } #undef FUNC_NAME -/* An association list mapping extra hash characters to procedures. */ -static SCM *scm_read_hash_procedures; +/* A fluid referring to an association list mapping extra hash + characters to procedures. */ +static SCM *scm_i_read_hash_procedures; +static inline SCM +scm_i_read_hash_procedures_ref (void) +{ + return scm_fluid_ref (*scm_i_read_hash_procedures); +} + +static inline void +scm_i_read_hash_procedures_set_x (SCM value) +{ + scm_fluid_set_x (*scm_i_read_hash_procedures, value); +} /* Token readers. */ @@ -1547,7 +1559,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, proc, SCM_ARG2, FUNC_NAME); /* Check if chr is already in the alist. */ - this = *scm_read_hash_procedures; + this = scm_i_read_hash_procedures_ref (); prev = SCM_BOOL_F; while (1) { @@ -1556,8 +1568,9 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, /* not found, so add it to the beginning. */ if (scm_is_true (proc)) { - *scm_read_hash_procedures = - scm_cons (scm_cons (chr, proc), *scm_read_hash_procedures); + SCM new = scm_cons (scm_cons (chr, proc), + scm_i_read_hash_procedures_ref ()); + scm_i_read_hash_procedures_set_x (new); } break; } @@ -1569,8 +1582,8 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, /* remove it. */ if (scm_is_false (prev)) { - *scm_read_hash_procedures = - SCM_CDR (*scm_read_hash_procedures); + SCM rest = SCM_CDR (scm_i_read_hash_procedures_ref ()); + scm_i_read_hash_procedures_set_x (rest); } else scm_set_cdr_x (prev, SCM_CDR (this)); @@ -1594,7 +1607,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, static SCM scm_get_hash_procedure (int c) { - SCM rest = *scm_read_hash_procedures; + SCM rest = scm_i_read_hash_procedures_ref (); while (1) { @@ -1738,8 +1751,13 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0, void scm_init_read () { - scm_read_hash_procedures = - SCM_VARIABLE_LOC (scm_c_define ("read-hash-procedures", SCM_EOL)); + SCM read_hash_procs; + + read_hash_procs = scm_make_fluid (); + scm_fluid_set_x (read_hash_procs, SCM_EOL); + + scm_i_read_hash_procedures = + SCM_VARIABLE_LOC (scm_c_define ("%read-hash-procedures", read_hash_procs)); scm_init_opts (scm_read_options, scm_read_opts); #include "libguile/read.x" diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index faff234..07ad6d2 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -65,7 +65,8 @@ save-stack named-module-use! top-repl - turn-on-debugging)) + turn-on-debugging + read-hash-procedures)) ;;;; Deprecated definitions. @@ -682,3 +683,17 @@ it.") "Debugging capabilities are present by default.") (debug-enable 'backtrace) (read-enable 'positions)) + +(define (read-hash-procedures-warning) + (issue-deprecation-warning + "`read-hash-procedures' is deprecated." + "Use the fluid `%read-hash-procedures' instead.")) + +(define-syntax read-hash-procedures + (identifier-syntax + (_ + (begin (read-hash-procedures-warning) + (fluid-ref %read-hash-procedures))) + ((set! _ expr) + (begin (read-hash-procedures-warning) + (fluid-set! %read-hash-procedures expr))))) diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 6686ca2..0027da7 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -109,19 +109,14 @@ (pass-if "R6RS/SRFI-30 block comment syntax overridden" ;; To be compatible with 1.8 and earlier, we should be able to override ;; this syntax. - (let ((rhp read-hash-procedures)) - (dynamic-wind - (lambda () - (read-hash-extend #\| (lambda args 'not))) - (lambda () - (fold (lambda (x y result) - (and result (eq? x y))) - #t - (read-string "(this is #| a comment)") - `(this is not a comment))) - (lambda () - (set! read-hash-procedures rhp))))) - + (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedures))) + (read-hash-extend #\| (lambda args 'not)) + (fold (lambda (x y result) + (and result (eq? x y))) + #t + (read-string "(this is #| a comment)") + `(this is not a comment)))) + (pass-if "unprintable symbol" ;; The reader tolerates unprintable characters for symbols. (equal? (string->symbol "\x01\x02\x03") -- tg: (fe15364..) t/read-hash-fluid (depends on: master)