;; edge.stk -- edges in an AP object graph.

(define-class <edge> ()
  ((source :accessor source :init-keyword :from)))

(define-class <construction-edge> (<edge>)
  ((label :accessor label :init-keyword :label)
   (target :accessor target :init-keyword :to
	   :allocation :virtual
	   :slot-ref (lambda (edge)
		       (let ((source [source edge])
			     (label [label edge]))
		       (if (slot-bound? source label)
			   (slot-ref source label)
			   @undefined)))
	   :slot-set! (lambda (edge target)
			(slot-set! [source edge] [label edge] target)))))

(define-macro (-> source label)
  `(make <construction-edge> :from ,source :label ,label))

(define-class <repetition-edge> (<edge>)
  ((label :accessor label :init-keyword :label
	  :allocation :virtual
	  :slot-ref (lambda (edge) "<repetition>")
	  :slot-set! (lambda (edge label)
		       (error "<repetition-edge> ~a: can't set label ~s"
			      edge label)))
   (target :accessor target :init-keyword :to)))

(define-macro (~> source target)
  `(make <repetition-edge> :from ,source :to ,target))

(define-method slot-name ((slot <symbol>)) slot)
(define-method slot-name ((slot <pair>)) (car slot))

;; return a list of edges from an object.
(define-method edges ((obj <object>))
  (map (lambda (slot) (-> obj (slot-name slot)))
       (class-slots (class-of obj))))

;; instead of Repetition classes, we just use scheme's built-in
;; aggregate types.
(define-method edges ((l <list>))
  (map (lambda (target) (~> l target)) l))
(define-method edges ((v <vector>)) (edges (vector->list v)))

;; there is no <hash-table> class, for some reason...
(define-method edges ((ht <unknown>))
  (if (hash-table? ht)
      (edges (hash-table->list ht))
      '()))

;; treat non-list pairs specially.
(define-method edges ((l <pair>))
  (if (list? (cdr l))
      (next-method)
      (list (~> l (car l)) (~> l (cdr l)))))

;; instead of Primitive (Terminal) classes, we just use scheme's
;; built-in types.
(define-method edges (x) '())

(define-method match-edge? (edge (l <null>)) #f)
(define-method match-edge? (edge (l <pair>))
  (or (match-edge? edge (car l))
      (match-edge? edge (cdr l))))
(define-method match-edge? (edge (l <symbol>))
  (eq? [label edge] l))
(define-method match-edge? (edge (c <class>))
  (is-a? [target edge] c))
;; (define-method match-edge? (edge (e <edge-spec>))



(provide "edge")