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

Add more kw source locations.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2020-06-16 15:41:56 -04:00
parent f3dd113e9d
commit 14e206bd0b
1 changed files with 33 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1390,37 +1390,39 @@
(lambda (args) (lambda (args)
(quasisyntax/loc stx (quasisyntax/loc stx
(if (variable-reference-constant? (#%variable-reference #,wrap-id)) (if (variable-reference-constant? (#%variable-reference #,wrap-id))
(#,impl-id/prop #,(quasisyntax/loc stx
;; keyword arguments: (#%app
#,@(let loop ([kw-args kw-args] [all-kws all-kws]) #,impl-id/prop
(cond ;; keyword arguments:
[(null? all-kws) null] #,@(let loop ([kw-args kw-args] [all-kws all-kws])
[(and (pair? kw-args) (cond
(eq? (syntax-e (caar kw-args)) (caar all-kws))) [(null? all-kws) null]
(cons (cdar kw-args) [(and (pair? kw-args)
(loop (cdr kw-args) (cdr all-kws)))] (eq? (syntax-e (caar kw-args)) (caar all-kws)))
[else (cons (cdar kw-args)
(cons (list-ref (car all-kws) 4) (loop (cdr kw-args) (cdr all-kws)))]
(loop kw-args (cdr all-kws)))])) [else
;; required arguments: (cons (list-ref (car all-kws) 4)
#,@(let loop ([i n-req] [args args]) (loop kw-args (cdr all-kws)))]))
(if (zero? i) ;; required arguments:
null #,@(let loop ([i n-req] [args args])
(cons (car args) (if (zero? i)
(loop (sub1 i) (cdr args))))) null
;; optional arguments: (cons (car args)
#,@(let loop ([opt-not-supplieds opt-not-supplieds] [args (list-tail args n-req)]) (loop (sub1 i) (cdr args)))))
(cond ;; optional arguments:
[(null? opt-not-supplieds) null] #,@(let loop ([opt-not-supplieds opt-not-supplieds] [args (list-tail args n-req)])
[(null? args) (cond
(cons (car opt-not-supplieds) [(null? opt-not-supplieds) null]
(loop (cdr opt-not-supplieds) null))] [(null? args)
[else (cons (car opt-not-supplieds)
(cons (car args) (loop (cdr opt-not-supplieds) (cdr args)))])) (loop (cdr opt-not-supplieds) null))]
;; rest args: [else
#,@(if rest? (cons (car args) (loop (cdr opt-not-supplieds) (cdr args)))]))
#`((list #,@(list-tail args (min (length args) (+ n-req n-opt))))) ;; rest args:
null)) #,@(if rest?
#`((list #,@(list-tail args (min (length args) (+ n-req n-opt)))))
null)))
#,(if lifted? #,(if lifted?
orig orig
(quasisyntax/loc stx (#%app #,wrap-id/prop . #,args))))))))) (quasisyntax/loc stx (#%app #,wrap-id/prop . #,args)))))))))