(in-package "KPML")

;;; File: default-orderings.lisp
;;; KPML-0.8
;;; March 1995, John Bateman.
;;; IPSI.
;;;

;;;----------------------------------------------------------------------
;;; Here we replace the Penman-style of setting default orderings for
;;; grammatical constituents by a definition macro that is also 
;;; aware of the possibility of mulitilingual divergences in 
;;; such default orderings.
;;;
;;; Can also be considered a stubb for more sophisticated treatments.
;;;
;;; A number of functions from Penman's orderings.lisp are 
;;; overwritten here in order to become consistent with the
;;; new definitions. Old default ordering constraints
;;; will continue to work with KPML 0.8+, although they
;;; have the side-effect that any multilingual information is
;;; lost.  KPML resources Release 3 and above have the new
;;; default ordering definitions in place.
;;;
;;;----------------------------------------------------------------------


(defmacro DEFINE-DEFAULT-ORDERS 
  (&key (language nil)(orders nil))
  (if (and language orders)
      `(merge-in-default-order ,language ,orders)
    (warning "Ill-formed default order definition!")))

  ;; 4.0 for ease of patching ...

(defmacro ADD-IN-DEFAULT-ORDERS 
  (&key (language nil)(orders nil))
  (if (and language orders)
      `(merge-in-default-order 
        ,language 
        (append (let ((curlan ,language))
                  (ml-default-orderings)) ,orders))
    (warning "Ill-formed default order add-in definition!")))



;;; The structure of the value of the global variable 
;;; FRAGMENT-ORDER-LSTS is now changed so that it consists of
;;; a cons. The car of the cons is the symbol :multilingual;
;;; this enables KPML to recognize whether it has a KPML-style
;;; default ordering definition, or a Penman-style one. The
;;; cdr of the cons is a simple association list of pairs,
;;; where the first element of each pair denotes a language, and
;;; the second element is the old Penman-style list of
;;; order fragments. No multilingual conditionalization is
;;; allowed within elements, since this is not a feature of
;;; the system whose use is particularly encouraged. If at
;;; some time it seems useful, it can be put in.

(defun MERGE-IN-DEFAULT-ORDER (lg ml-order-fragments)
  (cond ((eq (car fragment-order-lsts) :multilingual)
	 (let ((modified-order-lists nil)
	       (consumed nil))
	   (loop for lg-defaults in (cdr fragment-order-lsts)
		 do
		 (cond ((eq (car lg-defaults) lg)
			(push (list lg ml-order-fragments)
			      modified-order-lists)
			(warning "Default orderings for language " lg 
				 " being updated.")
			(setf consumed t))
		       (t
			(push lg-defaults modified-order-lists))))
	   (unless consumed (push (list lg ml-order-fragments)
				  modified-order-lists))
	   (setf fragment-order-lsts 
		 (cons :multilingual
		       modified-order-lists))))
	(t
	 (when fragment-order-lsts
	       (warning "Multilingual default orderings for language "
			lg " are being attempted although previously a non-multilingual set of default orderings had been loaded; new definition wins, old
ones are lost."))
	 (setf fragment-order-lsts 
		 (cons :multilingual
		       (list (list lg ml-order-fragments)))))))


;;;
;;; Function call to replace previous monolingual references to
;;; the variable fragment-order-lsts...
;;;

(defun ML-DEFAULT-ORDERINGS ()
  (if (eq (car fragment-order-lsts) :multilingual)
      (second (assoc curlan (cdr fragment-order-lsts)))
    fragment-order-lsts))


;;;
;;; Finally, provide for straightforward conversion to KPML form.
;;; Following function is called when KPML is called on to output
;;; some version of the ordering information and there is no
;;; multilingual-conform loaded. Provides conversion. 
;;;

(defun MAKE-KPML-CONFORMING-DEFAULT-ORDERINGS ()
  (warning "Previously nonmultilingual default orderings are now being forcibly updated to be multilingually conform and defined for language: " curlan ".")
  (setf fragment-order-lsts
	`(:multilingual (,curlan ,fragment-order-lsts))))





