[plt-scheme] Pattern matching and srfi-42

Hi all,

I am writing a "small" tutorial on srfi-42 loops. If you
have any nice examples, please send me a note.

As an appetizer here is the implementation of two new
generators :match and :plt-match which bind loop variables
using the normal match.ss or plt-match.ss syntax.

Example:

(define-struct entry (name score ))

(define entries
   (list
     (make-entry '("Jens Axel" "Søgaard")  3)
     (make-entry '("Noel"      "Welsh")    7)
     (make-entry '("Anton" "van Straaten") 'disqualified)))

`(ul ,@(list-ec (: e entries)
                 (:match ($ entry (f l) s) e)
                 (not (eq? s 'disqualified))
                 `(li ,f ,s)))

now evaluates to:

(ul (li "Jens Axel" 3) (li "Noel" 7))


I had to tap into the private parts of the pattern matcher.
It would be really nice to have a variables-bound-by-pattern
and a match-set! added to the library. [I couldn't
use match-define, since its expansion were to be inserted
in an expression context - therefore the binding of the
variables and the actual setting were separated].

One more thing: Is it possible to customize the behaviour
of compiled match, when the match fails? Below I wrapped
the matching in a (with-handlers ...), but this penalizes
all cases, not just the non-matching ones.

(require-for-syntax (lib "gen-match.ss" "mzlib" "private")
                     (lib "match-helper.ss" "mzlib" "private")
                     (lib "match-error.ss""mzlib" "private")
                     (lib "convert-pat.ss""mzlib" "private"))

(require (lib "etc.ss")
          (lib "list.ss")
          (lib "match-expander.ss" "mzlib" "private")
          (lib "match-error.ss" "mzlib" "private"))

(define-syntax (:plt-match stx)
   (syntax-case stx ()
     [(:plt-match cc pat expr)
      (identifier? #'pat)
      #'(:let cc pat expr)]
     [(:plt-match cc pat expr)
      (let* ((**match-bound-vars** '())
             (compiled-match
              (gen-match #'the-expr
                         '()
                         #'((pat never-used))
                         stx
                         (lambda (sf bv)
                           (set! **match-bound-vars** bv)
                           #`(begin
                               #,@(map (lambda (x)
                                         #`(set! #,(car x) #,(cdr x)))
                                       (reverse bv)))))))
        #`(:do cc
               (let ((the-expr expr)
                     (match-found? #t)
                     #,@(map (lambda (x) #`(#,(car x) #f))
                             (reverse **match-bound-vars**)))
                 (with-handlers
                   ([exn:fail? (lambda (exn) (set! match-found? #f))])
                   #,compiled-match))
               () match-found? (let ()) #f ()))]))

(list-ec (: x '(((1 2) 3) ((4 5) 6)))
          (:plt-match (list (list a b) c)  x)
          (list a b c))

(define-syntax (:match stx)
   (syntax-case stx ()
     [(:match cc pat expr)
      (identifier? #'pat)
      #'(:let cc path expr)]
     [(:match cc pat expr)
      (with-syntax ([new-pat (convert-pat #'pat)])
        #'(:plt-match cc new-pat expr))]))

Remember! Please send srfi-42 examples.

-- 
Jens Axel Søgaard