Re: Quasisyntax broken?

[Andreas Rottmann]

Andy Wingo <address@hidden> writes:

> On Fri 03 Jul 2009 02:04, Andreas Rottmann <address@hidden> 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 <address@hidden>
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/>