xlisponly/lsp/wildcard.lsp

   1 ; Wildcard Pattern matching algorithm
   2 ; * matches any substring (zero or more characters)
   3 ; ? matches any character
   4 ; ~c matches c
   5
   6 (defun match (pattern list)
   7        (labels ((match1 (pattern suspect)
   8                       (cond ((null pattern) (null suspect))
   9                             ((null suspect) (equal pattern '(:mult)))
  10                             ((eq (first pattern) :single)
  11                              (match1 (cdr pattern) (cdr suspect)))
  12                             ((eq (first pattern) :mult)
  13                              (if (null (rest pattern))
  14                                  t
  15                                  (do ((p (rest pattern))
  16                                       (l suspect (cdr l)))
  17                                      ((or (null l) (match1 p l))
  18                                       (not (null l))))))
  19                             ((eq (first pattern) (first suspect))
  20                              (match1 (rest pattern) (rest suspect)))
  21                             (t nil)))
  22               (explode (list)
  23                        (cond ((null list) nil)
  24                              ((eq (first list) #\*)
  25                               (cons :mult (explode (rest list))))
  26                              ((eq (first list) #\?)
  27                               (cons :single (explode (rest list))))
  28                              ((eq (first list) #\~)
  29                               (cons (second list)
  30                                     (explode (rest (rest list)))))
  31                              (t (cons (first list) (explode (rest list)))))))
  32              (let ((pat (explode (coerce pattern 'cons))))
  33                   (mapcan #'(lambda (x) (when (match1 pat (coerce x 'cons))
  34                                               (list x)))
  35                           list))))
  36
  37 (setq l (sort (apply #'nconc (map 'cons
  38                             #'(lambda (x) (mapcar #'string x))
  39                             *obarray*))
  40               #'string<))