paternmatch.clj

gistfile1.cl

(ns paternmatch)


(defn var-p [s]
   "var-p is true if argument is a variable"
   (or (= s 'xs) (= s 'zs)
       (= s 'ys)))

(defn null [x]
  (= x nil))


(defn var-only-p [s]
  (and (empty? (rest s))
       (var-p (first s))))
       



(defn match2 [state pattern]
 (cond 
   (and (null state) (null pattern))    '(true true)
   (var-only-p pattern)                 (list (first pattern) state)
   (= (first state) (first pattern))    (match2 (rest state) (rest pattern))
   (not (= (first state) (first pattern))) nil))
   

(defn match [state pattern]
  (cond 
   (and (empty? state) (empty? pattern)) 
      '(true true)
    (var-only-p pattern) 
      ( list (first pattern) state)
    (= (first state) (first pattern))
      (match (rest state) (rest pattern))
    (var-p (first pattern))
      (match2 (rest state) (rest pattern))
    (not (= (first state)(first pattern))) nil))

(defn lookup [target bindlist] 
  (cond 
    (empty? bindlist) nil
    (= (first (first bindlist)) (first target)) (second (first bindlist)) 
    :else (lookup target ( rest bindlist))))

(defn append [& parts] (apply concat parts))

 
  
(defn mreplace [targetexp bindlist]
  (cond
    (empty? targetexp) nil
    (var-p (first targetexp)) 
            (append  (lookup (first targetexp) bindlist)
                     (mreplace (rest targetexp) bindlist))
    :else (append (list (first targetexp))  (mreplace (rest targetexp) bindlist))))

    

(defn match-and-sub [state pattern target]
  (cond 
    (match state pattern) (mreplace target (match state pattern))
    true nil))  


(comment
(print "match: \n")
(match '(1 2 3) '(xs))

(print "replace: \n")
(mreplace '(xs 4 5 6) (match '(1 2 3) '(xs)))
)