(in-package "PENMAN")

;;; File: leftover-pretty-printing.lisp

;;; Extra functions for pretty printing additional objects that
;;; are not normally looked at outside of the interface...

(defun PRETTY-FORMAT-TERM-GRAPH (stream term-graph &optional (column 0))

  (let ((pretty-term "") col)

  (setf pretty-term
	(concatenate 'string pretty-term
	       (format nil "(~a / ~a" (term-graph-id term-graph)
		       (term-graph-type term-graph))))
  (setf col (+ column 3))
  (when (term-graph-features term-graph)
    (dolist (feature (term-graph-features term-graph))
      (setf pretty-term
	    (concatenate 'string pretty-term
		   (format nil "~%~v@T:~a " col (first feature))))
      (setf col (+ col (1+ (length (symbol-name (first feature))))))
      (setf pretty-term
	    (if (and (typep (rest feature) 'term-graph)
		     (term-graph-type (rest feature)))
	      (concatenate 'string pretty-term
			   (pretty-format-term-graph
			    stream (rest feature) col))
	      (concatenate 'string pretty-term
			   (format nil "~s"
				   (if (typep (rest feature) 'term-graph)
				     (term-graph-id (rest feature))
				     (rest feature))))))
      (setf col (- col (1+ (length (symbol-name (first feature))))))))
  (setf pretty-term
	(concatenate 'string pretty-term (format nil ")")))
  pretty-term))


(defun pretty-format-spl (spl-term &optional (column 0))

  (if (atom spl-term)
    (format nil "~s" spl-term)
    (if (eq (second spl-term) '/)
      (let ((pretty-term "") col features)
	(setf pretty-term
	      (concatenate 'string pretty-term
			   (format nil "(~s / ~s" (first spl-term)
				   (third spl-term))))
	(setf col (+ column 3))
	(when (rest (rest (rest spl-term)))
	  (let ((raw-features (rest (rest (rest spl-term)))))
	    (mapl #'(lambda (rest)
		      (when (keywordp (first rest))
			(push (if (keywordp (third rest))
				(list (first rest)(second rest))
				(list (first rest)(second rest) (third rest)))
			      features)))
		  raw-features))
	(setf features (reverse features))
	(dolist (feature features)
	  (setf pretty-term
		(concatenate 'string pretty-term
			     (format nil "~%~v@T~s " col (first feature))))
	  (setf col (+ col (1+ (length (symbol-name (first feature))))))
	  (setf pretty-term
		(if (third feature)
		  (if (typep (third feature) 'cons)
		    (concatenate 'string pretty-term
				 (format nil " ~s " (second feature))
				 (pretty-format-spl (third feature) col))
		    (concatenate 'string pretty-term
				 (format nil " ~s " (second feature))
				 (format nil "~s" (third feature))))
		  (if (typep (second feature) 'cons)
		    (concatenate 'string pretty-term
				 (pretty-format-spl (second feature) col))
		    (concatenate 'string pretty-term
				 (format nil "~s" (second feature))))))
	  (setf col (- col (1+ (length (symbol-name (first feature))))))))
	(concatenate 'string pretty-term (format nil ")")))
      (let ((terms ""))
	(setf terms (concatenate 'string terms (format nil "(")))
	(setf terms
	      (concatenate 'string terms (pretty-format-spl (first spl-term)
							    column)))
	(when (rest spl-term)
	  (dolist (term (rest spl-term))
	    (setf terms (concatenate 'string terms
				     (format nil "~%~v@T" (1+ column))))
	    (setf terms (concatenate 'string terms
				     (pretty-format-spl term column)))))
	(concatenate 'string terms ")")))))