On Sun, Feb 22, 2009 at 6:01 PM, Matthew Flatt <[email protected]> wrote:
> At Sun, 22 Feb 2009 17:44:42 -0500, Sam TH wrote:
>> I'd like to write a sequence syntax that uses `match'-style pattern
>> matching.  Unfortunately, this doesn't seem to be currently possible,
>> but it's close.
>>
>> First, something like this is ruled straight out:
>>
>> (for/list ([(? (lambda (x) #t) x) (:match (list 1 2 3))]) x)
>>
>> since (lambda (x) #t) is not an identifier.  This is ruled out
>> *before* the `:match' expander is given control.
>>
>> Second, it's not possible to distinguish between the client writing this:
>>
>> (for/list ([x (:match e)]) ...)
>>
>> and this:
>>
>> (for/list ([(x) (:match e)]) ...)
>>
>> which, while they have the same semantics for `in-list', would have
>> very different semantics for `:match'.
>>
>> I think the easiest solution would be to (1) accept any pattern in the
>> binding position, and have individual sequence-syntax forms rule them
>> out (perhaps `define-sequence-syntax' could make this easy), and (2)
>> provide a lower-level form which is given the raw pattern, without any
>> transformation.
>>
>> I'll write up a patch, provided anyone is interested.
>
> It sounds worth trying, but I'm not sure it will work easily.
>
> The existing `for' forms were designed with the idea that the
> right-hand side of a binding is always an expression. If the expression
> has a certain shape, then you might get better performance, but the
> shape of the expression doesn't affect the binding.
>
> A benefit of that design is that you can derive new `for'-like forms
> that wrap some right-hand sides with sequence converters. For example,
> a derived form might wrap a right-hand side with `stop-before'. If I
> remember correctly, then some of the `for' forms (perhaps `for/or' or
> `for/and') are implemented that way.
>
> In other words, the constraint that the right-hand side is always an
> expression might be built deep enough into the design that it's
> difficult to change. But I'm not sure.

Attached is my initial effort.  'for.diff' is a diff for
'scheme/private/for.ss', implementing `define-raw-sequence-syntax'.
Then 'test.ss' uses that to implement `:match' and `:match*', which
match single- and multiple-value generators, respectively.  I've tried
out a bunch of examples (included in the file), and they all seem to
work as intended, including the ones using `for/and' and `for/or'.

Do you think this is a reasonable strategy?  Is there something I've overlooked?

Thanks,
-- 
sam th
[email protected]

Attachment: test.ss
Description: Binary data

Index: private/for.ss
===================================================================
--- private/for.ss	(revision 13784)
+++ private/for.ss	(working copy)
@@ -49,6 +49,7 @@
              prop:sequence
              
              define-sequence-syntax
+             define-raw-sequence-syntax
              make-do-sequence
              :do-in)
   
@@ -65,8 +66,15 @@
                         3 0 #f
                         null (current-inspector)
                         0))
+    (define-values (struct:raw-sequence-transformer
+                    make-raw-sequence-transformer
+                    raw-sequence-transformer?
+                    raw-sequence-transformer-ref
+                    raw-sequence-transformer-set!)
+      (make-struct-type 'raw-sequence-transformer struct:sequence-transformer
+                        0 0))
 
-    (define (create-sequence-transformer proc1 proc2 cert)
+    (define (create-sequence-transformer proc1 proc2 cert raw?)
       (unless (and (procedure? proc1)
                    (or (procedure-arity-includes? proc1 1)
                        (procedure-arity-includes? proc1 0)))
@@ -80,17 +88,20 @@
                           "procedure (arity 1)"
                           1
                           proc1 proc2))
-      (make-sequence-transformer (if (procedure-arity-includes? proc1 0)
-                                      (lambda (stx)
-                                        (if (identifier? stx)
-                                            (proc1)
-                                            (datum->syntax stx
-                                                           #`(#,(proc1) . #,(cdr (syntax-e stx)))
-                                                           stx
-                                                           stx)))
-                                      proc1)
-                                  proc2
-                                  cert))
+      ((if raw?
+           make-raw-sequence-transformer
+           make-sequence-transformer)
+       (if (procedure-arity-includes? proc1 0)
+           (lambda (stx)
+             (if (identifier? stx)
+                 (proc1)
+                 (datum->syntax stx
+                                #`(#,(proc1) . #,(cdr (syntax-e stx)))
+                                stx
+                                stx)))
+           proc1)
+       proc2
+       cert))
 
     (define cert-key (gensym 'for-cert))
     
@@ -141,6 +152,22 @@
     (define (expand-clause orig-stx clause)
       (let eloop ([use-transformer? #t])
         (syntax-case clause (values in-parallel stop-before stop-after :do-in)
+          [[(id ...) (form . rest)]
+           (and use-transformer?
+                (identifier? #'form)
+                (raw-sequence-transformer? (syntax-local-value #'form (lambda () #f))))
+           (let ([m (syntax-local-value #'form)])
+             (let ([xformer (sequence-transformer-ref m 1)]
+                   [introducer (make-syntax-introducer)]
+                   [certifier (sequence-transformer-ref m 2)])
+               (let ([xformed (xformer (introducer (syntax-local-introduce clause)))])
+                 (if xformed
+                     (expand-clause orig-stx (certify-clause (syntax-case clause ()
+                                                               [(_ rhs) #'rhs])
+                                                             (syntax-local-introduce (introducer xformed)) 
+                                                             certifier
+                                                             introducer))
+                     (eloop #f)))))]
           [[(id ...) rhs]
            (let ([ids (syntax->list #'(id ...))])
              (for-each (lambda (id)
@@ -308,7 +335,17 @@
        (define-syntax id (create-sequence-transformer
                           expr-transformer-expr
                           clause-transformer-expr
-                          (syntax-local-certifier #f)))]))
+                          (syntax-local-certifier #f)
+                          #f))]))
+  
+  (define-syntax define-raw-sequence-syntax
+    (syntax-rules ()
+      [(_ id expr-transformer-expr clause-transformer-expr)
+       (define-syntax id (create-sequence-transformer
+                          expr-transformer-expr
+                          clause-transformer-expr
+                          (syntax-local-certifier #f)
+                          #t))]))
 
   (define (sequence? v)
     (or (do-sequence? v)
_________________________________________________
  For list-related administrative tasks:
  http://list.cs.brown.edu/mailman/listinfo/plt-dev

Reply via email to