;; path.stk -- path directives for traversing class dictionary graphs

(require "edge")

;; AP/STklos paths are a bit different from paths in Demeter.  Since
;; there is no concept of a class graph, we can't do any path-set
;; computation; instead we use path directives to make decisions about
;; which way to go dynamically at each node in the object graph.  If
;; an object is of one of the target classes of a path, the traversal
;; stops; thus, the :to keyword serves the same purpose as *to-stop*
;; in Demeter.  (The case where *to* and *to-stop* differ, and where
;; the user would want to use *to*, is relatively rare; most of these
;; cases might be handled by something like :to-all, which only
;; terminates the traversal at the class if there are no edges to
;; other objects of the same class-- this would handle the case of a
;; directly recursive class, i.e. A -> x A y.)  The :through keyword
;; serves a similar purpose to *through* in Demeter, but slightly
;; different: if an object has an outgoing edge whose label is in the
;; list, then no other edges from that object are traversed.  The
;; :bypassing keyword is pretty much the same as *bypassing* in
;; Demeter, except it works for both edges and classes.

;; TODO: through is not yet implemented.

(define-generic set-source!)
(define-generic set-target!)

(define-class <path> ()
  ;; sources and targets are lists of classes.
  ((sources :accessor sources :initform '())
   (source :accessor source :init-keyword :from
	   :allocation :virtual
	   :slot-ref (lambda (p) (first [sources p]))
	   :slot-set! set-source!)
   (targets :accessor targets :initform '())
   (target :accessor target :init-keyword :to
	   :allocation :virtual
	   :slot-ref (lambda (p) (first [targets p]))
	   :slot-set! set-target!)
   ;; through and bypassing are lists of symbols (edge names) or classes.
   (through :accessor through :init-keyword :through :initform '())
   (bypassing :accessor bypassing :init-keyword :bypassing :initform '())))

(define-method first ((l <null>)) #f)
(define-method first ((l <pair>)) (car l))

(define-method set-source! ((p <path>) (c <class>))
  (set! [sources p] (list c)))
(define-method set-source! ((p <path>) (l <list>))
  (set! [sources p] l))
(define-method set-target! ((p <path>) (c <class>))
  (set! [targets p] (list c)))
(define-method set-target! ((p <path>) (l <list>))
  (set! [targets p] l))

(define-method stop-at? ((p <path>) obj)
  (is-one-of? obj [targets p]))
(define-method is-one-of? (obj (l <null>)) #f)
(define-method is-one-of? (obj (l <pair>))
  (or (is-a? obj (car l)) (is-one-of? obj (cdr l))))

(define-method bypass? ((p <path>) (e <edge>))
  (match-edge? e [bypassing p]))

(define-method continue? ((path <path>) obj)
  (not (stop-at? path obj)))
(define-method continue? ((path <path>) (edge <edge>))
  (not (bypass? path edge)))

(define-macro (define-path name . args)
  `(define ,name (make <path> ,@args)))

(define-method from args
  (apply make <path> :from args))

(define-method to args
  (apply make <path> :to args))

(provide "path")