home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / RiscOS / APP / DEVS / LISP / CLISP.ZIP / CLisp / lsp / wildcard < prev   
Lisp/Scheme  |  1992-10-02  |  1KB  |  41 lines
  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<))
  41.