Slightly trickier

In my previous post, I gave a small pattern matching problem. It is easily solved by recursively descending the pattern and the object to match. This is analogous to interpreting the pattern because you walk the pattern each time you want to try to match an object.

If the pattern is constant, though, you can walk the pattern once and generate code that can match against an object much more quickly:

(define my-matcher
  (eval (make-matcher '(a (? var1) (nested (c (? var2)))))
        user-initial-environment))

(my-matcher '(a b (nested (c d)))) => ((var1 . b) (var2 . d))

I'd rate this as an intermediate puzzle. It isn't very different from the previous one, but you have to pay more attention to the phase of evaluation. As a hint, here are a pair of possible matchers:

(make-matcher '((? car) . (? cdr))) =>

(lambda (object)
  (and (pair? object)
       (let ((p1 ((lambda (object) (list (cons 'car object))) (car object)))
             (p2 ((lambda (object) (list (cons 'cdr object))) (cdr object))))
         (and p1
              p2
              (append p1 p2)))))

(make-matcher '((? one) and (? two))) =>

(lambda (object)
  (and (pair? object)
       (let ((left-submatch
              ((lambda (object) (list (cons 'one object))) (car object)))
             (right-submatch
              ((lambda (object)
                 (and (pair? object)
                      (let ((left-submatch
                             ((lambda (object)
                                (and (eqv? object 'and)
                                     '()))
                              (car object)))
                            (right-submatch
                             ((lambda (object)
                                (and (pair? object)
                                     (let ((left-submatch
                                            ((lambda (object)
                                               (list (cons 'two object)))
                                             (car object)))
                                           (right-submatch
                                            ((lambda (object)
                                               (and (eqv? object '())
                                                    '()))
                                             (cdr object))))
                                       (and left-submatch
                                            right-submatch
                                            (append left-submatch
                                                    right-submatch)))))
                              (cdr object))))
                        (and left-submatch
                             right-submatch
                             (append left-submatch right-submatch)))))
               (cdr object))))
         (and left-submatch
              right-submatch
              (append left-submatch right-submatch)))))

Astute readers will notice that this latter matcher is doing more work than necessary. If the match against part of the pattern fails, it still attempts to match the rest of the pattern. It only notices just before assembling the final result. Also, using append to assemble the sub-matches is a terrible waste.