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

Support for rest arguments to functions with (f . rest), useful for (?@ . blah)

Browse Source
This commit is contained in:
Georges Dupéron 2017-02-03 09:24:28 +01:00
parent a0df96cb3a
commit 74f38a3213
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
ddd-forms.rkt
View File

@ -105,18 +105,19 @@
;#:with expanded #'(#%app list other) ;#:with expanded #'(#%app list other)
#:with expanded #'other)) #:with expanded #'other))
(define-syntax-class not-stx-pair (define-syntax-class not-stx-pair
(pattern {~not (_ . _)}))) (pattern () #:with v #''())
(pattern {~and v {~not (_ . _)}})))
(define-syntax app (define-syntax app
(syntax-parser (syntax-parser
[{~and (_ fn arg:arg … #;.rest:not-stx-pair) [{~and (_ fn arg:arg … . rest:not-stx-pair)
{~not (_ _ {~literal …} . _)}} ;; not fn directly followed by a … {~not (_ _ {~literal …} . _)}} ;; not fn directly followed by a …
;#'(#%app apply fn (#%app append arg.expanded …)) ;#'(#%app apply fn (#%app append arg.expanded …))
(syntax/top-loc this-syntax (syntax/top-loc this-syntax
(#%app apply fn (#%app splice-append arg.expanded … #;#:rest #;rest)))] (#%app apply fn (#%app splice-append arg.expanded … #:rest rest.v)))]
[(_ arg:arg … #;.rest:not-stx-pair) ;; shorthand for list creation [(_ arg:arg … . rest:not-stx-pair) ;; shorthand for list creation
;#'(#%app apply list (#%app append arg.expanded …)) ;#'(#%app apply list (#%app append arg.expanded …))
(syntax/top-loc this-syntax (syntax/top-loc this-syntax
(#%app apply list (#%app splice-append arg.expanded … #;#:rest #;rest)))])) (#%app apply list (#%app splice-append arg.expanded … #:rest rest.v)))]))
(define (splice-append #:rest [rest '()] . l*) (define (splice-append #:rest [rest '()] . l*)
(splice-append* (if (null? rest) l* (append l* rest)))) (splice-append* (if (null? rest) l* (append l* rest))))