(in-package :cs325-user)

(define-test match-p
  (assert-true (match-p '(?x b ?y) '(a b c)))
  (assert-false (match-p '(?x b ?y) '(a d c)))
  (assert-false (match-p '(?x b ?y) '(a b)))
  (assert-true (match-p '?x 'a))
  (assert-true (match-p '?x '(a b c)))
  (assert-true (match-p '?x nil))
  (assert-false (match-p '(?x) nil))
  (assert-true (match-p '(a b c) '(a b c)))
  (assert-false (match-p '(?x b ?x) '(a b c)))
  (assert-true (match-p '(?x b ?x) '(a b a)))
  )

(define-test match-*
  ;;; from quiz
  (assert-true (match-p '(?*) '(a b c)))
  (assert-true (match-p '(?*) nil))
  (assert-true (match-p '(a ?*) '(a b c)))
  (assert-false (match-p '(?* a) '(a b c)))
  (assert-true (match-p '(?* ?x ?*) '(a b c)))
  (assert-true (match-p '((?* ?x ?*) ?x) '((a b c) c)))

  ;;; and more
  (assert-true (match-p '(?* c) '(a b c)))
  (assert-true (match-p '(?* a ?*) '(a b c)))
  (assert-true (match-p '(?* b ?*) '(a b c)))
  (assert-true (match-p '(?* c ?*) '(a b c)))
  (assert-true (match-p '((?* ?x ?*) ?x) '((a b c) a)))
  (assert-true (match-p '((?* ?x ?*) ?x) '((a b c) b)))
  (assert-false (match-p '((?* ?x ?*) ?x) '((a b c) d)))
  )

(defun match-p (x y &optional (blists '(nil)))
  (cond ((null blists) nil)
        ((eql x y) blists)
        ((var-p x) (var-match x y blists))
        ((atom x) nil)
        ((eql (car x) '?*) (match-* x y blists))
        (t
         (and (consp y)
              (match-p (cdr x) (cdr y)
                       (match-p (car x) (car y) blists))))))

(defun match-* (x y blists)
  (match-*-rest (cdr x) y blists))

(defun match-*-rest (x y blists)
  (and blists
       (append (match-p x y blists)
               (and (consp y)
                    (match-*-rest x (cdr y) blists)))))

(defun var-match (x y blists)
  (mapcan (lambda (blist) (bind-var x y blist))
          blists))

(defun bind-var (x y blist)
  (let ((binding (assoc x blist)))
    (cond ((null binding)
           (list (cons (list x y) blist)))
          ((eql y (cadr binding)) (list blist))
          (t nil))))

(defun var-p (x)
  (and (symbolp x)
       (eql (char (symbol-name x) 0) #\?)))