Andy Wingo <wi...@pobox.com> writes:
> On Fri 03 Jul 2009 02:04, Andreas Rottmann <a.rottm...@gmx.at> writes:
>
>> Playing around with Guile's now-in-core syntax-case support (using Git
>> HEAD as of today), I found that quasisyntax seems quite broken:
>
> We've spoken over IRC since then, but for those that do not frequent
> there, it's simply not implemented. You can implement it in terms of
> with-syntax, though. Did you have a patch for that, Andreas?
>
Yep, the patch is attached:
From: Andreas Rottmann <a.rottm...@gmx.at>
Subject: [PATCH] Add support for `quasisyntax'
---
module/ice-9/boot-9.scm | 75 +++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 75 insertions(+), 0 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 36a463a..26d73a7 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -308,6 +308,81 @@
(syntax-rules ()
((_ exp) (make-promise (lambda () exp)))))
+;; Add quasisyntax support. This is a slight variation of the code
+;; posted in http://srfi.schemers.org/srfi-93/mail-archive/msg00063.html
+(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 unsyntax unsyntax-splicing)
+ ((quasisyntax e)
+ (with-syntax (((k _) x) ; Original must be copied
+ ((rest bs) (expand (syntax e) (+ level 1))))
+ (syntax
+ ((k rest) bs))))
+ ((unsyntax e)
+ (= level 0)
+ (with-syntax (((t) (generate-temporaries '(t))))
+ (syntax (t ((t e))))))
+ (((unsyntax e ...) . r)
+ (= level 0)
+ (with-syntax (((rest (b ...)) (expand (syntax r) 0))
+ ((t ...) (generate-temporaries (syntax (e ...)))))
+
+ (syntax
+ ((t ... . rest)
+ ((t e) ... b ...)))))
+ (((unsyntax-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) ... b ...))))))
+ ((k . r)
+ (and (> level 0)
+ (identifier? (syntax k))
+ (or (free-identifier=? (syntax k) (syntax unsyntax))
+ (free-identifier=? (syntax k) (syntax unsyntax-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 ...)))))
+ (#(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))))))
;;; {Defmacros}
--
tg: (3b0b6bc..) t/quasisyntax (depends on: master)
>From my few experiments, it seems to work nicely.
Cheers, Rotty
--
Andreas Rottmann -- <http://rotty.yi.org/>
