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

reader: fix "original?" property on #lang-derived module name

Browse Source
This commit is contained in:
Matthew Flatt 2018-03-07 17:58:58 -07:00
parent ab48afda7a
commit d5d8249c12
4 changed files with 25 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-test-core/tests/racket/stx.rktl
View File

@ -400,6 +400,14 @@
(syntax-case stx () (syntax-case stx ()
[(_ () (_ () e)) (car (syntax-property #'e 'origin))]))) [(_ () (_ () e)) (car (syntax-property #'e 'origin))])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure a language name via `#lang` is original
(parameterize ([read-accept-reader #t])
(syntax-case (read-syntax 'hi (open-input-string "#lang racket/base 10")) ()
[(_ _ lang . _)
(test #t syntax-original? #'lang)]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; #%app, etc. ;; #%app, etc.

2
racket/src/expander/read/extension.rkt
View File

@ -121,7 +121,7 @@
(define submod-path `(submod ,(string->symbol lang-str) reader)) (define submod-path `(submod ,(string->symbol lang-str) reader))
(define reader-path (string->symbol (string-append lang-str "/lang/reader"))) (define reader-path (string->symbol (string-append lang-str "/lang/reader")))
(read-extension #:try-first-mod-path submod-path (read-extension #:try-first-mod-path submod-path
reader-path read-recur in (reading-at config line col pos) reader-path read-recur in (reading-at config line col pos)
#:get-info? get-info? #:get-info? get-info?

8
racket/src/expander/syntax/read-syntax.rkt
View File

@ -117,8 +117,14 @@
(cond (cond
[(syntax? v) (syntax->datum v)] [(syntax? v) (syntax->datum v)]
[else v])] [else v])]
[(syntax? v) v]
[(pair? v)
(read-to-syntax (cons (read-coerce #t (car v) srcloc)
(read-coerce #t (cdr v) srcloc))
srcloc
#f)]
[else [else
(datum->syntax #f v (and srcloc (to-srcloc-stx srcloc)))])) (read-to-syntax v srcloc #f)]))
(define (read-coerce-key for-syntax? k) (define (read-coerce-key for-syntax? k)
(cond (cond

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

@ -56648,7 +56648,15 @@ static const char *startup_source =
"(begin" "(begin"
"(if(not for-syntax?_12)" "(if(not for-syntax?_12)"
"(let-values()(if(syntax?$1 v_246)(let-values()(syntax->datum$1 v_246))(let-values() v_246)))" "(let-values()(if(syntax?$1 v_246)(let-values()(syntax->datum$1 v_246))(let-values() v_246)))"
"(let-values()(datum->syntax$1 #f v_246(if srcloc_12(to-srcloc-stx srcloc_12) #f)))))))" "(if(syntax?$1 v_246)"
"(let-values() v_246)"
"(if(pair? v_246)"
"(let-values()"
"(read-to-syntax"
"(cons(read-coerce #t(car v_246) srcloc_12)(read-coerce #t(cdr v_246) srcloc_12))"
" srcloc_12"
" #f))"
"(let-values()(read-to-syntax v_246 srcloc_12 #f))))))))"
"(define-values" "(define-values"
"(read-coerce-key)" "(read-coerce-key)"
"(lambda(for-syntax?_13 k_42)" "(lambda(for-syntax?_13 k_42)"