simple pattern matcher

[Keisuke Nishida]

I've written a simple pattern matcher for Guile.
May I add this to ice-9 after some more improvement?

  (define (trans x)
    (match x
      (('+) 0)
      (('+ e1) e1)
      (('+ e1 e2) `(add ,e1 ,e2))
      (else `oops)))

  (trans '(+))        => 0
  (trans '(+ 1))      => 1
  (trans '(+ 1 2))    => (add 1 2)
  (trans '(+ 1 2 3))  => oops

Kei

------------------------------------------------------------------------
(define-module (ice-9 match)
  :export (match))

(define (make-ref n)
  (case n
    ((0) `(car obj))
    ((1) `(cadr obj))
    ((2) `(caddr obj))
    ((3) `(cadddr obj))
    (else `(list-ref obj n))))

(define (build-clause clause)
  (let ((pattern (car clause)) (body (cdr clause)))
    (if (eq? pattern 'else) `(else ,@body)
        (let loop ((list pattern)
                   (n 0)
                   (formals '())
                   (consts '())
                   (args '()))
          (cond ((null? list)
                 `((and (eq? len ,(length pattern))
                        ,@(map (lambda (n)
                                 `(eq? ,(make-ref n) ,(list-ref pattern n)))
                               (reverse! consts)))
                   ((lambda ,(reverse! formals) ,@body)
                    ,@(map make-ref (reverse! args)))))
                ((symbol? (car list))
                 (loop (cdr list) (1+ n) (cons (car list) formals)
                       consts (cons n args)))
                (else
                 (loop (cdr list) (1+ n) formals (cons n consts) args)))))))

(define (build-match data . clauses)
  `(let* ((obj ,data) (len (length obj)))
     (cond ,@(map build-clause clauses))))

(define match
  (procedure->memoizing-macro
   (lambda (x e) (apply build-match (cdr x)))))