unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules
@ 2013-12-19  0:33 Mark H Weaver
  2014-01-08 11:41 ` Ludovic Courtès
  0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2013-12-19  0:33 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 2276 bytes --]

Hello all,

This patch implements a new primitive syntax form 'with-ellipsis' that
changes the ellipsis identifier within a lexical scope, and uses this to
implement the R7RS extension to 'syntax-rules'.  I'd like to apply this
to the stable-2.0 branch.

It took me quite a while to figure out the right way to generalize this
R7RS feature for the syntax-case system.  My first idea was to make
'syntax' a syntax parameter, but further thought made it clear that this
would be inadequate.  Consider all of the other macros based on 'syntax'
and 'syntax-case': things such as 'with-syntax', 'quasisyntax', etc.

It was obvious that 'with-ellipsis' should modify the lexical
environment somehow, but how?  First of all, consider that a single
'syntax' or 'syntax-case' form might, in general, be composed of
identifiers from many different lexical environments.  The lexical
environment of the 'syntax' keyword is not the right environment to look
at for the entire template, because in a 'quasisyntax' or 'syntax-rules'
form, that's the lexical environment of the 'quasisyntax' or
'syntax-rules' macro.

It soon became clear that I must search the lexical environment of each
identifier within a pattern or template to determine if that identifier
is an ellipsis.  But what identifier should it look up in that lexical
environment?  Again, my first thought was to look up the identifier
itself, but that's not right either.  A 'with-ellipsis' form must not
only add a new ellipsis identifier; it must also disable the special
meaning of the previous ellipsis identifier.

In the end, here's how this works: 'with-ellipsis' binds a special
identifier named #{ $sc-ellipsis }# using a new 'ellipsis' binding type.
The new ellipsis identifier is stored within the binding.  In order to
determine whether an identifier X is an ellipsis, the binding for
#{ $sc-ellipsis }# is looked up in the lexical environment of X.  If the
binding is found and has binding-type 'ellipsis', then X is compared to
the identifier stored in the binding using 'bound-id=?'.  Otherwise, X
is compared to '...' using 'free-id=?' as was done before.

After much thought, I'm fairly confident that this is the only good
approach.  I'd like to push this to stable-2.0.

Comments and suggestions welcome.


[-- Attachment #2: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules --]
[-- Type: text/x-patch, Size: 40561 bytes --]

From 619bb46010696f232f09f124049739becfe94611 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Wed, 18 Dec 2013 18:49:37 -0500
Subject: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS
 syntax-rules.

* module/ice-9/psyntax.scm (binding-type): Update the header comment
  to mention the new 'ellipsis' binding type.
  (ellipsis?): Add 'r' and 'mod' as arguments.  Search the lexical
  environment for an ellipsis binding, and use it.
  (gen-syntax): Adapt to the additional arguments of 'ellipsis?'.
  (with-ellipsis): New core syntax.
  (convert-pattern): Add unary 'ellipsis?' procedure as an argument.
  (gen-clause): Adapt to the additional arguments of 'ellipsis?'.
  Pass unary 'ellipsis?' procedure to 'convert-pattern'.
  (syntax-case): Adapt to the additional arguments of 'ellipsis?'.
  (syntax-local-binding): Support new 'ellipsis' binding type.
  (syntax-rules): Add support for a custom ellipsis identifier as
  the first operand, as per R7RS.  Collect common code within new
  local procedure 'expand-syntax-rules'.

* module/ice-9/psyntax-pp.scm: Regenerate.

* module/ice-9/local-eval.scm (analyze-identifiers): Add support for
  'ellipsis' binding type.

* doc/ref/api-macros.texi (Syntax Rules): Add docs for R7RS custom
  ellipsis syntax.  Use @dots{}.
  (Syntax Case): Add docs for 'with-ellipsis'.  Use @dots{}.
  (Syntax Transformer Helpers): Update to include new 'ellipsis'
  binding type.

* test-suite/tests/syntax.test: Add tests.
---
 doc/ref/api-macros.texi      |   73 +++++++++++++-
 module/ice-9/local-eval.scm  |    8 ++-
 module/ice-9/psyntax-pp.scm  |  225 ++++++++++++++++++++++++++++++------------
 module/ice-9/psyntax.scm     |  108 +++++++++++++++-----
 test-suite/tests/syntax.test |  106 ++++++++++++++++++++-
 5 files changed, 423 insertions(+), 97 deletions(-)

diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index a3fa83f..61137f0 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -136,7 +136,7 @@ same @var{letrec-syntax}.
 @code{syntax-rules} macros are simple, pattern-driven syntax transformers, with
 a beauty worthy of Scheme.
 
-@deffn {Syntax} syntax-rules literals (pattern template)...
+@deffn {Syntax} syntax-rules literals (pattern template) @dots{}
 Create a syntax transformer that will rewrite an expression using the rules
 embodied in the @var{pattern} and @var{template} clauses.
 @end deffn
@@ -363,6 +363,26 @@ Cast into this form, our @code{when} example is significantly shorter:
   (if c (begin e ...)))
 @end example
 
+@subsubsection Specifying a custom ellipsis identifier
+
+When writing macros that generate macro definitions, it is convenient to
+use a different ellipsis identifier at each level.  Guile allows the
+desired ellipsis identifier to be specified as the first operand to
+@code{syntax-rules}, as per R7RS.  For example:
+
+@example
+(define-syntax define-quotation-macros
+  (syntax-rules ()
+    ((_ (macro-name head-symbol) ...)
+     (begin (define-syntax macro-name
+              (syntax-rules ::: ()
+                ((_ x :::)
+                 (quote (head-symbol x :::)))))
+            ...))))
+(define-quotation-macros (quote-a a) (quote-b b) (quote-c c))
+(quote-a 1 2 3) @result{} (a 1 2 3)
+@end example
+
 @subsubsection Further Information
 
 For a formal definition of @code{syntax-rules} and its pattern language, see
@@ -389,7 +409,7 @@ Primer for the Merely Eccentric}.
 @code{syntax-case} macros are procedural syntax transformers, with a power
 worthy of Scheme.
 
-@deffn {Syntax} syntax-case syntax literals (pattern [guard] exp)...
+@deffn {Syntax} syntax-case syntax literals (pattern [guard] exp) @dots{}
 Match the syntax object @var{syntax} against the given patterns, in order. If a
 @var{pattern} matches, return the result of evaluating the associated @var{exp}.
 @end deffn
@@ -631,9 +651,9 @@ variable environment, and we can do so using @code{syntax-case} itself:
 However there are easier ways to write this. @code{with-syntax} is often
 convenient:
 
-@deffn {Syntax} with-syntax ((pat val)...) exp...
+@deffn {Syntax} with-syntax ((pat val) @dots{}) exp @dots{}
 Bind patterns @var{pat} from their corresponding values @var{val}, within the
-lexical context of @var{exp...}.
+lexical context of @var{exp} @enddots{}.
 
 @example
 ;; better
@@ -681,6 +701,44 @@ edition 3 or 4, in the chapter on syntax. Dybvig was the primary author of the
 @code{syntax-case} system. The book itself is available online at
 @uref{http://scheme.com/tspl4/}.
 
+@subsubsection Custom ellipsis identifiers for syntax-case macros
+
+When writing procedural macros that generate macro definitions, it is
+convenient to use a different ellipsis identifier at each level.  Guile
+supports this for procedural macros using the @code{with-ellipsis}
+special form:
+
+@deffn {Syntax} with-ellipsis ellipsis body @dots{}
+@var{ellipsis} must be an identifier.  Evaluate @var{body} in a special
+lexical environment such that all macro patterns and templates within
+@var{body} will use @var{ellipsis} as the ellipsis identifier instead of
+the usual three dots (@code{...}).
+@end deffn
+
+For example:
+
+@example
+(define-syntax define-quotation-macros
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (macro-name head-symbol) ...)
+       #'(begin (define-syntax macro-name
+                  (lambda (x)
+                    (with-ellipsis :::
+                      (syntax-case x ()
+                        ((_ x :::)
+                         #'(quote (head-symbol x :::)))))))
+                ...)))))
+(define-quotation-macros (quote-a a) (quote-b b) (quote-c c))
+(quote-a 1 2 3) @result{} (a 1 2 3)
+@end example
+
+Note that the effect of @code{with-ellipsis} does not propagate within
+nested syntax binding forms such as @code{define-syntax},
+@code{let-syntax}, or @code{letrec-syntax}.  It also does not affect the
+ellipsis identifier of the generated code, unless @code{with-ellipsis}
+is included around the generated code.
+
 @node Syntax Transformer Helpers
 @subsection Syntax Transformer Helpers
 
@@ -740,8 +798,11 @@ of @code{eq?}) identifying this binding.
 A syntax transformer, either local or global.  The value is the
 transformer procedure.
 @item pattern-variable
-A pattern variable, bound via syntax-case.  The value is an opaque
-object, internal to the expander.
+A pattern variable, bound via @code{syntax-case}.  The value is an
+opaque object, internal to the expander.
+@item ellipsis
+An internal binding, bound via @code{with-ellipsis}.  The value is the
+(anti-marked) local ellipsis identifier.
 @item displaced-lexical
 A lexical variable that has gone out of scope.  This can happen if a
 badly-written procedural macro saves a syntax object, then attempts to
diff --git a/module/ice-9/local-eval.scm b/module/ice-9/local-eval.scm
index 28f30b9..bd3588b 100644
--- a/module/ice-9/local-eval.scm
+++ b/module/ice-9/local-eval.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2012 Free Software Foundation, Inc.
+;;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -179,6 +179,12 @@
                                  (cdr val)
                                  t)
                            patterns))))
+              ((ellipsis)
+               (lp ids capture formals
+                   (cons (lambda (x)
+                           #`(with-ellipsis #,val #,x))
+                         wrappers)
+                   patterns))
               (else
                (error "what" type val))))))))))
 
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index f5f764b..a9015b2 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1096,9 +1096,17 @@
            (syntax-violation #f "nonprocedure transformer" p)))))
    (expand-void (lambda () (build-void #f)))
    (ellipsis?
-     (lambda (x)
-       (and (nonsymbol-id? x)
-            (free-id=? x '#(syntax-object ... ((top)) (hygiene guile))))))
+     (lambda (e r mod)
+       (and (nonsymbol-id? e)
+            (let* ((id (make-syntax-object
+                         '#{ $sc-ellipsis }#
+                         (syntax-object-wrap e)
+                         (syntax-object-module e)))
+                   (n (id-var-name id '(())))
+                   (b (lookup n r mod)))
+              (if (eq? (car b) 'ellipsis)
+                (bound-id=? e (cdr b))
+                (free-id=? e '#(syntax-object ... ((top)) (hygiene guile))))))))
    (lambda-formals
      (lambda (orig-args)
        (letrec*
@@ -1567,14 +1575,15 @@
                           (let ((var.lev (cdr b)))
                             (gen-ref src (car var.lev) (cdr var.lev) maps)))
                         (lambda (var maps) (values (list 'ref var) maps))))
-                     ((ellipsis? e) (syntax-violation 'syntax "misplaced ellipsis" src))
+                     ((ellipsis? e r mod)
+                      (syntax-violation 'syntax "misplaced ellipsis" src))
                      (else (values (list 'quote e) maps))))
              (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(any any))))
-               (if (and tmp-1 (apply (lambda (dots e) (ellipsis? dots)) tmp-1))
-                 (apply (lambda (dots e) (gen-syntax src e r maps (lambda (x) #f) mod))
+               (if (and tmp-1 (apply (lambda (dots e) (ellipsis? dots r mod)) tmp-1))
+                 (apply (lambda (dots e) (gen-syntax src e r maps (lambda (e r mod) #f) mod))
                         tmp-1)
                  (let ((tmp-1 ($sc-dispatch tmp '(any any . any))))
-                   (if (and tmp-1 (apply (lambda (x dots y) (ellipsis? dots)) tmp-1))
+                   (if (and tmp-1 (apply (lambda (x dots y) (ellipsis? dots r mod)) tmp-1))
                      (apply (lambda (x dots y)
                               (let f ((y y)
                                       (k (lambda (maps)
@@ -1585,7 +1594,7 @@
                                                  (syntax-violation 'syntax "extra ellipsis" src)
                                                  (values (gen-map x (car maps)) (cdr maps))))))))
                                 (let* ((tmp y) (tmp ($sc-dispatch tmp '(any . any))))
-                                  (if (and tmp (apply (lambda (dots y) (ellipsis? dots)) tmp))
+                                  (if (and tmp (apply (lambda (dots y) (ellipsis? dots r mod)) tmp))
                                     (apply (lambda (dots y)
                                              (f y
                                                 (lambda (maps)
@@ -1810,6 +1819,30 @@
                 (syntax-violation 'case-lambda "bad case-lambda*" e))))))))
   (global-extend
     'core
+    'with-ellipsis
+    (lambda (e r w s mod)
+      (let* ((tmp e) (tmp ($sc-dispatch tmp '(_ any any . each-any))))
+        (if (and tmp (apply (lambda (dots e1 e2) (id? dots)) tmp))
+          (apply (lambda (dots e1 e2)
+                   (let ((id (if (symbol? dots)
+                               '#{ $sc-ellipsis }#
+                               (make-syntax-object
+                                 '#{ $sc-ellipsis }#
+                                 (syntax-object-wrap dots)
+                                 (syntax-object-module dots)))))
+                     (let ((ids (list id))
+                           (labels (list (gen-label)))
+                           (bindings (list (cons 'ellipsis (source-wrap dots w s mod)))))
+                       (let ((nw (make-binding-wrap ids labels w))
+                             (nr (extend-env labels bindings r)))
+                         (expand-body (cons e1 e2) (source-wrap e nw s mod) nr nw mod)))))
+                 tmp)
+          (syntax-violation
+            'with-ellipsis
+            "bad syntax"
+            (source-wrap e w s mod))))))
+  (global-extend
+    'core
     'let
     (letrec*
       ((expand-let
@@ -2069,7 +2102,7 @@
     'syntax-case
     (letrec*
       ((convert-pattern
-         (lambda (pattern keys)
+         (lambda (pattern keys ellipsis?)
            (letrec*
              ((cvt* (lambda (p* n ids)
                       (let* ((tmp p*) (tmp ($sc-dispatch tmp '(any . any))))
@@ -2163,9 +2196,10 @@
        (gen-clause
          (lambda (x keys clauses r pat fender exp mod)
            (call-with-values
-             (lambda () (convert-pattern pat keys))
+             (lambda ()
+               (convert-pattern pat keys (lambda (e) (ellipsis? e r mod))))
              (lambda (p pvars)
-               (cond ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
+               (cond ((not (and-map (lambda (x) (not (ellipsis? (car x) r mod))) pvars))
                       (syntax-violation 'syntax-case "misplaced ellipsis" pat))
                      ((not (distinct-bound-ids? (map car pvars)))
                       (syntax-violation 'syntax-case "duplicate pattern variable" pat))
@@ -2245,7 +2279,7 @@
                (tmp ($sc-dispatch tmp-1 '(_ any each-any . each-any))))
           (if tmp
             (apply (lambda (val key m)
-                     (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x)))) key)
+                     (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x r mod)))) key)
                        (let ((x (gen-var 'tmp)))
                          (build-application
                            s
@@ -2361,6 +2395,13 @@
                            ((memv key '(syntax)) (values 'pattern-variable value))
                            ((memv key '(displaced-lexical)) (values 'displaced-lexical #f))
                            ((memv key '(global)) (values 'global (cons value (cdr mod))))
+                           ((memv key '(ellipsis))
+                            (values
+                              'ellipsis
+                              (make-syntax-object
+                                (syntax-object-expression value)
+                                (anti-mark (syntax-object-wrap value))
+                                (syntax-object-module value))))
                            (else (values 'other #f)))))))))))
      (syntax-locally-bound-identifiers
        (lambda (id)
@@ -2547,56 +2588,116 @@
     'syntax-rules
     'macro
     (lambda (xx)
-      (let ((tmp-1 xx))
-        (let ((tmp ($sc-dispatch tmp-1 '(_ each-any . #(each ((any . any) any))))))
-          (if tmp
-            (apply (lambda (k keyword pattern template)
-                     (list '#(syntax-object lambda ((top)) (hygiene guile))
-                           '(#(syntax-object x ((top)) (hygiene guile)))
-                           (vector
-                             '(#(syntax-object macro-type ((top)) (hygiene guile))
-                               .
-                               #(syntax-object syntax-rules ((top)) (hygiene guile)))
-                             (cons '#(syntax-object patterns ((top)) (hygiene guile)) pattern))
-                           (cons '#(syntax-object syntax-case ((top)) (hygiene guile))
-                                 (cons '#(syntax-object x ((top)) (hygiene guile))
-                                       (cons k
-                                             (map (lambda (tmp-1 tmp)
-                                                    (list (cons '#(syntax-object dummy ((top)) (hygiene guile)) tmp)
-                                                          (list '#(syntax-object syntax ((top)) (hygiene guile))
-                                                                tmp-1)))
-                                                  template
-                                                  pattern))))))
-                   tmp)
-            (let ((tmp ($sc-dispatch tmp-1 '(_ each-any any . #(each ((any . any) any))))))
-              (if (if tmp
-                    (apply (lambda (k docstring keyword pattern template)
-                             (string? (syntax->datum docstring)))
-                           tmp)
-                    #f)
-                (apply (lambda (k docstring keyword pattern template)
-                         (list '#(syntax-object lambda ((top)) (hygiene guile))
-                               '(#(syntax-object x ((top)) (hygiene guile)))
-                               docstring
-                               (vector
-                                 '(#(syntax-object macro-type ((top)) (hygiene guile))
-                                   .
-                                   #(syntax-object syntax-rules ((top)) (hygiene guile)))
-                                 (cons '#(syntax-object patterns ((top)) (hygiene guile)) pattern))
-                               (cons '#(syntax-object syntax-case ((top)) (hygiene guile))
-                                     (cons '#(syntax-object x ((top)) (hygiene guile))
-                                           (cons k
-                                                 (map (lambda (tmp-1 tmp)
-                                                        (list (cons '#(syntax-object dummy ((top)) (hygiene guile)) tmp)
-                                                              (list '#(syntax-object syntax ((top)) (hygiene guile))
-                                                                    tmp-1)))
-                                                      template
-                                                      pattern))))))
-                       tmp)
-                (syntax-violation
-                  #f
-                  "source expression failed to match any pattern"
-                  tmp-1)))))))))
+      (letrec*
+        ((expand-syntax-rules
+           (lambda (dots keys docstrings clauses)
+             (let ((tmp-1 (list keys docstrings clauses)))
+               (let ((tmp ($sc-dispatch tmp-1 '(each-any each-any #(each ((any . any) any))))))
+                 (if tmp
+                   (apply (lambda (k docstring keyword pattern template)
+                            (let ((tmp (cons '#(syntax-object lambda ((top)) (hygiene guile))
+                                             (cons '(#(syntax-object x ((top)) (hygiene guile)))
+                                                   (append
+                                                     docstring
+                                                     (list (vector
+                                                             '(#(syntax-object macro-type ((top)) (hygiene guile))
+                                                               .
+                                                               #(syntax-object syntax-rules ((top)) (hygiene guile)))
+                                                             (cons '#(syntax-object patterns ((top)) (hygiene guile))
+                                                                   pattern))
+                                                           (cons '#(syntax-object syntax-case ((top)) (hygiene guile))
+                                                                 (cons '#(syntax-object x ((top)) (hygiene guile))
+                                                                       (cons k
+                                                                             (map (lambda (tmp-1 tmp)
+                                                                                    (list (cons '#(syntax-object
+                                                                                                   dummy
+                                                                                                   ((top))
+                                                                                                   (hygiene guile))
+                                                                                                tmp)
+                                                                                          (list '#(syntax-object
+                                                                                                   syntax
+                                                                                                   ((top))
+                                                                                                   (hygiene guile))
+                                                                                                tmp-1)))
+                                                                                  template
+                                                                                  pattern))))))))))
+                              (let ((form tmp))
+                                (if dots
+                                  (let ((tmp dots))
+                                    (let ((dots tmp))
+                                      (list '#(syntax-object with-ellipsis ((top)) (hygiene guile))
+                                            dots
+                                            form)))
+                                  form))))
+                          tmp)
+                   (syntax-violation
+                     #f
+                     "source expression failed to match any pattern"
+                     tmp-1)))))))
+        (let ((tmp xx))
+          (let ((tmp-1 ($sc-dispatch tmp '(_ each-any . #(each ((any . any) any))))))
+            (if tmp-1
+              (apply (lambda (k keyword pattern template)
+                       (expand-syntax-rules
+                         #f
+                         k
+                         '()
+                         (map (lambda (tmp-2 tmp-1 tmp) (list (cons tmp tmp-1) tmp-2))
+                              template
+                              pattern
+                              keyword)))
+                     tmp-1)
+              (let ((tmp-1 ($sc-dispatch tmp '(_ each-any any . #(each ((any . any) any))))))
+                (if (if tmp-1
+                      (apply (lambda (k docstring keyword pattern template)
+                               (string? (syntax->datum docstring)))
+                             tmp-1)
+                      #f)
+                  (apply (lambda (k docstring keyword pattern template)
+                           (expand-syntax-rules
+                             #f
+                             k
+                             (list docstring)
+                             (map (lambda (tmp-2 tmp-1 tmp) (list (cons tmp tmp-1) tmp-2))
+                                  template
+                                  pattern
+                                  keyword)))
+                         tmp-1)
+                  (let ((tmp-1 ($sc-dispatch tmp '(_ any each-any . #(each ((any . any) any))))))
+                    (if (if tmp-1
+                          (apply (lambda (dots k keyword pattern template) (identifier? dots))
+                                 tmp-1)
+                          #f)
+                      (apply (lambda (dots k keyword pattern template)
+                               (expand-syntax-rules
+                                 dots
+                                 k
+                                 '()
+                                 (map (lambda (tmp-2 tmp-1 tmp) (list (cons tmp tmp-1) tmp-2))
+                                      template
+                                      pattern
+                                      keyword)))
+                             tmp-1)
+                      (let ((tmp-1 ($sc-dispatch tmp '(_ any each-any any . #(each ((any . any) any))))))
+                        (if (if tmp-1
+                              (apply (lambda (dots k docstring keyword pattern template)
+                                       (if (identifier? dots) (string? (syntax->datum docstring)) #f))
+                                     tmp-1)
+                              #f)
+                          (apply (lambda (dots k docstring keyword pattern template)
+                                   (expand-syntax-rules
+                                     dots
+                                     k
+                                     (list docstring)
+                                     (map (lambda (tmp-2 tmp-1 tmp) (list (cons tmp tmp-1) tmp-2))
+                                          template
+                                          pattern
+                                          keyword)))
+                                 tmp-1)
+                          (syntax-violation
+                            #f
+                            "source expression failed to match any pattern"
+                            tmp))))))))))))))
 
 (define define-syntax-rule
   (make-syntax-transformer
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index fa009d2..143d4c7 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -42,6 +42,9 @@
 ;;; Modified by Andy Wingo <wingo@pobox.com> according to the Git
 ;;; revision control logs corresponding to this file: 2009, 2010.
 
+;;; Modified by Mark H Weaver <mhw@netris.org> according to the Git
+;;; revision control logs corresponding to this file: 2012, 2013.
+
 
 ;;; This code is based on "Syntax Abstraction in Scheme"
 ;;; by R. Kent Dybvig, Robert Hieb, and Carl Bruggeman.
@@ -509,6 +512,7 @@
     ;;               (syntax . (<var> . <level>))    pattern variables
     ;;               (global)                        assumed global variable
     ;;               (lexical . <var>)               lexical variables
+    ;;               (ellipsis . <identifier>)       custom ellipsis
     ;;               (displaced-lexical)             displaced lexicals
     ;; <level>   ::= <nonnegative integer>
     ;; <var>     ::= variable returned by build-lexical-var
@@ -528,6 +532,9 @@
 
     ;; a lexical variable is a lambda- or letrec-bound variable.
 
+    ;; an ellipsis binding is introduced by the 'with-ellipsis' special
+    ;; form.
+
     ;; a displaced-lexical identifier is a lexical identifier removed from
     ;; it's scope by the return of a syntax object containing the identifier.
     ;; a displaced lexical can also appear when a letrec-syntax-bound
@@ -1574,9 +1581,22 @@
         (build-void no-source)))
 
     (define ellipsis?
-      (lambda (x)
-        (and (nonsymbol-id? x)
-             (free-id=? x #'(... ...)))))
+      (lambda (e r mod)
+        (and (nonsymbol-id? e)
+             ;; If there is a binding for the special identifier
+             ;; #{ $sc-ellipsis }# in the lexical environment of E,
+             ;; and if the associated binding type is 'ellipsis',
+             ;; then the binding's value specifies the custom ellipsis
+             ;; identifier within that lexical environment, and the
+             ;; comparison is done using 'bound-id=?'.
+             (let* ((id (make-syntax-object '#{ $sc-ellipsis }#
+                                            (syntax-object-wrap e)
+                                            (syntax-object-module e)))
+                    (n (id-var-name id empty-wrap))
+                    (b (lookup n r mod)))
+               (if (eq? (binding-type b) 'ellipsis)
+                   (bound-id=? e (binding-value b))
+                   (free-id=? e #'(... ...)))))))
 
     (define lambda-formals
       (lambda (orig-args)
@@ -1901,17 +1921,17 @@
                                            (let ((var.lev (binding-value b)))
                                              (gen-ref src (car var.lev) (cdr var.lev) maps)))
                                        (lambda (var maps) (values `(ref ,var) maps)))
-                                     (if (ellipsis? e)
+                                     (if (ellipsis? e r mod)
                                          (syntax-violation 'syntax "misplaced ellipsis" src)
                                          (values `(quote ,e) maps)))))
                              (syntax-case e ()
                                ((dots e)
-                                (ellipsis? #'dots)
-                                (gen-syntax src #'e r maps (lambda (x) #f) mod))
+                                (ellipsis? #'dots r mod)
+                                (gen-syntax src #'e r maps (lambda (e r mod) #f) mod))
                                ((x dots . y)
                                 ;; this could be about a dozen lines of code, except that we
                                 ;; choose to handle #'(x ... ...) forms
-                                (ellipsis? #'dots)
+                                (ellipsis? #'dots r mod)
                                 (let f ((y #'y)
                                         (k (lambda (maps)
                                              (call-with-values
@@ -1926,7 +1946,7 @@
                                                              (cdr maps))))))))
                                   (syntax-case y ()
                                     ((dots . y)
-                                     (ellipsis? #'dots)
+                                     (ellipsis? #'dots r mod)
                                      (f #'y
                                         (lambda (maps)
                                           (call-with-values
@@ -2119,6 +2139,25 @@
                                   #'((args e1 e2 ...) ...)))
                        (_ (syntax-violation 'case-lambda "bad case-lambda*" e)))))
 
+    (global-extend 'core 'with-ellipsis
+                   (lambda (e r w s mod)
+                     (syntax-case e ()
+                       ((_ dots e1 e2 ...)
+                        (id? #'dots)
+                        (let ((id (if (symbol? #'dots)
+                                      '#{ $sc-ellipsis }#
+                                      (make-syntax-object '#{ $sc-ellipsis }#
+                                                          (syntax-object-wrap #'dots)
+                                                          (syntax-object-module #'dots)))))
+                          (let ((ids (list id))
+                                (labels (list (gen-label)))
+                                (bindings (list (make-binding 'ellipsis (source-wrap #'dots w s mod)))))
+                            (let ((nw (make-binding-wrap ids labels w))
+                                  (nr (extend-env labels bindings r)))
+                              (expand-body #'(e1 e2 ...) (source-wrap e nw s mod) nr nw mod)))))
+                       (_ (syntax-violation 'with-ellipsis "bad syntax"
+                                            (source-wrap e w s mod))))))
+
     (global-extend 'core 'let
                    (let ()
                      (define (expand-let e r w s mod constructor ids vals exps)
@@ -2338,7 +2377,7 @@
                      (define convert-pattern
                        ;; accepts pattern & keys
                        ;; returns $sc-dispatch pattern & ids
-                       (lambda (pattern keys)
+                       (lambda (pattern keys ellipsis?)
                          (define cvt*
                            (lambda (p* n ids)
                              (syntax-case p* ()
@@ -2427,10 +2466,10 @@
                      (define gen-clause
                        (lambda (x keys clauses r pat fender exp mod)
                          (call-with-values
-                             (lambda () (convert-pattern pat keys))
+                             (lambda () (convert-pattern pat keys (lambda (e) (ellipsis? e r mod))))
                            (lambda (p pvars)
                              (cond
-                              ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
+                              ((not (and-map (lambda (x) (not (ellipsis? (car x) r mod))) pvars))
                                (syntax-violation 'syntax-case "misplaced ellipsis" pat))
                               ((not (distinct-bound-ids? (map car pvars)))
                                (syntax-violation 'syntax-case "duplicate pattern variable" pat))
@@ -2500,7 +2539,7 @@
                        (let ((e (source-wrap e w s mod)))
                          (syntax-case e ()
                            ((_ val (key ...) m ...)
-                            (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x))))
+                            (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x r mod))))
                                          #'(key ...))
                                 (let ((x (gen-var 'tmp)))
                                   ;; fat finger binding and references to temp variable x
@@ -2604,6 +2643,11 @@
                  ((syntax) (values 'pattern-variable value))
                  ((displaced-lexical) (values 'displaced-lexical #f))
                  ((global) (values 'global (cons value (cdr mod))))
+                 ((ellipsis)
+                  (values 'ellipsis
+                          (make-syntax-object (syntax-object-expression value)
+                                              (anti-mark (syntax-object-wrap value))
+                                              (syntax-object-module value))))
                  (else (values 'other #f))))))))
 
       (define (syntax-locally-bound-identifiers id)
@@ -2797,25 +2841,35 @@
 
 (define-syntax syntax-rules
   (lambda (xx)
+    (define (expand-syntax-rules dots keys docstrings clauses)
+      (with-syntax
+          (((k ...) keys)
+           ((docstring ...) docstrings)
+           ((((keyword . pattern) template) ...) clauses))
+        (with-syntax
+            ((form #'(lambda (x)
+                       docstring ...        ; optional docstring
+                       #((macro-type . syntax-rules)
+                         (patterns pattern ...)) ; embed patterns as procedure metadata
+                       (syntax-case x (k ...)
+                         ((dummy . pattern) #'template)
+                         ...))))
+          (if dots
+              (with-syntax ((dots dots))
+                #'(with-ellipsis dots form))
+              #'form))))
     (syntax-case xx ()
       ((_ (k ...) ((keyword . pattern) template) ...)
-       #'(lambda (x)
-           ;; embed patterns as procedure metadata
-           #((macro-type . syntax-rules)
-             (patterns pattern ...))
-           (syntax-case x (k ...)
-             ((dummy . pattern) #'template)
-             ...)))
+       (expand-syntax-rules #f #'(k ...) #'() #'(((keyword . pattern) template) ...)))
       ((_ (k ...) docstring ((keyword . pattern) template) ...)
        (string? (syntax->datum #'docstring))
-       #'(lambda (x)
-           ;; the same, but allow a docstring
-           docstring
-           #((macro-type . syntax-rules)
-             (patterns pattern ...))
-           (syntax-case x (k ...)
-             ((dummy . pattern) #'template)
-             ...))))))
+       (expand-syntax-rules #f #'(k ...) #'(docstring) #'(((keyword . pattern) template) ...)))
+      ((_ dots (k ...) ((keyword . pattern) template) ...)
+       (identifier? #'dots)
+       (expand-syntax-rules #'dots #'(k ...) #'() #'(((keyword . pattern) template) ...)))
+      ((_ dots (k ...) docstring ((keyword . pattern) template) ...)
+       (and (identifier? #'dots) (string? (syntax->datum #'docstring)))
+       (expand-syntax-rules #'dots #'(k ...) #'(docstring) #'(((keyword . pattern) template) ...))))))
 
 (define-syntax define-syntax-rule
   (lambda (x)
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 6fac0ba..142e2e5 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -1,7 +1,7 @@
 ;;;; syntax.test --- test suite for Guile's syntactic forms    -*- scheme -*-
 ;;;;
 ;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2009, 2010,
-;;;;   2011, 2012 Free Software Foundation, Inc.
+;;;;   2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,6 +19,7 @@
 
 (define-module (test-suite test-syntax)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 local-eval)
   #:use-module (test-suite lib))
 
 
@@ -1172,6 +1173,44 @@
 	(r 'outer))
       #t)))
 
+(with-test-prefix "syntax-rules"
+
+  (pass-if-equal "custom ellipsis within normal ellipsis"
+      '((((a x) (a y) (a …))
+         ((b x) (b y) (b …))
+         ((c x) (c y) (c …)))
+        (((a x) (b x) (c x))
+         ((a y) (b y) (c y))
+         ((a …) (b …) (c …))))
+    (let ()
+      (define-syntax foo
+        (syntax-rules ()
+          ((_ y ...)
+           (syntax-rules … ()
+             ((_ x …)
+              '((((x y) ...) …)
+                (((x y) …) ...)))))))
+      (define-syntax bar (foo x y …))
+      (bar a b c)))
+
+  (pass-if-equal "normal ellipsis within custom ellipsis"
+      '((((a x) (a y) (a z))
+         ((b x) (b y) (b z))
+         ((c x) (c y) (c z)))
+        (((a x) (b x) (c x))
+         ((a y) (b y) (c y))
+         ((a z) (b z) (c z))))
+    (let ()
+      (define-syntax foo
+        (syntax-rules … ()
+          ((_ y …)
+           (syntax-rules ()
+             ((_ x ...)
+              '((((x y) …) ...)
+                (((x y) ...) …)))))))
+      (define-syntax bar (foo x y z))
+      (bar a b c))))
+
 (with-test-prefix "syntax-case"
   
   (pass-if-syntax-error "duplicate pattern variable"
@@ -1225,6 +1264,71 @@
                  ((x ... y ... z ...) #f)))
             (interaction-environment)))))
 
+(with-test-prefix "with-ellipsis"
+
+  (pass-if-equal "simple"
+      '(a 1 2 3)
+    (let ()
+      (define-syntax define-quotation-macros
+        (lambda (x)
+          (syntax-case x ()
+            ((_ (macro-name head-symbol) ...)
+             #'(begin (define-syntax macro-name
+                        (lambda (x)
+                          (with-ellipsis …
+                            (syntax-case x ()
+                              ((_ x …)
+                               #'(quote (head-symbol x …)))))))
+                      ...)))))
+      (define-quotation-macros (quote-a a) (quote-b b))
+      (quote-a 1 2 3)))
+
+  (pass-if-equal "disables normal ellipsis"
+      '(a ...)
+    (let ()
+      (define-syntax foo
+        (lambda (x)
+          (with-ellipsis …
+            (syntax-case x ()
+              ((_)
+               #'(quote (a ...)))))))
+      (foo)))
+
+  (pass-if-equal "doesn't affect ellipsis for generated code"
+      '(a b c)
+    (let ()
+      (define-syntax quotation-macro
+        (lambda (x)
+          (with-ellipsis …
+            (syntax-case x ()
+              ((_)
+               #'(lambda (x)
+                   (syntax-case x ()
+                     ((_ x ...)
+                      #'(quote (x ...))))))))))
+      (define-syntax kwote (quotation-macro))
+      (kwote a b c)))
+
+  (pass-if-equal "doesn't propagate into syntax binders"
+      '(a b c)
+    (let ()
+      (with-ellipsis …
+        (define-syntax kwote
+          (lambda (x)
+            (syntax-case x ()
+              ((_ x ...)
+               #'(quote (x ...))))))
+        (kwote a b c))))
+
+  (pass-if-equal "works with local-eval"
+      5
+    (let ((env (with-ellipsis … (the-environment))))
+      (local-eval '(syntax-case #'(a b c d e) ()
+                     ((x …)
+                      (length #'(x …))))
+                  env))))
+
 ;;; Local Variables:
 ;;; eval: (put 'pass-if-syntax-error 'scheme-indent-function 1)
+;;; eval: (put 'with-ellipsis 'scheme-indent-function 1)
 ;;; End:
-- 
1.7.5.4


^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules
  2013-12-19  0:33 [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules Mark H Weaver
@ 2014-01-08 11:41 ` Ludovic Courtès
  2014-01-08 20:10   ` Mark H Weaver
  0 siblings, 1 reply; 8+ messages in thread
From: Ludovic Courtès @ 2014-01-08 11:41 UTC (permalink / raw)
  To: guile-devel

Hi, Mark,

Mark H Weaver <mhw@netris.org> skribis:

> In the end, here's how this works: 'with-ellipsis' binds a special
> identifier named #{ $sc-ellipsis }# using a new 'ellipsis' binding type.
> The new ellipsis identifier is stored within the binding.  In order to
> determine whether an identifier X is an ellipsis, the binding for
> #{ $sc-ellipsis }# is looked up in the lexical environment of X.  If the
> binding is found and has binding-type 'ellipsis', then X is compared to
> the identifier stored in the binding using 'bound-id=?'.  Otherwise, X
> is compared to '...' using 'free-id=?' as was done before.

This looks nice!  Thanks for providing the detailed reasoning, that’s
insightful.

Does something like this work:

  (define-syntax define-inline
    (with-ellipsis ---
      (syntax-rules ()
        ((_ (name parms ---) exp ---)
         (define-syntax name
            (syntax-rules ()
              ((_ args (--- ---))
               ((lambda (parms ---) exp ---)
                args (--- ---)))))))))

Looks good to me for 2.0.

Could you wrap lines to 80 columns in psyntax.scm?

> +@subsubsection Specifying a custom ellipsis identifier

Should be “Specifying a Custom Ellipsis Identifier”.

> +@subsubsection Custom ellipsis identifiers for syntax-case macros

Likewise.

> +      (define-syntax define-quotation-macros
> +        (lambda (x)
> +          (syntax-case x ()
> +            ((_ (macro-name head-symbol) ...)
> +             #'(begin (define-syntax macro-name
> +                        (lambda (x)
> +                          (with-ellipsis …
> +                            (syntax-case x ()
> +                              ((_ x …)
> +                               #'(quote (head-symbol x …)))))))
> +                      ...)))))

Pretty cool.  :-)

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules
  2014-01-08 11:41 ` Ludovic Courtès
@ 2014-01-08 20:10   ` Mark H Weaver
  2014-01-08 20:53     ` Ludovic Courtès
  0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2014-01-08 20:10 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

Hi Ludovic,

ludo@gnu.org (Ludovic Courtès) writes:

> Mark H Weaver <mhw@netris.org> skribis:
>
>> In the end, here's how this works: 'with-ellipsis' binds a special
>> identifier named #{ $sc-ellipsis }# using a new 'ellipsis' binding type.
>> The new ellipsis identifier is stored within the binding.  In order to
>> determine whether an identifier X is an ellipsis, the binding for
>> #{ $sc-ellipsis }# is looked up in the lexical environment of X.  If the
>> binding is found and has binding-type 'ellipsis', then X is compared to
>> the identifier stored in the binding using 'bound-id=?'.  Otherwise, X
>> is compared to '...' using 'free-id=?' as was done before.
>
> This looks nice!  Thanks for providing the detailed reasoning, that’s
> insightful.
>
> Does something like this work:
>
>   (define-syntax define-inline
>     (with-ellipsis ---
>       (syntax-rules ()
>         ((_ (name parms ---) exp ---)
>          (define-syntax name
>             (syntax-rules ()
>               ((_ args (--- ---))
>                ((lambda (parms ---) exp ---)
>                 args (--- ---)))))))))

No, because as noted in the docs, the custom ellipsis does not propagate
to the generated code.  Therefore, given the above definition,

  (define-inline (foo a b c) (list a b c))

expands to:

  (define-syntax foo
    (syntax-rules ()
      ((_ args ---)
       ((lambda (a b c) (list a b c))
        args ---))))

However, '---' is not the ellipsis identifier for this generated macro,
because the 'with-ellipsis' is not present in the generated code.
Therefore, '---' is treated as a normal pattern variable by the
generated macro.

It is important that the custom ellipsis does not propagate to the
generated code, so that we can use 'with-ellipsis' to implement R7RS
'syntax-rules', which allows a custom ellipsis as its first operand,
before the literals list.  In R7RS 'syntax-rules', the custom ellipsis
does not propagate to generated code.

A corrected version of your macro is the following:

  (define-syntax define-inline
    (with-ellipsis ---
      (syntax-rules ()
        ((_ (name parms ---) exp ---)
         (define-syntax name
           (syntax-rules ()
             ((_ args ...)
              ((lambda (parms ---) exp ---)
               args ...))))))))

Note that as currently implemented, the effect of 'with-ellipsis'
also does not propagate into nested syntax definition forms such as
'let-syntax', 'letrec-syntax', and 'define-syntax'.  We could go either
way on this.

I confess that I didn't make this decision intentionally.  It was an
accident of the current implementation.  The reason is that transformer
expressions are evaluated in a "macros only" environment, with all other
bindings removed (see 'macros-only-env' in psyntax.scm).  We could
arrange to keep the ellipsis binding in that restricted environment as
well, if desired.  I don't think it matters much.

What do you think?

> Could you wrap lines to 80 columns in psyntax.scm?

Ordinarily I try to keep lines to 80 columns, but psyntax.scm already
has a great deal of code that violates that rule.  Fixing that would be
a rather large commit, and I'm not sure it would be an improvement.

>> +@subsubsection Specifying a custom ellipsis identifier
>
> Should be “Specifying a Custom Ellipsis Identifier”.
>
>> +@subsubsection Custom ellipsis identifiers for syntax-case macros
>
> Likewise.

Okay.

   Thanks!
     Mark



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules
  2014-01-08 20:10   ` Mark H Weaver
@ 2014-01-08 20:53     ` Ludovic Courtès
  2014-01-09 23:07       ` Mark H Weaver
  0 siblings, 1 reply; 8+ messages in thread
From: Ludovic Courtès @ 2014-01-08 20:53 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Mark H Weaver <mhw@netris.org> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Mark H Weaver <mhw@netris.org> skribis:
>>
>>> In the end, here's how this works: 'with-ellipsis' binds a special
>>> identifier named #{ $sc-ellipsis }# using a new 'ellipsis' binding type.
>>> The new ellipsis identifier is stored within the binding.  In order to
>>> determine whether an identifier X is an ellipsis, the binding for
>>> #{ $sc-ellipsis }# is looked up in the lexical environment of X.  If the
>>> binding is found and has binding-type 'ellipsis', then X is compared to
>>> the identifier stored in the binding using 'bound-id=?'.  Otherwise, X
>>> is compared to '...' using 'free-id=?' as was done before.
>>
>> This looks nice!  Thanks for providing the detailed reasoning, that’s
>> insightful.
>>
>> Does something like this work:
>>
>>   (define-syntax define-inline
>>     (with-ellipsis ---
>>       (syntax-rules ()
>>         ((_ (name parms ---) exp ---)
>>          (define-syntax name
>>             (syntax-rules ()
>>               ((_ args (--- ---))
>>                ((lambda (parms ---) exp ---)
>>                 args (--- ---)))))))))
>
> No, because as noted in the docs, the custom ellipsis does not propagate
> to the generated code.

OK, right; it’d work with ‘with-ellipsis’ repeated after the inner
‘define-syntax’ I suppose.

Actually my question was more about the ellipsis escaping form
(... ...).  It is affected by ‘with-ellipsis’, right?  (It may be a
obvious question, but I’m not familiar with the implementation.)

[...]

> It is important that the custom ellipsis does not propagate to the
> generated code, so that we can use 'with-ellipsis' to implement R7RS
> 'syntax-rules', which allows a custom ellipsis as its first operand,
> before the literals list.  In R7RS 'syntax-rules', the custom ellipsis
> does not propagate to generated code.

Yes, that make sense.

> Note that as currently implemented, the effect of 'with-ellipsis'
> also does not propagate into nested syntax definition forms such as
> 'let-syntax', 'letrec-syntax', and 'define-syntax'.  We could go either
> way on this.

Well, I think it’s fine this way, but then again I’ve been living in
world without that feature.  ;-)

How does R7RS syntax-rules behave in that respect?  I guess we should
just follow suit.

>> Could you wrap lines to 80 columns in psyntax.scm?
>
> Ordinarily I try to keep lines to 80 columns, but psyntax.scm already
> has a great deal of code that violates that rule.  Fixing that would be
> a rather large commit, and I'm not sure it would be an improvement.

OK (I do find it hard to read long lines, FWIW.)

Thanks!

Ludo’.



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules
  2014-01-08 20:53     ` Ludovic Courtès
@ 2014-01-09 23:07       ` Mark H Weaver
  2014-01-10 13:02         ` Ludovic Courtès
  0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2014-01-09 23:07 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

ludo@gnu.org (Ludovic Courtès) writes:

> Mark H Weaver <mhw@netris.org> skribis:
>
>> ludo@gnu.org (Ludovic Courtès) writes:
>>
>>> Does something like this work:
>>>
>>>   (define-syntax define-inline
>>>     (with-ellipsis ---
>>>       (syntax-rules ()
>>>         ((_ (name parms ---) exp ---)
>>>          (define-syntax name
>>>             (syntax-rules ()
>>>               ((_ args (--- ---))
>>>                ((lambda (parms ---) exp ---)
>>>                 args (--- ---)))))))))
>>
>> No, because as noted in the docs, the custom ellipsis does not propagate
>> to the generated code.
>
> OK, right; it’d work with ‘with-ellipsis’ repeated after the inner
> ‘define-syntax’ I suppose.

Yes.

> Actually my question was more about the ellipsis escaping form
> (... ...).  It is affected by ‘with-ellipsis’, right?

Yes, so the following works:

  (define-syntax define-inline
    (with-ellipsis ---
      (syntax-rules ()
        ((_ (name parms ---) exp ---)
         (define-syntax name
           (with-ellipsis (--- ---)
             (syntax-rules ()
               ((_ args (--- ---))
                ((lambda (parms ---) exp ---)
                 args (--- ---))))))))))

Needless to say, the whole point of custom ellipses is to avoid having
to ever escape ellipses, but you can still do it.

>> Note that as currently implemented, the effect of 'with-ellipsis'
>> also does not propagate into nested syntax definition forms such as
>> 'let-syntax', 'letrec-syntax', and 'define-syntax'.  We could go either
>> way on this.
>
> Well, I think it’s fine this way, but then again I’ve been living in
> world without that feature.  ;-)
>
> How does R7RS syntax-rules behave in that respect?  I guess we should
> just follow suit.

In R7RS, custom ellipsis is not part of the lexical environment, and
thus does not propagate at all.  A custom ellipsis affects only the
patterns and templates of the 'syntax-rules' macro it is passed to.

I ended up making the effect of 'with-ellipsis' propagate into syntax
definition forms, since the semantics seem simpler to me.

I pushed this and the 'syntax-error' patch to stable-2.0.

     Thanks!
       Mark



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules
  2014-01-09 23:07       ` Mark H Weaver
@ 2014-01-10 13:02         ` Ludovic Courtès
  2014-01-10 17:08           ` Mark H Weaver
  0 siblings, 1 reply; 8+ messages in thread
From: Ludovic Courtès @ 2014-01-10 13:02 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Mark H Weaver <mhw@netris.org> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:

[...]

>> Actually my question was more about the ellipsis escaping form
>> (... ...).  It is affected by ‘with-ellipsis’, right?
>
> Yes, so the following works:
>
>   (define-syntax define-inline
>     (with-ellipsis ---
>       (syntax-rules ()
>         ((_ (name parms ---) exp ---)
>          (define-syntax name
>            (with-ellipsis (--- ---)
>              (syntax-rules ()
>                ((_ args (--- ---))
>                 ((lambda (parms ---) exp ---)
>                  args (--- ---))))))))))


Sorry I wasn’t clear.  Does this work:

  (define-syntax define-inline
    (with-ellipsis ---
      (syntax-rules ()
        ((_ (name parms ---) exp ---)
         (define-syntax name
           (with-ellipsis ---                  ; <- note here!
             (syntax-rules ()
               ((_ args (--- ---))
                ((lambda (parms ---) exp ---)
                 args (--- ---))))))))))

IOW, does the escaping syntax adjust to the current ellipsis?

> Needless to say, the whole point of custom ellipses is to avoid having
> to ever escape ellipses, but you can still do it.

Yes of course; that’s an academic question to satisfy my curiosity.

>>> Note that as currently implemented, the effect of 'with-ellipsis'
>>> also does not propagate into nested syntax definition forms such as
>>> 'let-syntax', 'letrec-syntax', and 'define-syntax'.  We could go either
>>> way on this.
>>
>> Well, I think it’s fine this way, but then again I’ve been living in
>> world without that feature.  ;-)
>>
>> How does R7RS syntax-rules behave in that respect?  I guess we should
>> just follow suit.
>
> In R7RS, custom ellipsis is not part of the lexical environment, and
> thus does not propagate at all.  A custom ellipsis affects only the
> patterns and templates of the 'syntax-rules' macro it is passed to.
>
> I ended up making the effect of 'with-ellipsis' propagate into syntax
> definition forms, since the semantics seem simpler to me.

OK.

So does that mean that in the example above the second ‘with-ellipsis’
can now be omitted, or is it limited to ‘let...-syntax’?

> I pushed this and the 'syntax-error' patch to stable-2.0.

Great, thank you!

Ludo’.



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules
  2014-01-10 13:02         ` Ludovic Courtès
@ 2014-01-10 17:08           ` Mark H Weaver
  2014-01-10 20:36             ` Ludovic Courtès
  0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2014-01-10 17:08 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

Hi Ludovic,

ludo@gnu.org (Ludovic Courtès) writes:

> Mark H Weaver <mhw@netris.org> skribis:
>
>> ludo@gnu.org (Ludovic Courtès) writes:
>
> [...]
>
>>> Actually my question was more about the ellipsis escaping form
>>> (... ...).  It is affected by ‘with-ellipsis’, right?
>>
>> Yes, so the following works:
>>
>>   (define-syntax define-inline
>>     (with-ellipsis ---
>>       (syntax-rules ()
>>         ((_ (name parms ---) exp ---)
>>          (define-syntax name
>>            (with-ellipsis (--- ---)
>>              (syntax-rules ()
>>                ((_ args (--- ---))
>>                 ((lambda (parms ---) exp ---)
>>                  args (--- ---))))))))))
>
>
> Sorry I wasn’t clear.  Does this work:
>
>   (define-syntax define-inline
>     (with-ellipsis ---
>       (syntax-rules ()
>         ((_ (name parms ---) exp ---)
>          (define-syntax name
>            (with-ellipsis ---                  ; <- note here!
>              (syntax-rules ()
>                ((_ args (--- ---))
>                 ((lambda (parms ---) exp ---)
>                  args (--- ---))))))))))
>
> IOW, does the escaping syntax adjust to the current ellipsis?

Yes, the escaping syntax does adjust to the current ellipsis, but no,
your example won't work.  It differs from the working code I gave in
just one respect: you passed "---" as the first operand to
'with-ellipsis', whereas I passed "(--- ---)".

Since you chose the same ellipsis identifier for both the inner and
outer macros, you need to escape the ellipsis passed to the inner
'with-ellipsis', just as you need to escape any ellipsis that you want
to remain present in the generated code.

Remember that macros are expanded from the outside in.  When
(define-inline (foo a b c) (list a b c)) is expanded, at that point the
entire inner 'define-syntax' form is just a template, and it has no
understanding of the inner syntax forms.  Therefore, it will interpret
your inner "with-ellipsis ---" as meaning that 'with-ellipsis' should be
a pattern variable.  You need to write "with-ellipsis (--- ---)"
instead, which will expand into "with-ellipsis ---" in the generated
code.

>> Needless to say, the whole point of custom ellipses is to avoid having
>> to ever escape ellipses, but you can still do it.
>
> Yes of course; that’s an academic question to satisfy my curiosity.

[...]

>> I ended up making the effect of 'with-ellipsis' propagate into syntax
>> definition forms, since the semantics seem simpler to me.
>
> OK.
>
> So does that mean that in the example above the second ‘with-ellipsis’
> can now be omitted, or is it limited to ‘let...-syntax’?

No, it's not limited to 'let...-syntax'.  The effect of 'with-ellipsis'
propagates into 'define-syntax' forms well.

However, you still need the second 'with-ellipsis' in your example,
because the effect of 'with-ellipsis' does not affect the ellipsis of
the generated code.  If you want one macro to generate another macro
definition that uses a custom ellipsis, you must include 'with-ellipsis'
in the generated code.

    Regards,
      Mark



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules
  2014-01-10 17:08           ` Mark H Weaver
@ 2014-01-10 20:36             ` Ludovic Courtès
  0 siblings, 0 replies; 8+ messages in thread
From: Ludovic Courtès @ 2014-01-10 20:36 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Mark H Weaver <mhw@netris.org> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Mark H Weaver <mhw@netris.org> skribis:
>>
>>> ludo@gnu.org (Ludovic Courtès) writes:

[...]

>> Sorry I wasn’t clear.  Does this work:
>>
>>   (define-syntax define-inline
>>     (with-ellipsis ---
>>       (syntax-rules ()
>>         ((_ (name parms ---) exp ---)
>>          (define-syntax name
>>            (with-ellipsis ---                  ; <- note here!
>>              (syntax-rules ()
>>                ((_ args (--- ---))
>>                 ((lambda (parms ---) exp ---)
>>                  args (--- ---))))))))))
>>
>> IOW, does the escaping syntax adjust to the current ellipsis?

[...]

> Since you chose the same ellipsis identifier for both the inner and
> outer macros, you need to escape the ellipsis passed to the inner
> 'with-ellipsis', just as you need to escape any ellipsis that you want
> to remain present in the generated code.

Arf, right, my bad.  That makes a lot of sense.

[...]

>>> I ended up making the effect of 'with-ellipsis' propagate into syntax
>>> definition forms, since the semantics seem simpler to me.
>>
>> OK.
>>
>> So does that mean that in the example above the second ‘with-ellipsis’
>> can now be omitted, or is it limited to ‘let...-syntax’?
>
> No, it's not limited to 'let...-syntax'.  The effect of 'with-ellipsis'
> propagates into 'define-syntax' forms well.

OK.

> However, you still need the second 'with-ellipsis' in your example,
> because the effect of 'with-ellipsis' does not affect the ellipsis of
> the generated code.  If you want one macro to generate another macro
> definition that uses a custom ellipsis, you must include 'with-ellipsis'
> in the generated code.

Yes, understood.

Thanks for explaining!

Ludo’.



^ permalink raw reply	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2014-01-10 20:36 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-12-19  0:33 [PATCH] psyntax: custom ellipses using 'with-ellipsis' or R7RS syntax-rules Mark H Weaver
2014-01-08 11:41 ` Ludovic Courtès
2014-01-08 20:10   ` Mark H Weaver
2014-01-08 20:53     ` Ludovic Courtès
2014-01-09 23:07       ` Mark H Weaver
2014-01-10 13:02         ` Ludovic Courtès
2014-01-10 17:08           ` Mark H Weaver
2014-01-10 20:36             ` Ludovic Courtès

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).