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

Stop keyworded functions from changing args' name

Browse Source
This commit is contained in:
shhyou 2021-01-07 16:15:39 -06:00 committed by Matthew Flatt
parent 225aa54453
commit 7894e97fd2
2 changed files with 65 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
pkgs/racket-test-core/tests/racket/procs.rktl
View File

@ -785,4 +785,58 @@
;; ---------------------------------------- ;; ----------------------------------------
(module kw-defns racket/base
(provide (all-defined-out))
(define (func-name/opt.1 arg [opt.1 (lambda (x) x)])
(object-name arg))
(define (func-name/opt.2 arg [opt.2 (lambda (x) x)])
(object-name opt.2))
(define (func-name/kw.1 arg1 #:kw.1 arg2)
(object-name arg1))
(define (func-name/kw.2 arg1 #:kw.2 arg2)
(object-name arg2))
(define (func-name/kw.opt.1 arg #:kw.opt.1 [kw.opt.1 (lambda (x) x)])
(object-name arg))
(define (func-name/kw.opt.2 arg #:kw.opt.2 [kw.opt.2 (lambda (x) x)])
(object-name kw.opt.2))
)
(require 'kw-defns)
(define ((proc-has-name? name) s)
(and (symbol? s) (regexp-match? name (symbol->string s))))
(test #t (proc-has-name? #rx"procs.rktl:")
(func-name/opt.1 (lambda (z) z)))
;; the default value of the optional argument picks up
;; the name of the optional argument
(test #t (proc-has-name? #rx"opt[.]2")
(func-name/opt.2 (lambda (z) z)))
(test #t (proc-has-name? #rx"procs.rktl:")
(func-name/opt.2 (lambda (z) z) (lambda (w) w)))
(test #t (proc-has-name? #rx"procs.rktl:")
(func-name/kw.1 (lambda (z) z) #:kw.1 (lambda (w) w)))
(test #t (proc-has-name? #rx"procs.rktl:")
(func-name/kw.2 (lambda (z) z) #:kw.2 (lambda (w) w)))
(test #t (proc-has-name? #rx"procs.rktl:")
(func-name/kw.opt.1 (lambda (z) z)))
(test #t (proc-has-name? #rx"procs.rktl:")
(func-name/kw.opt.1 (lambda (z) z) #:kw.opt.1 (lambda (w) w)))
(test #t (proc-has-name? #rx"kw[.]opt[.]2")
(func-name/kw.opt.2 (lambda (z) z)))
(test #t (proc-has-name? #rx"procs.rktl:")
(func-name/kw.opt.2 (lambda (z) z) #:kw.opt.2 (lambda (w) w)))
;; ----------------------------------------
(report-errs) (report-errs)

17
racket/collects/racket/private/kw.rkt
View File

@ -421,6 +421,12 @@
(syntax-property (datum->syntax #'e (syntax-e #'e) #f #'e) (syntax-property (datum->syntax #'e (syntax-e #'e) #f #'e)
'inferred-name (void))])) 'inferred-name (void))]))
(define-for-syntax (hide-binding-name stx)
(syntax-property stx
'inferred-name
;; void hides binding name
(void)))
;; Similar to the above, when we copy source locations from an input ;; Similar to the above, when we copy source locations from an input
;; expression, we need to ensure the source location is copied even if there ;; expression, we need to ensure the source location is copied even if there
;; is no source location on the input, but (quasi)syntax/loc doesn’t copy ;; is no source location on the input, but (quasi)syntax/loc doesn’t copy
@ -1267,17 +1273,15 @@
[(keyword? (syntax-e (car l))) [(keyword? (syntax-e (car l)))
(loop (cddr l) (loop (cddr l)
(cdr ids) (cdr ids)
(cons (list (car ids) (syntax-property (cadr l) (cons (list (car ids) (hide-binding-name (cadr l)))
'inferred-name
;; void hides binding name
(void)))
bind-accum) bind-accum)
arg-accum arg-accum
(cons (cons (car l) (car ids)) (cons (cons (car l) (car ids))
kw-pairs))] kw-pairs))]
[else (loop (cdr l) [else (loop (cdr l)
(cdr ids) (cdr ids)
(cons (list (car ids) (car l)) bind-accum) (cons (list (car ids) (hide-binding-name (car l)))
bind-accum)
(cons (copy-properties (car ids) (car l)) arg-accum) (cons (copy-properties (car ids) (car l)) arg-accum)
kw-pairs)]))))))) kw-pairs)])))))))
@ -1346,7 +1350,8 @@
(if (not lifted?) (if (not lifted?)
;; caller didn't lift expressions out ;; caller didn't lift expressions out
(let ([ids (generate-temporaries args)]) (let ([ids (generate-temporaries args)])
#`(let #,(map list ids args) #`(let #,(map list ids
(map hide-binding-name args))
#,(k ids))) #,(k ids)))
;; caller already lifted expression: ;; caller already lifted expression:
(k args)))]) (k args)))])