;; This general search procedure takes a list of the initial nodes,
;; the goal predicate, the operators (successors) function, the insert 
;; function, and the maximum depth of the search three (max-level)

(defun srch (start-nodes goal operators insert max-level)
  (let ((NODES nil) (num-visited 0) (children nil) (ANCESTORS nil))
    ;; add the level, predecessor, and expanded flag to each node in nodes
    (setf NODES (mapcar #'(lambda(x) (list x 0 nil nil)) start-nodes))
    (loop
     ;; if there are no more nodes to visit or visited max. # of nodes, 
     ;; return NIL as failure signal and the number of visited nodes.
     (if (or (null NODES) (>= num-visited *visited_max*))
	(return (list nil nil num-visited)))

     ;; if goal has been reached, return T as success signal, 
     ;; the solution path, and the number of visited nodes.
     (if (funcall goal (first (first NODES)))
	 (return (list t (return-path (first NODES) NODES)
		       (+ 1 num-visited))))

     (incf num-visited)
     (if (= (rem num-visited 10000) 0) (format t "~% ~A" num-visited))
     ;; if at maximum depth throw away node, otherwise put its children 
     ;; on the list & iterate 
     (cond
      ;; if max-level reached remove the node and all its dangling parents
      ((= (second (first NODES)) max-level)
       ;; remove the node
       (setf NODES (rest NODES)) 
       ;; now remove its expanded parents
       (while (and (not (NULL NODES)) (fourth (first NODES)))
	 (setf NODES (rest NODES))
	 (pop ANCESTORS)))
      ;; now expand the node and set expanded flag 
      (t (setf (fourth (first NODES)) T)
	 (push (first (first NODES)) ANCESTORS)
	 (setf children (funcall operators (first NODES)))
;; (format t "~% NODE: ~A" (first NODES))
	 (setf children 
	       (remove-if #'(lambda (x) 
			      (member (first x) ANCESTORS :test #'equal))
			  children))
;; (format t "~% AFTER: ~A" children)
	 (if (null children) 
	     ;; remove the node and its expanded parents
	     (while (and (not (NULL NODES)) (fourth (first NODES)))
	       (pop ANCESTORS)
	       (setf NODES (rest NODES)))
	   ;; call insert function to add the children to NODES
	   (setf NODES (funcall insert children NODES)))))
     )))


;
; eql-vis checks if the first elements of the two pairs are equal
;
(defun eql-vis (x y) 
    (equal (first x) (first y)))


;
; dfs insertion puts new chidren on the front of the list
;
(defun dfs (children NODES)
  (nconc children NODES)
  )

;
; bfs insertion puts new chidren at the end of the list
;
(defun bfs (children NODES)
  (nconc NODES children)
  )


(defmacro while (test &rest body)
`(do ()
     ((not ,test))
     ,@body))

;
; return-path takes a node and the 'NODES' list and produces the 
; search path
;
(defun return-path (node NODES)
  (let ((path nil) (move (third node)) (elt node) (func nil))
    (while (not (null move))
      (format t "~% ~A ~A" elt move)
      (setf path (cons move path))
      (setf func (second (assoc move *Complements*)))
      (setf elt (funcall func (first elt)))
      (setf elt (assoc elt NODES :test #'equal))
      (setf move (third elt)))
    path))