List matching in LISP

Working AutoLISP examples are in match.lsp (simple) and whmatch.lsp (extended) The following is stolen from somewhere (I forgot, sorry)

The following is based on some notes that I found between some old papers describing two functions for doing list matching in LISP. The sheet one which the notes are is dated: May 20, 1980. The idea is the extension of regular expression for string matching to lists.

The description said (with some slight modifications added):

(def (matcht (rule wks) (cond
     ((null rule) nil) ((null wks) nil)
     ((atom rule) (cond
          ((eq rule (quote *)) wks)
          ((eq rule (quote *x)) wks)
          ((eq rule (quote *a)) (cond ((atom wks) wks) (t nil)))
          ((eq rule (quote *l)) (cond ((atom wks) nil) (t wks)))
          ((atom wks) (cond ((eq rule wks) wks) (t nil)))
          (t nil)))
     ((equal (car rule) (quote *q)) (cond
         ((equal (cadr rule) wks) wks)
         (t nil)))
     ((equal (car rule) (quote *>) (set (cadr rule) (matcht (cadr rule) wks)))
     ((equal (car rule) (quote *<)) (match (eval (cadr rule)) wks))
     ((equal (car rule) (quote *ll)) (cond
         ((null (cdr rule)) (cond ((atom wks) nil) (t wks)))
         ((numberp (cadr rule)) (cond
              ((atom wks) nil)
              ((eqn (cadr rule) (length wks)) wks)
              (t nil)) ))
         ((atom wks) nil)
         (t wks)))
     ((equal (car rule) (quote *am)) (cond
         ((atom wks) (cond
              ((memq wks (cd rule)) wks)
              (t nil) ))
         (t nil)))
     ((equal (car rule) (quote **)
      (eval (append (cdr rule) (list (quote quote) wks))))
     ((atom wks) nil)
     (t (matchd (rule wks nil nil))) )))

(def (matchd (rule wks a b) (cond
     ((null rule) (cond
           ((null wks) (reverse a))
           (t nil) ))
     ((null wks) (cond
           ((and (equal (car rule) (quote $)) (null (cdr rule)))
            (reverse (cons (quote nil) a)))
           (t nil) ))
     ((eq (car rule) (quote $)) (cond
           ((null (cdr rule) (reverse (cons wks a)))
           ((equal (quote $) (cadr rule))
            (matchd (cdr rule) (cdr wks) (cons (cons (car wks) nil) a) nil))
           ((null (setq matchd (matchd (cdr rule) wks (cons (reverse b) a)
            (matchd rule (cdr wks) a (cons (car wks) b)))
           (t matchd) ))
     ((equal (car rule) (quote *or)) (cond
           ((null (cdr rule)) nil)
           ((null (setq matchd (append (caadr rule) (cddr rule)) wks a nil)))
                 ((null (cdadr rule)) nil)
                 (t (matchd (cons (cons (quote *or) (cdadr rule)) (cddr rule)))
                            wks a nil)) ))
           (t matchd) ))
     ((null (setq matchd (matcht (car rule) (car wks))) nil)
     (t (matchd (cdr rule) (cdr wks) (cons matchd a) nil)) )))
This is in the UT LISP 4.1 dialect. (I have to say, that I cannot recall whether I actually tested the above functions, but when I typed the above functions out, I had some vague rememberence of correcting the mistakes that I found before.) Note that matcht and matchd are also used as local variables. It would have been nicer to use an extra function here, such that, for example:
     ((null (setq matchd (matcht (car rule) (car wks))) nil)
     (t (matchd (cdr rule) (cdr wks) (cons matchd a) nil)) )))
is rewritten into:
     (t (matchd2 (matcht (car rule) (car wks)) rule wks a)) )))

(def matchd2 (r rule wks a) (cond
     ((null r) nil)
     (t (matchd (cdr rule) (cdr wks) (cons r a) nil)) )))
For those that do not have a LISP evaluator in their head, here a small explaination of what the function matcht does. It is given two arguments: a rule and some S-expression, and will return either nil, or a list in the form of the rule, containing the first possible matching of the S-expression according to the rule. The rule can contain the following elements: