From d794bde875448018bbfbbb4c21386717b38c110b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 20 Dec 2007 14:00:15 +0000 Subject: [PATCH] liberalize un{quote,syntax}-spliciing to allow a non-list at the end of an enclosing list svn: r8083 --- collects/scheme/private/qq-and-or.ss | 7 ++-- collects/scheme/private/qqstx.ss | 39 +++++++++++-------- .../scribblings/gui/font-list-class.scrbl | 2 +- collects/scribblings/reference/syntax.scrbl | 12 ++++-- collects/tests/mzscheme/syntax.ss | 2 +- 5 files changed, 38 insertions(+), 24 deletions(-) diff --git a/collects/scheme/private/qq-and-or.ss b/collects/scheme/private/qq-and-or.ss index d581257b07..2d2b587341 100644 --- a/collects/scheme/private/qq-and-or.ss +++ b/collects/scheme/private/qq-and-or.ss @@ -275,9 +275,10 @@ (if (zero? level) (let-values (((l) (normal l old-l))) - (let-values - () - (list (quote-syntax qq-append) uqsd l))) + (if (stx-null? l) + uqsd + (list (quote-syntax qq-append) + uqsd l))) (let-values (((restx) (qq-list rest (sub1 level)))) (let-values diff --git a/collects/scheme/private/qqstx.ss b/collects/scheme/private/qqstx.ss index 3a632aa636..d2669d2bc2 100644 --- a/collects/scheme/private/qqstx.ss +++ b/collects/scheme/private/qqstx.ss @@ -66,22 +66,29 @@ stx)] [((unsyntax-splicing x) . rest) (if (zero? depth) - (let ([rest-done-k - (lambda (rest-v bindings) - (with-syntax ([temp (car (generate-temporaries '(uqs)))] - [ctx (datum->syntax #'x 'ctx #'x)]) - (convert-k (datum->syntax - stx - (list* (syntax temp) - (quote-syntax ...) - rest-v) - stx) - (cons #'[(temp (... ...)) (check-splicing-list x (quote-syntax ctx))] - bindings))))]) - (loop (syntax rest) depth - (lambda () - (rest-done-k (syntax rest) null)) - rest-done-k)) + (if (stx-null? (syntax rest)) + (with-syntax ([temp (car (generate-temporaries '(uqs1)))]) + (convert-k (datum->syntax + stx + (syntax temp) + stx) + (list #'[temp x]))) + (let ([rest-done-k + (lambda (rest-v bindings) + (with-syntax ([temp (car (generate-temporaries '(uqs)))] + [ctx (datum->syntax #'x 'ctx #'x)]) + (convert-k (datum->syntax + stx + (list* (syntax temp) + (quote-syntax ...) + rest-v) + stx) + (cons #'[(temp (... ...)) (check-splicing-list x (quote-syntax ctx))] + bindings))))]) + (loop (syntax rest) depth + (lambda () + (rest-done-k (syntax rest) null)) + rest-done-k))) (let ([mk-rest-done-k (lambda (x-v x-bindings) (lambda (rest-v rest-bindings) diff --git a/collects/scribblings/gui/font-list-class.scrbl b/collects/scribblings/gui/font-list-class.scrbl index b736ca9315..491415f90b 100644 --- a/collects/scribblings/gui/font-list-class.scrbl +++ b/collects/scribblings/gui/font-list-class.scrbl @@ -33,7 +33,7 @@ Creates an empty font list. [underline any/c #f] [smoothing (one-of/c 'default 'partly-smoothed 'smoothed 'unsmoothed) 'default] [size-in-pixels? any/c #f]) - void?])]{ + (is-a?/c font%)])]{ Finds an existing font in the list or creates a new one (that is automatically added to the list). The arguments are the same as for diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index 25e6433871..e109cfd0f3 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -1013,12 +1013,18 @@ and the result of the @scheme[_expr] takes the place of the @scheme[(unquote-splicing _expr)] similarly escapes, but the @scheme[_expr] must produce a list, and its elements are spliced as multiple values place of the @scheme[(unquote-splicing _expr)], which -must appear as the @scheme[car] or a quoted pair. +must appear as the @scheme[car] or a quoted pair; if the @scheme[cdr] +of the relevant quoted pair is empty, then @scheme[_expr] need not +produce a list, and its result is used directly in place of the quoted +pair (in the same way that @scheme[append] accepts a non-list final +argument). @examples[ (eval:alts (#,(scheme quasiquote) (0 1 2)) `(0 1 2)) -(eval:alts (#,(scheme quasiquote) (0 (#,(scheme unquote) (+ 1 2)) 4)) `(1 ,(+ 1 2) 4)) -(eval:alts (#,(scheme quasiquote) (0 (#,(scheme unquote-splicing) (list 1 2)) 4)) `(1 ,@(list 1 2) 4)) +(eval:alts (#,(scheme quasiquote) (0 (#,(scheme unquote) (+ 1 2)) 4)) `(0 ,(+ 1 2) 4)) +(eval:alts (#,(scheme quasiquote) (0 (#,(scheme unquote-splicing) (list 1 2)) 4)) `(0 ,@(list 1 2) 4)) +(eval:alts (#,(scheme quasiquote) (0 (#,(scheme unquote-splicing) 1) 4)) `(0 ,@1 4)) +(eval:alts (#,(scheme quasiquote) (0 (#,(scheme unquote-splicing) 1))) `(0 ,@1)) ] A @scheme[quasiquote], @scheme[unquote], or @scheme[unquote-splicing] diff --git a/collects/tests/mzscheme/syntax.ss b/collects/tests/mzscheme/syntax.ss index 72331c32ed..09d2542172 100644 --- a/collects/tests/mzscheme/syntax.ss +++ b/collects/tests/mzscheme/syntax.ss @@ -663,7 +663,7 @@ (syntax-test #'(unquote-splicing 7)) (syntax-test #'`(1 . ,@5)) -(error-test #'`(1 ,@5)) +(test (cons 1 5) 'qq `(1 ,@5)) (error-test #'`(1 ,@5 2)) (define (qq-test e)