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
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}.
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.
(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?
(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).
((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
(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))
(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)
(integrate-external "input")
(integrate-external "port"))
\f
-(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)
(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))
(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!))
(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?*)
(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)
(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)))
(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 '()))
(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))
(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)
(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)
(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*))
projects / mit-scheme.git / commitdiff