;;; Copyright (c) 1991-2022 John Carroll, Ann Copestake, Robert Malouf, Stephan Oepen
;;; see LICENSE for conditions

(in-package :lkb)

;;; functions which output in path notation
;;; mostly moved from lexinput.lsp 


;;; called from outputsrc

(defun output-type-as-paths (type type-record ostream)
  (format ostream 
          "~%~(~A~) ~(~A~) " type (ltype-parents type-record))
  (when (ltype-comment type-record)
    (format ostream "~%~S" (ltype-comment type-record)))
  (if (ltype-enumerated-p type-record)
    (format ostream "~%(OR~{~( ~A~)~}).~%" (ltype-daughters type-record))
    (let ((local-constraint (ltype-local-constraint type-record)))
      (if (null local-constraint)
        (format ostream ".~%")
        (display-dag1 local-constraint
                      'path2 ostream)))))


;;; unification based

(defun output-unif (unif ostream active-p)
   (format ostream "~%")
   (cond 
      ((unification-p unif)
         (output-unif-lhs ostream unif active-p)
         (output-path ostream (basic-unification-rhs unif) active-p))
      ((or (path-p unif) (typed-path-p unif))
         (output-path ostream unif active-p))
      (t (format ostream "~A" unif))))

(defun output-unif-lhs (ostream unif &optional active-p)
   (declare (ignore active-p))
   (cond 
      ((unification-p unif) 
         (output-path ostream (basic-unification-lhs unif))
         (format ostream "  =  "))
      (t (error "Unrecognised item in lexical specification ~A" unif))))
         

(defun display-fs-spec (structure ostream &optional active-p)
   (cond 
      ((fs-and-path-p structure) 
         (display-fs-spec (fs-and-path-fs structure) 
            ostream active-p)
         (output-path ostream (fs-and-path-path structure) active-p))
      (t (error "~%Unknown thing in unification specification ~A"
            structure))))  

(defun output-path (ostream path &optional active-p)
   (cond ((typed-path-p path)
          (let ((ordered-list (typed-path-typed-feature-list path)))
            (format ostream "<")
            (when ordered-list
              (output-type-feature-pair ostream (car ordered-list) active-p)
              (loop for tfp in (cdr ordered-list)
                   do
                   (format ostream ":" )
                   (output-type-feature-pair ostream tfp active-p)))
            (format ostream ">")))
         ((path-p path)
          (let ((ordered-list (path-typed-feature-list path)))
            (format ostream "<")
            (when ordered-list
              (format ostream " ~A " (car ordered-list))
              (loop for feat in (cdr ordered-list)
                   do
                   (format ostream ":" )
                   (format ostream " ~A " feat)))
            (format ostream ">")))
         (t
          ;; !!! each graphics platform must define an appropriate output-active-type
          ;; ~/ format function
          (format ostream
            (if active-p "~/lkb::output-active-type/" "~S") (u-value-type path)))))

(defun output-type-feature-pair (ostream tfp &optional active-p)
   (if active-p
      (format ostream " ~A " 
         (type-feature-pair-feature tfp))
      (format ostream "~( ~A ~A ~)" 
         (type-feature-pair-type tfp)
         (type-feature-pair-feature tfp))))