This page is part of the web mail archives of SRFI 93 from before July 7th, 2015. The new archives for SRFI 93 contain all messages, not just those from before July 7th, 2015.
Here is more correct and much more concise definition.
A quasisyntax expression is simply converted to a
with-syntax expression that performs the appropriate
substitutions. It runs on Petite.
I've been careful to port Bawden's extension of the
R5RS quasiquote semantics, which I suspect agrees with the
definition used for quasiquote in Chez, to quasisyntax.
Andre
;;;=========================================================
;;;
;;; Quasisyntax in terms of SRFI-93 syntax-case.
;;; Andre van Tonder
;;;
;;;=========================================================
;;;
;;; To make nested unquote-splicing behave in a useful way,
;;; the R5RS-compatible extension to quasiquote in appendix B
;;; of the following paper is used:
;;;
;;; Alan Bawden - Quasiquotation in Lisp
;;; http://citeseer.ist.psu.edu/bawden99quasiquotation.html
;;;
;;; The algorithm converts a quasisyntax expression to an
;;; equivalent with-syntax expression.
;;; For example:
;;;
;;; (quasisyntax (set! ,a ,b))
;;; ==> (with-syntax ((t0 a)
;;; (t1 b))
;;; (syntax (set! t0 t1)))
;;;
;;; (quasisyntax (list ,@args))
;;; ==> (with-syntax (((t ...) args))
;;; (syntax (list t ...)))
;;;
;;; Note that quasisyntax is expanded first, before any
;;; ellipses act. For example:
;;;
;;; (quasisyntax (f ((b ,a) ...))
;;; ==> (with-syntax ((t a))
;;; (syntax (f ((b t) ...))))
;;;
;;; so that
;;;
;;; (let-syntax ((test-ellipses-over-unsyntax
;;; (lambda (e)
;;; (let ((a (syntax a)))
;;; (with-syntax (((b ...) (syntax (1 2 3))))
;;; (quasisyntax
;;; (quote ((b ,a) ...))))))))
;;; (test-ellipses-over-unsyntax))
;;;
;;; ==> ((1 a) (2 a) (3 a))
(define-syntax quasisyntax
(lambda (e)
(define (expand-quasisyntax x)
;; Expand returns a syntax object of the form
;; (template[t/e, ...] (replacement ...))
;; Here template[t/e ...] denotes the original template
;; with unquoted expressions e replaced by fresh
;; variables t, followed by the appropriate ellipses
;; if e is also spliced.
;; The second part of the return value is the list of
;; replacements, each of the form (t e) if e is just
;; unquoted, or ((t ...) e) if e is also spliced.
;; This will be the list of bindings of the resulting
;; with-syntax expression.
(define (expand x level)
(syntax-case x (quasisyntax unquote unquote-splicing)
((quasisyntax e)
(with-syntax (((k _) x) ; Original must be copied
((rest bs) (expand (syntax e) (+ level 1))))
(syntax
((k . rest) bs))))
((unquote e)
(= level 0)
(with-syntax (((t) (generate-temporaries '(t))))
(syntax (t (t e)))))
(((unquote e ...) . r)
(= level 0)
(with-syntax (((rest (b ...)) (expand (syntax r) 0))
((t ...) (generate-temporaries (syntax (e
...)))))
(syntax
((t ... . rest)
((t e) ... b ...)))))
(((unquote-splicing e ...) . r)
(= level 0)
(with-syntax (((rest (b ...)) (expand (syntax r) 0))
((t ...) (generate-temporaries (syntax (e
...)))))
(with-syntax ((((t ...) ...) (syntax ((t (... ...)) ...))))
(syntax
((t ... ... . rest)
(((t ...) e) ...))))))
((k . r)
(and (> level 0)
(or (free-identifier=? (syntax k) (syntax unquote))
(free-identifier=? (syntax k) (syntax unquote-splicing))))
(with-syntax (((rest bs) (expand (syntax r) (- level 1))))
(syntax
((k . rest) bs))))
((h . t)
(with-syntax (((head (b1 ...)) (expand (syntax h) level))
((tail (b2 ...)) (expand (syntax t) level)))
(syntax
((head . tail)
(b1 ... b2 ...)))))
(()
(syntax (() ())))
(id
(identifier? (syntax id))
(syntax (id ())))
(#(e ...)
(with-syntax ((((e* ...) bs)
(expand (vector->list (syntax #(e ...)) level))))
(syntax
(#(e* ...) bs))))
(other
(syntax (other ())))))
(with-syntax (((template bindings) (expand x 0)))
(syntax
(with-syntax bindings (syntax template)))))
(syntax-case e ()
((k template)
(expand-quasisyntax (syntax template))))))
;;;=============================================================
;;;
;;; Tests
;;;
;;;==============================================================
(define-syntax swap!
(lambda (e)
(syntax-case e ()
((_ a b)
(let ((a (syntax a))
(b (syntax b)))
(quasisyntax
(let ((temp ,a))
(set! ,a ,b)
(set! ,b temp))))))))
(let ((temp 1)
(set! 2))
(swap! set! temp)
(values temp set!)) ;==> 2 1
(define-syntax case
(lambda (x)
(syntax-case x ()
((_ e c1 c2 ...)
(quasisyntax
(let ((t e))
,(let f ((c1 (syntax c1)) (cmore (syntax (c2 ...))))
(if (null? cmore)
(syntax-case c1 (else)
((else e1 e2 ...) (syntax (begin e1 e2 ...)))
(((k ...) e1 e2 ...) (syntax (if (memv t '(k ...))
(begin e1 e2 ...)))))
(syntax-case c1 ()
(((k ...) e1 e2 ...)
(quasisyntax
(if (memv t '(k ...))
(begin e1 e2 ...)
,(f (car cmore) (cdr cmore))))))))))))))
(case 'a
((b c) 'no)
((d a) 'yes))
(define-syntax let-in-order
(lambda (form)
(syntax-case form ()
((_ ((i e) ...) e0 e1 ...)
(let f ((ies (syntax ((i e) ...)))
(its (syntax ())))
(syntax-case ies ()
(() (quasisyntax (let ,its e0 e1 ...)))
(((i e) . ies) (with-syntax (((t) (generate-temporaries '(t))))
(quasisyntax
(let ((t e))
,(f (syntax ies)
(quasisyntax
((i t) ,@its)))))))))))))
(let-in-order ((x 1)
(y 2))
(+ x y)) ;==> 3
(let-syntax ((test-ellipses-over-unsyntax
(lambda (e)
(let ((a (syntax a)))
(with-syntax (((b ...) (syntax (1 2 3))))
(quasisyntax
(quote ((b ,a) ...))))))))
(test-ellipses-over-unsyntax))
;==> ((1 a) (2 a) (3 a))