match pattern

Discussion of Common Lisp

match pattern

Postby mautorrejon » Tue Oct 30, 2012 8:14 pm

I am having problems with this function. What I have worked so far is that it checks for variable that are denoted by "?" For instance variable x is denoted by (? x). so what Im looking to do with it is given two list for instance:
 (match '(A (? X) (? Y)) '(A (E F) G))
(T ((X (E F)) (Y G)))
 (match '(A (? X) (? X)) '(A (E F) G))
(NIL ((X (E F))))
 (match '(A (? X) (? Y (numberp Y))) '(A (E F) 7))
(T ((X (E F)) (Y 7)))
 (match '(A (? X) (? Y (numberp Y))) '(A (E F) G))
(NIL ((X (E F))))
 (match '(A (? X) (? Y (numberp Y) (> Y 10))) '(A (E F) 15))
(T ((X (E F)) (Y 15)))
 (match '(A (? X) (? Y (numberp Y) (my-predicate Y 10))) '(A (E F) 7))
(NIL ((X (E F))))
So far my code works half the way..i think. could anyone help get this right. I feel like i go over and over and do no improvement.

Code: Select all
(defun match (p s &optional (binds () ))
   (let ( (temp nil) )
      (cond    ((atom p)    (cond    ((equal p s) (list t binds))
                           (t (list nil nil))))
            ((equal (first p) '?) (setf temp (test-binds (second p) s binds))    (cond    (temp (list t p))
                                                                     (t (list nil nil))
            ((atom s) (list nil nil))
            (t               (setf temp (match (first p) (first s) binds))
                           ; temp = (flag binds)
                           (cond       ((first temp) (match (rest p) (rest s) (second temp)))
                           ; (first p) and (first s) match
                                    (t (list nil nil))

Code: Select all
(defun test-binds (x v binds)
   ;; returns nil or the binds updated by the addition of the pair (x v)
   (let ( (y nil) )
      (setf y (assoc x binds))
         (y (cond ((equal (second y) v) binds)(t nil)))
         (t (setf binds (append binds (list (list x v)))))
Posts: 2
Joined: Wed Oct 10, 2012 7:28 pm

Re: match pattern

Postby Konfusius » Thu Nov 01, 2012 3:46 am

Code: Select all
(define-condition pattern-maching-failed (error) ())

(defun rxvarp (exp)
  (if (and (consp exp)
         (= 2 (length exp))
         (eq '? (car exp))
         (symbolp (cadr exp)))
   (cadr exp)))

(defun bind-rxvar (var exp bind)
  (let ((ent (assoc var bind)))
   (if ent
     (if (equalp (cdr ent) exp)
      (error 'pattern-maching-failed))
     (acons var exp bind))))

(defun match* (rx exp bind)
  (let ((var (rxvarp rx)))
   (cond (var
         (bind-rxvar var exp bind))
        ((and (consp rx) (consp exp))
         (if (= (length rx) (length exp))
           (reduce (lambda (bind-acc pair) (match* (car pair) (cdr pair) bind-acc))
                 (mapcar #'cons rx exp)
                 :initial-value bind)
           (error 'pattern-maching-failed)))
         (if (equalp rx exp)
           (error 'pattern-maching-failed))))))

(defun match (rx exp)
  (handler-case (match* rx exp nil)
   (pattern-maching-failed () :doesnt-match)))
Posts: 62
Joined: Fri Jun 10, 2011 6:38 am

Return to Common Lisp

Who is online

Users browsing this forum: No registered users and 7 guests