(in-package :lojban-dot)

(declaim (optimize (speed 0) (safety 3) (debug 3)))

(defvar *pr*)
(defvar *collapse-list-nodes* nil)

;(defun make-graph ()
 ; (let ((*pr* (cl-peg:pp *lg* "ko sipna" t)))
  ;  (cl-dot:dot-graph (cl-dot:generate-graph (cl-peg:pr-result *pr*)) "mydot.ps"))
;)

(defgeneric filter-lists (o))
(defmethod filter-lists ((pv cl-peg:parse-node))
  (list pv))


(defmethod cl-dot:object-node ((pr cl-peg:parse-result))
  (cl-peg:parse-result-root-parse-node pr))

; --------------------------------------------------------------------------------
; for cl-peg parse-node structs

(defmethod cl-dot:object-node ((pv cl-peg:parse-node))
  (if (not (null pv))
      (let ((pe (cl-peg:parse-node-parse-element pv)))
	(if (typep pe (find-class 'cl-peg:named-non-terminal))
	    (if (equal (slot-value pe 'cl-peg::NAME) 'cl-peg::|gismu|)
		(make-instance 'cl-dot:node :attributes (list :label (concatenate 'string "gismu: " (cl-peg:parse-node-input-string *pr* pv ))))
		(progn
					;		  (format t "name is ~A ~A" (slot-value pe 'cl-peg::NAME) (class-of (slot-value pe 'cl-peg::NAME)))
		  (make-instance 'cl-dot:node :attributes (list :label (string (slot-value pe 'cl-peg::NAME)))))
		)
	    )
	)))

(defmethod filter-lists ((pv cl-peg:parse-node))
  (list pv))

(defmethod cl-dot:object-points-to ((pv cl-peg:parse-node))
  (reverse 
   (let ((children (cl-peg:parse-node-children pv)))
    (if (not (null children))
	(let ((filtered (filter-lists (cl-peg:parse-node-children pv))))
	  filtered))))
)


(defmethod cl-dot:object-pointed-to-by ((pv cl-peg:parse-node)))

(defmethod cl-dot:object-knows-of ((pv cl-peg:parse-node)))

; --------------------------------------------------------------------------------
; for lojban objects

(defmethod cl-dot:object-node ((l lojban::jbovalsi))
  (make-instance 'cl-dot:node ;(list :label (class-name (class-of l))))
		 :attributes (list :label (slot-value l 'lojban::grammar-label)))
)

(defmethod cl-dot:object-node ((l lojban::lojban-grammar-leaves))
  (make-instance 'cl-dot:node ;(list :label (class-name (class-of l))))
		 :attributes (list :label (concatenate 'string (slot-value l 'lojban::grammar-label)
						       " "
						       (slot-value l 'lojban::text))))
)


(defmethod cl-dot:object-points-to ((l lojban::jbovalsi))
  (reverse
   (let ((children (slot-value l 'lojban::children)))
     (if (not (null children))
	  (filter-lists children)))))

; --------------------------------------------------------------------------------
; lists

(defmethod filter-lists ((l lojban::jbovalsi))
  (list l))

(defmethod cl-dot:object-node ((l list))
  (break))

(defmethod cl-dot:object-points-to ((l list))
  (break))

(defmethod filter-lists ((l list))
  (let ((l (reduce #'append 
		   (loop for c in l when (filter-lists c) collect it))))
;    (format t "~% ~A" l)
    l))