Practice Matching Problem - Answers

(defun match (p s)           TRACE THE FOLLOWING CALL TO MATCH:                       
  (cond 	 -->(match '(is (* x) work (? y) the way)  '(is this going to work by the way))
    ((handle-both-null p s))         Label the values of P and S on each recursive call.
    ((handle-normal-recursion p s))	Count the total number of calls to match.
    ((atom (first p)) nil)           ;;(match  (rest p)(rest s)) new P = ((* x) work (? y) the way)  
                                                            new S = (this going to work by the way)
    ((handle-? p s))                     (match  p (rest s)) new P = ((* x) work (? y) the way)  
                                                        new S = (going to work by the way)
    ((handle-* p s))                    (match  p (rest s)) new P = ((* x) work (? y) the way) 
                                                            new S = (to work by the way)
    (t nil) ) )      (match  (rest p) (rest s)) new P = (work (? y) the way) new S = (work by the way)
                          (match  (rest p) (rest s)) new P = ((? y) the way) new S = (by the way)
(defun 1st-pattern-op (p)          (match  (rest p) (rest s)) new P = (the way) new S = (the way)   
 "Return the *, ? in the first pattern construct of P." (match  (rest p) (rest s)) new P = (way) new S = (way)  
  (first (first p)) ) ; same as (CAAR P)       (match  (rest p) (rest s)) new P = () new S = ()
                                                      return: ((:YES . YES))
(defun 1st-pattern-variable (p)                        return: ((:YES . YES))              
"Return the variable in the first pattern construct of P."    return: ((:YES . YES))
  (first (rest (first p))) ) ; same as (CADAR P)             return: ((Y . BY) (:YES . YES))
                                                             return ((Y . BY) (:YES . YES))
(defun handle-both-null (p s)                                return ((X  TO) (Y . BY) (:YES . YES))
"Test for and handle case when both P and S are null." return ((X  GOING TO) (Y . BY) (:YES . YES))
  (if (and (null p)(null s))                        return: ((X  THIS GOING TO) (Y . BY) (:YES . YES)) 
      '((:yes . :yes)) ) )                          return: ((X  THIS GOING TO) (Y . BY) (:YES . YES))
                                                                                         
(defun handle-normal-recursion (p s) 
"Test for and handle case when the first elements of P and S are EQL."
  (if (atom (first p))
      (if (eql (first p)(first s))
          (match (rest p)(rest s)) ) ) )

(defun handle-? (p s)  
;;Test for and handle the case when (FIRST P) is of  the form (? X)."
  (if s ; S must not be null
      (if (eql (1st-pattern-op p) '?)
          (let ((rest-match (match (rest p)(rest s)) ))
            (if rest-match
                (acons  (1st-pattern-variable p)  (first s)  rest-match) ) ) ) ) )

(defun handle-* (p s)  ;;Test for and handle the case when (FIRST P) is of the form (* X)."
  (if (eql (1st-pattern-op p) '*)
      (let ((pattern-variable
              (1st-pattern-variable p) )
            (rest-match nil) )
        (cond ; subcase 1 --match 1 element of S:
              ((and s
                    (setf rest-match (match (rest p)  (rest s) ) ) )
               (acons pattern-variable  (list (first s))  rest-match) )

              ; subcase 2 --match no elements of S:
              ((setf rest-match (match (rest p) s))
               (acons pattern-variable nil rest-match) )

              ; subcase 3 --match more than 1 elt of S:
              ((and s
                    (setf rest-match (match p (rest s)) ) )
               (acons pattern-variable (cons (first s) (val pattern-variable rest-match) )
                                                   (rest rest-match)) )
              (t nil) ) ) ) )