expander: track core #%datum expansion in 'origin

This commit is contained in:
Matthew Flatt 2020-12-12 20:23:35 -07:00
parent 400f4fa4fb
commit 1e19e660c9
4 changed files with 638 additions and 625 deletions

View File

@ -1061,8 +1061,13 @@
;; expecting `#%app` from `racket/base` to reqrite to core `#%app` ;; expecting `#%app` from `racket/base` to reqrite to core `#%app`
(test #t syntax-original? (find (expand #'(+ 1 2)) '#%app)) (test #t syntax-original? (find (expand #'(+ 1 2)) '#%app))
(test #t syntax-property (find (expand #'(+ 1 2)) '#%app) 'implicit-made-explicit) (test #t syntax-property (find (expand #'(+ 1 2)) '#%app) 'implicit-made-explicit)
(test #t syntax-original? (find (expand #'100) '#%datum))
(test #t syntax-property (find (expand #'100) '#%datum) 'implicit-made-explicit)
(test #f syntax-original? (find (expand (datum->syntax #'here '(+ 1 2))) '#%app)) (test #f syntax-original? (find (expand (datum->syntax #'here '(+ 1 2))) '#%app))
(test #t syntax-property (find (expand (datum->syntax #'here '(+ 1 2))) '#%app) 'implicit-made-explicit)) (test #t syntax-property (find (expand (datum->syntax #'here '(+ 1 2))) '#%app) 'implicit-made-explicit)
(test #f syntax-original? (find (expand (datum->syntax #'here '100)) '#%datum))
(test #t syntax-property (find (expand (datum->syntax #'here '100)) '#%datum) 'implicit-made-explicit))
;; ---------------------------------------- ;; ----------------------------------------
@ -1751,7 +1756,7 @@
(let () (let ()
(define m (define m
'(module m racket/base '(module m racket/base
(define-syntax-rule (m) 1) (define-syntax-rule (m) '1)
(module+ main (module+ main
(m)))) (m))))

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -405,10 +405,12 @@
(if (and (expand-context-to-parsed? ctx) (if (and (expand-context-to-parsed? ctx)
(free-id-set-empty? (expand-context-stops ctx))) (free-id-set-empty? (expand-context-stops ctx)))
(parsed-quote (keep-properties-only~ s) (syntax->datum datum)) (parsed-quote (keep-properties-only~ s) (syntax->datum datum))
(rebuild (syntax-track-origin (rebuild s
s (list (core-id 'quote phase)
(list (core-id 'quote phase) datum)
datum))))) #:track? #f)
s
(m '#%datum)))))
;; '#%kernel `#%app` treats an empty combination as a literal null ;; '#%kernel `#%app` treats an empty combination as a literal null
(add-core-form! (add-core-form!