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

improve names in keyword-function stack traces

Browse Source 
Change the way names are generated for pieces of the implementation of
a keyword-argument function. These functions are not accessible as
values, so the names don't matter for printing a function, but the
names can show up in stack traces.
This commit is contained in:
Matthew Flatt 2019-12-01 11:13:58 -07:00
parent 22387af060
commit 1c74f8c956
2 changed files with 9090 additions and 9185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -670,7 +670,9 @@
(cond (cond
[(null? kws) null] [(null? kws) null]
[else [else
(cons (cadar kws) (loop (cdr kws)))])))]) (cons (cadar kws) (loop (cdr kws)))])))]
[local-name (or local-name
(syntax-local-infer-name stx))])
(with-syntax ([(kw-arg ...) kw-args] (with-syntax ([(kw-arg ...) kw-args]
[kws-sorted sorted-kws] [kws-sorted sorted-kws]
[(opt-arg ...) opt-args] [(opt-arg ...) opt-args]
@ -698,10 +700,8 @@
[with-kw-max-arg (if (null? (syntax-e #'rest)) [with-kw-max-arg (if (null? (syntax-e #'rest))
(+ 2 (length plain-ids) (length opts)) (+ 2 (length plain-ids) (length opts))
#f)] #f)]
[core (car (generate-temporaries (if (identifier? local-name) [core (generate-proc-id 'core local-name)]
(list local-name) [unpack (generate-proc-id 'unpack local-name)])
'(core))))]
[unpack (car (generate-temporaries '(unpack)))])
(let ([mk-core (let ([mk-core
(lambda (kw-core?) (lambda (kw-core?)
;; body of procedure, where all optional ;; body of procedure, where all optional
@ -804,8 +804,7 @@
(mk-unpack) (mk-unpack)
(with-syntax ([kws (map car sorted-kws)] (with-syntax ([kws (map car sorted-kws)]
[no-kws (let ([p (mk-no-kws #t)] [no-kws (let ([p (mk-no-kws #t)]
[n (or local-name [n local-name])
(syntax-local-infer-name stx))])
(if n (if n
#`(let ([#,n #,p]) #,n) #`(let ([#,n #,p]) #,n)
p))] p))]
@ -833,7 +832,6 @@
[with-kws (mk-with-kws)] [with-kws (mk-with-kws)]
[(_ mk-id . _) (with-syntax ([n (or local-name [(_ mk-id . _) (with-syntax ([n (or local-name
(syntax-local-infer-name stx)
'unknown)] 'unknown)]
[call-fail (mk-kw-arity-stub)]) [call-fail (mk-kw-arity-stub)])
(syntax-local-lift-values-expression (syntax-local-lift-values-expression
@ -875,6 +873,17 @@
null null
args)) args))
(define-for-syntax (generate-proc-id default local-name)
(cond
[(not local-name)
((make-syntax-introducer) (datum->syntax #f default))]
[(symbol? local-name)
(generate-proc-id local-name #f)]
[(identifier? local-name)
(generate-proc-id (syntax-e local-name) #f)]
[else
(generate-proc-id default #f)]))
;; ---------------------------------------- ;; ----------------------------------------
;; Helper macro: ;; Helper macro:

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

File diff suppressed because it is too large Load Diff