expander: restore datum-intern-literal in datum->syntax

As the documentation says, `datum->syntax` should use
`datum-intern-literal`. That helps avoid syntax-object mutability, and
it increases sharing in compiled forms. The use of
`datum-intern-literal` got lost when the expander was rewritten in
Racket.

Relevant to #3245
This commit is contained in:
Matthew Flatt 2020-06-25 10:23:48 -06:00
parent 27fd176968
commit 5f5599d2e8
3 changed files with 29 additions and 23 deletions

View File

@ -53,6 +53,10 @@
(test 'val syntax-property s 'key)
(test #f syntax-property (syntax-property-remove s 'key) 'key))
(test #t immutable? (syntax-e (datum->syntax #f (string #\a))))
(test #t immutable? (syntax-e (syntax-case (datum->syntax #f (list (string #\a))) ()
[(a) #'a])))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; some syntax-case patterns
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -233,25 +233,26 @@
[else
(define insp (if (syntax? s) 'not-needed (current-module-code-inspector)))
(define (wrap content)
(syntax (if (and stx-c
(syntax-tamper stx-c))
(modified-content content
(tamper-tainted-for-content content))
content)
(if stx-c
(syntax-scopes stx-c)
empty-scopes)
(if stx-c
(syntax-shifted-multi-scopes stx-c)
empty-shifted-multi-scopes)
(if stx-c
(syntax-mpi-shifts stx-c)
empty-mpi-shifts)
(and stx-l (syntax-srcloc stx-l))
empty-props
(and insp
stx-c
(weaker-inspector insp (syntax-inspector stx-c)))))
(let ([content (datum-intern-literal content)])
(syntax (if (and stx-c
(syntax-tamper stx-c))
(modified-content content
(tamper-tainted-for-content content))
content)
(if stx-c
(syntax-scopes stx-c)
empty-scopes)
(if stx-c
(syntax-shifted-multi-scopes stx-c)
empty-shifted-multi-scopes)
(if stx-c
(syntax-mpi-shifts stx-c)
empty-mpi-shifts)
(and stx-l (syntax-srcloc stx-l))
empty-props
(and insp
stx-c
(weaker-inspector insp (syntax-inspector stx-c))))))
(define result-s
(non-syntax-map s
(lambda (tail? x) (cond

View File

@ -6259,12 +6259,13 @@ static const char *startup_source =
"(lambda(content_0)"
"(begin"
" 'wrap"
"(let-values(((content_1)(datum-intern-literal content_0)))"
"(syntax2.1"
"(if(if stx-c_0(syntax-tamper stx-c_0) #f)"
"(modified-content1.1"
" content_0"
"(tamper-tainted-for-content content_0))"
" content_0)"
" content_1"
"(tamper-tainted-for-content content_1))"
" content_1)"
"(if stx-c_0(syntax-scopes stx-c_0) empty-scopes)"
"(if stx-c_0"
"(syntax-shifted-multi-scopes stx-c_0)"
@ -6288,7 +6289,7 @@ static const char *startup_source =
"(let-values() a_0)"
"(let-values() #f)))))))"
" #f)"
" #f))))))"
" #f)))))))"
"(let-values(((result-s_0)"
"(let-values(((s_1) s_0)"
"((f_0)"