previous up next     contents index
Next: Index Up: Pattern Matching for Scheme Previous: Code Generation

Examples

This section illustrates the convenience of pattern matching with some examples. The following function recognizes some s-expressions that represent the standard Y operator:

(define Y?
  (match-lambda
    [('lambda (f1)
       ('lambda (y1)
         ((('lambda (x1) (f2 ('lambda (z1) ((x2 x3) z2))))
           ('lambda (a1) (f3 ('lambda (b1) ((a2 a3) b2)))))
          y2)))
     (and (symbol? f1) (symbol? y1) (symbol? x1) (symbol? z1) (symbol? a1) (symbol? b1)
          (eq? f1 f2) (eq? f1 f3) (eq? y1 y2)
          (eq? x1 x2) (eq? x1 x3) (eq? z1 z2)
          (eq? a1 a2) (eq? a1 a3) (eq? b1 b2))]
    [_ #f]))
Writing an equivalent piece of code in raw Scheme is tedious.

The following code defines abstract syntax for a subset of Scheme, a parser into this abstract syntax, and an unparser.

(define-structure (Lam args body))
(define-structure (Var s))
(define-structure (Const n))
(define-structure (App fun args))

(define parse
  (match-lambda
    [(and s (? symbol?) (not 'lambda))
     (make-Var s)]
    [(? number? n)
     (make-Const n)]
    [('lambda (and args ((? symbol?) ...) (not (? repeats?))) body)
     (make-Lam args (parse body))]
    [(f args ...)
     (make-App
       (parse f)
       (map parse args))]
    [x (error 'syntax "invalid expression")]))

(define repeats?
  (lambda (l)
    (and (not (null? l))
         (or (memq (car l) (cdr l)) (repeats? (cdr l))))))

(define unparse
  (match-lambda
    [($\$$ Var s) s]
    [($\$$ Const n) n]
    [($\$$ Lam args body) `(lambda ,args ,(unparse body))]
    [($\$$ App f args) `(,(unparse f) ,@(map unparse args))]))
With pattern matching, it is easy to ensure that the parser rejects all incorrectly formed inputs with an error message.

With match-define, it is easy to define several procedures that share a hidden variable. The following code defines three procedures, inc, value, and reset, that manipulate a hidden counter variable:

(match-define (inc value reset)
  (let ([val 0])
    (list
      (lambda () (set! val (add1 val)))
      (lambda () val)
      (lambda () (set! val 0)))))
Although this example is not recursive, the bodies could recursively refer to each other.

The following code is taken from the macro package itself. The procedure validate-match-pattern checks the syntax of match patterns, and converts quasipatterns into ordinary patterns.

(define validate-match-pattern
  (lambda (p)
    (letrec
      ([name?
         (lambda (x)
           (and (symbol? x)
                (not (dot-dot-k? x))
                (not (memq x '(quasiquote quote unquote unquote-splicing
                                ? _ $\$$ and or not set! get! ...)))))]
       [simple?
         (lambda (x)
           (or (string? x) (boolean? x) (char? x) (number? x) (null? x)))]
       [ordinary
         (match-lambda
           [(? simple? p) p]
           [(? name? p) p]
           ['_ '_]
           [('quasiquote p) (quasi p)]
           [(and p ('quote _)) p]
           [('? pred ps ...) `(and (? ,pred) ,@(map ordinary ps))]
           [('and ps ...) `(and ,@(map ordinary ps))]
           [('or ps ...) `(or ,@(map ordinary ps))]
           [('not ps ...) `(not (or ,@(map ordinary ps)))]
           [('$\$$ (? name? r) ps ...) `($\$$ ,r ,@(map ordinary ps))]
           [(and p ('set! (? name?))) p]
           [(and p ('get! (? name?))) p]
           [(p '...) `(,(ordinary p) ..0)]
           [(p (? dot-dot-k? ddk)) `(,(ordinary p) ,ddk)]
           [(x . y) (cons (ordinary x) (ordinary y))]
           [(? vector? p) (apply vector (map ordinary (vector->list p)))]
           [#&p (box (ordinary p))]
           [p (err "invalid pattern at ~a" p)])]
       [quasi
         (match-lambda
           [(? simple? p) p]
           [(? symbol? p) `(quote ,p)]
           [('unquote p) (ordinary p)]
           [(('unquote-splicing p) . ()) (ordinary p)]
           [(('unquote-splicing p) . y) (append (ordlist p) (quasi y))]
           [(p '...) `(,(quasi p) ..0)]
           [(p (? dot-dot-k? ddk)) `(,(quasi p) ,ddk)]
           [(x . y) (cons (quasi x) (quasi y))]
           [(? vector? p) (apply vector (map quasi (vector->list p)))]
           [#&p (box (quasi p))]
           [p (err "invalid quasipattern at ~a" p)])]
       [ordlist
         (match-lambda
           [() ()]
           [(x . y) (cons (ordinary x) (ordlist y))]
           [p (err "invalid unquote-splicing at ~a" p)])])
      (ordinary p))))



PLT