suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

reader: see new parameter values in read/recursive

Browse Source 
When `read/recursive` is used, do not inherit parameter values
recorded by an enclosing `read`, and instead look them up again.
This change restores behavior of the old reader.

Closes #2661
This commit is contained in:
Matthew Flatt 2019-05-18 12:52:45 -04:00
parent 5f70abef0c
commit cc73ec8d69
3 changed files with 61 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
pkgs/racket-test-core/tests/racket/read.rktl
View File

@ -1444,6 +1444,37 @@
(read-syntax 'm (open-input-string "#lang reader 'provides-a-reader-to-check-phase"))))])
(anything)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(parameterize ([read-case-sensitive #t])
(define (myread [in (current-input-port)])
(parameterize-read
(lambda () (read in))))
(define (parameterize-read do-read)
(parameterize ([current-readtable (make-a-readtable (current-readtable))])
(do-read)))
(define (make-a-readtable base)
(make-readtable base
#\! 'dispatch-macro read-directive
#f 'non-terminating-macro (reparameterize-read base)))
(define (reparameterize-read base)
(case-lambda
[(c in) (read/recursive in c base)]
[(c in src line col pos) (read-syntax/recursive src in c base)]))
(define (read-directive c in src line col pos)
(read-case-sensitive #f)
(make-special-comment #f))
;; Parameter change takes effect for recursive read:
(test 'abc myread (open-input-string "#!ABC"))
;; Change also sticks:
(test 'abc myread (open-input-string "ABC")))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; readtable has `report-errs`:

6
racket/src/expander/read/config.rkt
View File

@ -31,7 +31,7 @@
* pos
* indentations ; stack of `indentation` records
* keep-comment? ; make main dispatch return on comment
parameter-override ; mash of parameter -> value
parameter-override ; hash of parameter -> value
parameter-cache ; hash of parameter -> value
st)) ; other shared mutable state
@ -99,7 +99,9 @@
[keep-comment? keep-comment?]
[st (if local-graph?
(read-config-state #f #f)
(read-config-st config))]))
(read-config-st config))]
[parameter-override #hasheq()]
[parameter-cache (make-hasheq)]))
(define (port+config->srcloc in config
#:end-pos [given-end-pos #f])

50
racket/src/racket/src/startup.inc
View File

@ -52111,7 +52111,9 @@ static const char *startup_source =
"((st63_0)"
"(if local-graph?_0"
"(read-config-state3.1 #f #f)"
"(read-config-st config_0))))"
"(read-config-st config_0)))"
"((parameter-override64_0) '#hasheq())"
"((parameter-cache65_0)(make-hasheq)))"
"(read-config/inner2.1"
" readtable61_0"
" next-readtable62_0"
@ -52123,8 +52125,8 @@ static const char *startup_source =
"(read-config/inner-module-declared? the-struct_1)"
"(read-config/inner-coerce the-struct_1)"
"(read-config/inner-coerce-key the-struct_1)"
"(read-config/inner-parameter-override the-struct_1)"
"(read-config/inner-parameter-cache the-struct_1)"
" parameter-override64_0"
" parameter-cache65_0"
" st63_0))"
" (raise-argument-error 'struct-copy \"read-config/inner?\" the-struct_1)))))"
"(read-config/outer1.1"
@ -52169,16 +52171,16 @@ static const char *startup_source =
"(let-values(((v_0) config_0))"
"(let-values(((the-struct_0) v_0))"
"(if(read-config/outer? the-struct_0)"
"(let-values(((line64_0) line_0)"
"((col65_0) col_0)"
"((pos66_0) pos_0)"
"((inner67_0)(read-config/outer-inner v_0)))"
"(let-values(((line66_0) line_0)"
"((col67_0) col_0)"
"((pos68_0) pos_0)"
"((inner69_0)(read-config/outer-inner v_0)))"
"(read-config/outer1.1"
" inner67_0"
" inner69_0"
"(read-config/outer-wrap the-struct_0)"
" line64_0"
" col65_0"
" pos66_0"
" line66_0"
" col67_0"
" pos68_0"
"(read-config/outer-indentations the-struct_0)"
"(read-config/outer-keep-comment? the-struct_0)))"
" (raise-argument-error 'struct-copy \"read-config/outer?\" the-struct_0)))))))"
@ -52189,10 +52191,10 @@ static const char *startup_source =
"(let-values(((v_0) config_0))"
"(let-values(((the-struct_0) v_0))"
"(if(read-config/outer? the-struct_0)"
"(let-values(((wrap68_0) #f)((inner69_0)(read-config/outer-inner v_0)))"
"(let-values(((wrap70_0) #f)((inner71_0)(read-config/outer-inner v_0)))"
"(read-config/outer1.1"
" inner69_0"
" wrap68_0"
" inner71_0"
" wrap70_0"
"(read-config/outer-line the-struct_0)"
"(read-config/outer-col the-struct_0)"
"(read-config/outer-pos the-struct_0)"
@ -52206,15 +52208,15 @@ static const char *startup_source =
"(let-values(((v_0) config_0))"
"(let-values(((the-struct_0) v_0))"
"(if(read-config/outer? the-struct_0)"
"(let-values(((keep-comment?70_0) #t)((inner71_0)(read-config/outer-inner v_0)))"
"(let-values(((keep-comment?72_0) #t)((inner73_0)(read-config/outer-inner v_0)))"
"(read-config/outer1.1"
" inner71_0"
" inner73_0"
"(read-config/outer-wrap the-struct_0)"
"(read-config/outer-line the-struct_0)"
"(read-config/outer-col the-struct_0)"
"(read-config/outer-pos the-struct_0)"
"(read-config/outer-indentations the-struct_0)"
" keep-comment?70_0))"
" keep-comment?72_0))"
" (raise-argument-error 'struct-copy \"read-config/outer?\" the-struct_0)))))))"
"(define-values"
"(discard-comment)"
@ -52226,15 +52228,15 @@ static const char *startup_source =
"(let-values(((v_0) config_0))"
"(let-values(((the-struct_0) v_0))"
"(if(read-config/outer? the-struct_0)"
"(let-values(((keep-comment?72_0) #f)((inner73_0)(read-config/outer-inner v_0)))"
"(let-values(((keep-comment?74_0) #f)((inner75_0)(read-config/outer-inner v_0)))"
"(read-config/outer1.1"
" inner73_0"
" inner75_0"
"(read-config/outer-wrap the-struct_0)"
"(read-config/outer-line the-struct_0)"
"(read-config/outer-col the-struct_0)"
"(read-config/outer-pos the-struct_0)"
"(read-config/outer-indentations the-struct_0)"
" keep-comment?72_0))"
" keep-comment?74_0))"
" (raise-argument-error 'struct-copy \"read-config/outer?\" the-struct_0)))))))))"
"(define-values"
"(next-readtable)"
@ -52246,12 +52248,12 @@ static const char *startup_source =
"(let-values(((v_0) config_0))"
"(let-values(((the-struct_0) v_0))"
"(if(read-config/outer? the-struct_0)"
"(let-values(((inner74_0)"
"(let-values(((inner76_0)"
"(let-values(((the-struct_1)(read-config/outer-inner v_0)))"
"(if(read-config/inner? the-struct_1)"
"(let-values(((readtable75_0)(read-config-next-readtable config_0)))"
"(let-values(((readtable77_0)(read-config-next-readtable config_0)))"
"(read-config/inner2.1"
" readtable75_0"
" readtable77_0"
"(read-config/inner-next-readtable the-struct_1)"
"(read-config/inner-for-syntax? the-struct_1)"
"(read-config/inner-source the-struct_1)"
@ -52266,7 +52268,7 @@ static const char *startup_source =
"(read-config/inner-st the-struct_1)))"
" (raise-argument-error 'struct-copy \"read-config/inner?\" the-struct_1)))))"
"(read-config/outer1.1"
" inner74_0"
" inner76_0"
"(read-config/outer-wrap the-struct_0)"
"(read-config/outer-line the-struct_0)"
"(read-config/outer-col the-struct_0)"