Re: new match system bug?

[Stefan Israelsson Tampe <stefan.tampe@spray.se>]

[-- Attachment #1: Type: Text/Plain, Size: 770 bytes --]

On Saturday, September 04, 2010 02:44:49 pm Ludovic Courtès wrote:
> Hello!
> 
> Stefan Israelsson Tampe <stefan.tampe@spray.se> writes:
> > While eating the dogfood of the new match macro I come across a bug
> > e.g, this does not work!
> > 
> > (match '(a b) ((and x (a ... b)) a))
> 
> But:
> 
>   scheme@(guile-user)> (match '(a b) ((and x (a . b)) a))
>   $1 = a
> 
> According to the grammar in the manual, I don’t think literal ‘...’ can
> be used in the middle of a list; it should only be used at the end of a
> list, where it means “zero or more”:
> 
>   scheme@(guile-user)> (match '(a b) ((a ...) a))
>   $2 = (a b)
> 
> Thanks,
> Ludo’.

I Included a trailing pattern error message to match.scm in this patch.
/Stefan

[-- Attachment #2: match-trailing.patch --]
[-- Type: text/x-patch, Size: 1808 bytes --]

diff --git a/module/ice-9/match.scm b/module/ice-9/match.scm
index 1a2a61e..3a709a1 100644
--- a/module/ice-9/match.scm
+++ b/module/ice-9/match.scm
@@ -115,6 +115,36 @@
       ((_ newpat  m ()            v kt ke i)
        (syntax (match-one v newpat () kt ke i))))))
 
+;;error messag added
+(define-syntax match-gen-ellipses
+  (syntax-rules ()
+    ((_ v p () g+s (sk ...) fk i ((id id-ls) ...))
+     (match-check-identifier p
+       ;; simplest case equivalent to (p ...), just bind the list
+       (let ((p v))
+         (if (list? p)
+             (sk ... i)
+             fk))
+       ;; simple case, match all elements of the list
+       (let loop ((ls v) (id-ls '()) ...)
+         (cond
+           ((null? ls)
+            (let ((id (reverse id-ls)) ...) (sk ... i)))
+           ((pair? ls)
+            (let ((w (car ls)))
+              (match-one w p ((car ls) (set-car! ls))
+                         (match-drop-ids (loop (cdr ls) (cons id id-ls) ...))
+                         fk i)))
+           (else
+            fk)))))
+    ((_ v p r g+s (sk ...) fk i ((id id-ls) ...))
+     ;; general case, trailing patterns to match, keep track of the
+     ;; remaining list length so we don't need any backtracking
+     (match-verify-no-ellipses
+      r
+      (match-syntax-error
+       "trailing pattern to ... , eg. (x ... y) is not supported")))))
+
 ;;We must be able to extract vars in the new constructs!!
 (define-syntax match-extract-vars
   (syntax-rules (_ ___ *** ? $ = quote quasiquote and or not get! set!)
@@ -241,5 +271,5 @@
 		    #'(begin exp ...))))))
 
 (include-from-path/filtered
- (match-extract-vars match-two match)
- "ice-9/match.upstream.scm")
\ No newline at end of file
+ (match-gen-ellipses match-extract-vars match-two match)
+ "ice-9/match.upstream.scm")