From 8c1aaad42c1257154a25e7162689ccaec9c90b0d Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 7 Feb 2014 10:57:39 -0700 Subject: [PATCH] Fluidize (runtime parser) controls: *parser-radix*,... ... *parser-associate-positions?*, *parser-atom-delimiters*, *parser-canonicalize-symbols?*, *parser-constituents*, *parser-enable-file-attributes-parsing?*, *parser-keyword-style*, and *parser-table*. --- doc/ref-manual/io.texi | 31 ++++++++------- src/edwin/schmod.scm | 7 ++-- src/ffi/cdecls.scm | 7 ++-- src/runtime/file-attributes.scm | 39 ++++++++++--------- src/runtime/option.scm | 2 +- src/runtime/parse.scm | 68 +++++++++++++++++++++------------ src/runtime/swank.scm | 3 +- src/runtime/unpars.scm | 10 +++-- src/sicp/studen.scm | 4 +- 9 files changed, 100 insertions(+), 71 deletions(-) diff --git a/doc/ref-manual/io.texi b/doc/ref-manual/io.texi index e36982518..a17a55f2c 100644 --- a/doc/ref-manual/io.texi +++ b/doc/ref-manual/io.texi @@ -583,8 +583,8 @@ but the written representation is incomplete and therefore not parsable, an error is signalled. @var{Environment} is used to look up the values of control variables -such as @samp{*parser-radix*}. If not supplied, it defaults to the -@acronym{REP} environment. +such as @samp{*parser-radix*} (@pxref{reader-controls}). If not +supplied, it defaults to the @acronym{REP} environment. @end deffn @deffn procedure eof-object? object @@ -699,17 +699,22 @@ that they are both flexible and extremely fast, especially for large amounts of data. @end deffn -The following variables may be bound or assigned to change the behavior -of the @code{read} procedure. They are looked up in the environment -that is passed to @code{read}, and so may have different values in -different environments. It is recommended that the global bindings of -these variables be left unchanged; make local changes by shadowing the -global bindings in nested environments. +@anchor{reader-controls} +@subsection Reader Controls + +The following names control the behavior of the @code{read} procedure. +They are looked up in the environment that is passed to @code{read}, +and so may have different fluids in different environments. The +global fluids (fluids assigned to the global bindings) may be +dynamically bound by the @code{let-fluid} procedure, but should not be +mutated by @code{fluid-set!}. Make persistent, local changes by +shadowing the global bindings in the local environment and assigning +new fluids to them. @defvr variable *parser-radix* -This variable defines the radix used by the reader when it parses +This fluid defines the radix used by the reader when it parses numbers. This is similar to passing a radix argument to -@code{string->number}. The value of this variable must be one of +@code{string->number}. The value of the fluid must be one of @code{2}, @code{8}, @code{10}, or @code{16}; any other value is ignored, and the reader uses radix @code{10}. @@ -718,14 +723,14 @@ Note that much of the number syntax is invalid for radixes other than and signals an error. However, problems can still occur when @code{*parser-radix*} is set to @code{16}, because syntax that normally denotes symbols can now denote numbers (e.g.@: @code{abc}). Because of -this, it is usually undesirable to set this variable to anything other +this, it is usually undesirable to set this fluid to anything other than the default. -The default value of this variable is @code{10}. +The default value of this fluid is @code{10}. @end defvr @defvr variable *parser-canonicalize-symbols?* -This variable controls how the parser handles case-sensitivity of +This fluid controls how the parser handles case-sensitivity of symbols. If it is bound to its default value of @code{#t}, symbols read by the parser are converted to lower case before being interned. Otherwise, symbols are interned without case conversion. diff --git a/src/edwin/schmod.scm b/src/edwin/schmod.scm index d874f83ad..036f6ecd6 100644 --- a/src/edwin/schmod.scm +++ b/src/edwin/schmod.scm @@ -232,9 +232,10 @@ The following commands evaluate Scheme expressions: (let ((environment (evaluation-environment #f))) (obarray-completions (if (and bound-only? - (environment-lookup - environment - '*PARSER-CANONICALIZE-SYMBOLS?*)) + (fluid + (environment-lookup + environment + '*PARSER-CANONICALIZE-SYMBOLS?*))) (string-downcase prefix) prefix) (if bound-only? diff --git a/src/ffi/cdecls.scm b/src/ffi/cdecls.scm index d334c1641..2d10ceb7d 100644 --- a/src/ffi/cdecls.scm +++ b/src/ffi/cdecls.scm @@ -69,6 +69,10 @@ USA. (define c-include-noisily? #f) (define current-filename) +(define read-environment + (make-top-level-environment '(*PARSER-CANONICALIZE-SYMBOLS?*) + (list (make-fluid #f)))) + (define (include-cdecl-file filename cwd twd includes) ;; Adds the C declarations in FILENAME to INCLUDES. Interprets ;; FILENAME relative to CWD (current working directory). @@ -111,9 +115,6 @@ USA. ((pathname=? again simpler) again) (else (loop again (fix:1+ count))))))) -(define read-environment - (make-top-level-environment '(*PARSER-CANONICALIZE-SYMBOLS?*) '(#f))) - (define (include-cdecl form cwd twd includes) ;; Add a top-level C declaration to INCLUDES. If it is an ;; include, interprete the included filenames relative to CWD diff --git a/src/runtime/file-attributes.scm b/src/runtime/file-attributes.scm index 0f634e5c4..226d9883a 100644 --- a/src/runtime/file-attributes.scm +++ b/src/runtime/file-attributes.scm @@ -120,29 +120,30 @@ This file is part of MIT/GNU Scheme. (define (parse-file-attributes-item parse port) ;; Prepare the parser for first mode. - (fluid-let ((*parser-associate-positions?* #f) - (*parser-atom-delimiters* - char-set/file-attributes-atom-delimiters) - (*parser-canonicalize-symbols?* #f) - (*parser-constituents* char-set/file-attributes-constituents) - (*parser-enable-file-attributes-parsing?* #f) ; no recursion! - (*parser-keyword-style* #f) - (*parser-radix* 10) - (*parser-table* file-attributes-parser-table)) - (parse port system-global-environment))) + (let-fluids *parser-associate-positions?* #f + *parser-atom-delimiters* char-set/file-attributes-atom-delimiters + *parser-canonicalize-symbols?* #f + *parser-constituents* char-set/file-attributes-constituents + *parser-enable-file-attributes-parsing?* #f ; no recursion! + *parser-keyword-style* #f + *parser-radix* 10 + *parser-table* file-attributes-parser-table + (lambda () + (parse port system-global-environment)))) (define (parse-file-attributes-value parse port) ;; Prepare the parser for second mode. - (fluid-let ((*parser-associate-positions?* #f) - (*parser-atom-delimiters* char-set/atom-delimiters) - (*parser-canonicalize-symbols?* #f) - (*parser-constituents* char-set/constituents) - (*parser-enable-file-attributes-parsing?* #f) ; no recursion! + (let-fluids *parser-associate-positions?* #f + *parser-atom-delimiters* char-set/atom-delimiters + *parser-canonicalize-symbols?* #f + *parser-constituents* char-set/constituents + *parser-enable-file-attributes-parsing?* #f ; no recursion! ;; enable prefix keywords - (*parser-keyword-style* 'prefix) - (*parser-radix* 10) - (*parser-table* system-global-parser-table)) - (parse port system-global-environment))) + *parser-keyword-style* 'prefix + *parser-radix* 10 + *parser-table* system-global-parser-table + (lambda () + (parse port system-global-environment)))) (define (parse-file-attributes-line port db multiline) (declare (ignore db)) diff --git a/src/runtime/option.scm b/src/runtime/option.scm index 980ade71e..fd7905ef7 100644 --- a/src/runtime/option.scm +++ b/src/runtime/option.scm @@ -56,7 +56,7 @@ USA. (define (make-load-environment) (let ((e (extend-top-level-environment system-global-environment))) - (environment-define e '*PARSER-CANONICALIZE-SYMBOLS?* #t) + (environment-define e '*PARSER-CANONICALIZE-SYMBOLS?* (make-fluid #t)) e)) (if (memq name loaded-options) diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm index e6ab41cd8..6eb7e7567 100644 --- a/src/runtime/parse.scm +++ b/src/runtime/parse.scm @@ -31,22 +31,22 @@ USA. (integrate-external "input") (integrate-external "port")) -(define *parser-associate-positions?* #f) +(define *parser-associate-positions?*) (define *parser-atom-delimiters*) -(define *parser-canonicalize-symbols?* #t) +(define *parser-canonicalize-symbols?*) (define *parser-constituents*) -(define *parser-enable-file-attributes-parsing?* #t) -(define *parser-keyword-style* #f) -(define *parser-radix* 10) +(define *parser-enable-file-attributes-parsing?*) +(define *parser-keyword-style*) +(define *parser-radix*) (define *parser-table*) -(define runtime-parser-associate-positions? #f) +(define runtime-parser-associate-positions?) (define runtime-parser-atom-delimiters) -(define runtime-parser-canonicalize-symbols? #t) +(define runtime-parser-canonicalize-symbols?) (define runtime-parser-constituents) -(define runtime-parser-enable-file-attributes-parsing? #t) -(define runtime-parser-keyword-style #f) -(define runtime-parser-radix 10) +(define runtime-parser-enable-file-attributes-parsing?) +(define runtime-parser-keyword-style) +(define runtime-parser-radix) (define runtime-parser-table) (define ignore-extra-list-closes #t) @@ -133,6 +133,22 @@ USA. (define char-set/number-leaders) (define (initialize-package!) + (set! *parser-associate-positions?* (make-fluid #f)) + (set! *parser-atom-delimiters* (make-fluid 'UNBOUND)) + (set! *parser-canonicalize-symbols?* (make-fluid #t)) + (set! *parser-constituents* (make-fluid 'UNBOUND)) + (set! *parser-enable-file-attributes-parsing?* (make-fluid #t)) + (set! *parser-keyword-style* (make-fluid #f)) + (set! *parser-radix* (make-fluid 10)) + (set! *parser-table* (make-fluid 'UNBOUND)) + (set! runtime-parser-associate-positions? (make-fluid #f)) + (set! runtime-parser-atom-delimiters (make-fluid 'UNBOUND)) + (set! runtime-parser-canonicalize-symbols? (make-fluid #t)) + (set! runtime-parser-constituents (make-fluid 'UNBOUND)) + (set! runtime-parser-enable-file-attributes-parsing? (make-fluid #t)) + (set! runtime-parser-keyword-style (make-fluid #f)) + (set! runtime-parser-radix (make-fluid 10)) + (set! runtime-parser-table (make-fluid 'UNBOUND)) (let* ((constituents (char-set-difference char-set:graphic char-set:whitespace)) @@ -191,12 +207,12 @@ USA. (set! char-set/atom-delimiters atom-delimiters) (set! char-set/symbol-quotes symbol-quotes) (set! char-set/number-leaders number-leaders) - (set! *parser-atom-delimiters* atom-delimiters) - (set! *parser-constituents* constituents) - (set! runtime-parser-atom-delimiters atom-delimiters) - (set! runtime-parser-constituents constituents)) - (set! *parser-table* system-global-parser-table) - (set! runtime-parser-table system-global-parser-table) + (set-fluid! *parser-atom-delimiters* atom-delimiters) + (set-fluid! *parser-constituents* constituents) + (set-fluid! runtime-parser-atom-delimiters atom-delimiters) + (set-fluid! runtime-parser-constituents constituents)) + (set-fluid! *parser-table* system-global-parser-table) + (set-fluid! runtime-parser-table system-global-parser-table) (set! hashed-object-interns (make-strong-eq-hash-table)) (initialize-condition-types!)) @@ -796,13 +812,14 @@ USA. (begin (guarantee-environment environment #f) environment))) - (atom-delimiters - (repl-environment-value environment '*PARSER-ATOM-DELIMITERS*)) - (constituents - (repl-environment-value environment '*PARSER-CONSTITUENTS*))) + (atom-delimiters (fluid (repl-environment-value + environment '*PARSER-ATOM-DELIMITERS*))) + (constituents (fluid (repl-environment-value environment + '*PARSER-CONSTITUENTS*)))) (guarantee-char-set atom-delimiters #f) (guarantee-char-set constituents #f) - (make-db (repl-environment-value environment '*PARSER-ASSOCIATE-POSITIONS?*) + (make-db (fluid (repl-environment-value environment + '*PARSER-ASSOCIATE-POSITIONS?*)) atom-delimiters (overridable-value port environment '*PARSER-CANONICALIZE-SYMBOLS?*) @@ -810,8 +827,8 @@ USA. (overridable-value port environment '*PARSER-ENABLE-FILE-ATTRIBUTES-PARSING?*) (overridable-value port environment '*PARSER-KEYWORD-STYLE*) - (repl-environment-value environment '*PARSER-RADIX*) - (repl-environment-value environment '*PARSER-TABLE*) + (fluid (repl-environment-value environment '*PARSER-RADIX*)) + (fluid (repl-environment-value environment '*PARSER-TABLE*)) (make-shared-objects) (port/operation port 'DISCRETIONARY-WRITE-CHAR) (position-operation port environment) @@ -835,12 +852,13 @@ USA. (let* ((nope "no-overridden-value") (v (port/get-property port name nope))) (if (eq? v nope) - (repl-environment-value environment name) + (fluid (repl-environment-value environment name)) v))) (define (position-operation port environment) (let ((default (lambda (port) port #f))) - (if (repl-environment-value environment '*PARSER-ASSOCIATE-POSITIONS?*) + (if (fluid (repl-environment-value environment + '*PARSER-ASSOCIATE-POSITIONS?*)) (or (port/operation port 'POSITION) default) default))) diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm index df3db3f0c..247288dd2 100644 --- a/src/runtime/swank.scm +++ b/src/runtime/swank.scm @@ -825,7 +825,8 @@ swank:xref (define (all-completions prefix environment) (let ((prefix - (if (environment-lookup environment '*PARSER-CANONICALIZE-SYMBOLS?*) + (if (fluid (environment-lookup environment + '*PARSER-CANONICALIZE-SYMBOLS?*)) (string-downcase prefix) prefix)) (completions '())) diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm index 33e06422c..91477e946 100644 --- a/src/runtime/unpars.scm +++ b/src/runtime/unpars.scm @@ -343,7 +343,8 @@ USA. (unparse-symbol-name (symbol-name symbol)))) (define (unparse-keyword-name s) - (case (repl-environment-value (fluid *environment*) '*PARSER-KEYWORD-STYLE*) + (case (fluid (repl-environment-value (fluid *environment*) + '*PARSER-KEYWORD-STYLE*)) ((PREFIX) (*unparse-char #\:) (unparse-symbol-name s)) @@ -358,8 +359,8 @@ USA. (define (unparse-symbol-name s) (if (or (string-find-next-char-in-set s - (if (repl-environment-value (fluid *environment*) - '*PARSER-CANONICALIZE-SYMBOLS?*) + (if (fluid (repl-environment-value (fluid *environment*) + '*PARSER-CANONICALIZE-SYMBOLS?*)) canon-symbol-quoted non-canon-symbol-quoted)) (fix:= (string-length s) 0) @@ -392,7 +393,8 @@ USA. (char=? (string-ref string 0) #\#)) (define (looks-like-keyword? string) - (case (repl-environment-value (fluid *environment*) '*PARSER-KEYWORD-STYLE*) + (case (fluid (repl-environment-value (fluid *environment*) + '*PARSER-KEYWORD-STYLE*)) ((PREFIX) (char=? (string-ref string 0) #\:)) ((SUFFIX) diff --git a/src/sicp/studen.scm b/src/sicp/studen.scm index c7d6a96df..c2b2366fc 100644 --- a/src/sicp/studen.scm +++ b/src/sicp/studen.scm @@ -99,12 +99,12 @@ USA. (access set-atom-delimiters! (->environment '(runtime parser)))) (define (enable-system-syntax) - (set! *parser-table* system-global-parser-table) + (set-fluid! *parser-table* system-global-parser-table) (set-atom-delimiters! 'mit-scheme) (set-repl/syntax-table! (nearest-repl) system-global-syntax-table)) (define (disable-system-syntax) - (set! *parser-table* *student-parser-table*) + (set-fluid! *parser-table* *student-parser-table*) (set-atom-delimiters! 'sicp) (set-repl/syntax-table! (nearest-repl) *student-syntax-table*)) -- 2.25.1