(in-package "KPML")

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

;;;----------------------------------------------------------------------
;;; Here we replace the Penman-style of setting system dependencies for
;;; ordering entry of parallel systems by a definition macro that is also 
;;; aware of the possibility of mulitilingual divergences in 
;;; such dependencies.
;;;
;;; The function compute-system-dependencies from Penman's allparts.lisp is
;;; overwritten here in order to become consistent with the
;;; new definitions. Old system dependency 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
;;; system dependency definitions in place.
;;;
;;;----------------------------------------------------------------------

;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(declaim (special *network-updated?*
		  curlan))
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


;;; The structure of the system-dependencies Penman variable was a
;;; list of elements representing ordered sets of systems that were
;;; parallel. The ordering of these systems is interpreted as the
;;; required entry order during traversal. The elements could either
;;; be lists themselves (directly representing the ordered sets) or be
;;; names of such sets. Until KPML 0.7, these names were maintained as
;;; a simple list in the variable *ordering-regions*; this is replaced
;;; in KPML 0.8+ with the variable *system-dependency-sets* which is
;;; an association list relating names of dependency sets to a further
;;; association list relating languages to the systems to be in that
;;; dependency set for a language. Dependency set names and their
;;; values are defined with the following macro...

(defmacro DEFINE-DEPENDENCY-SET
  (&key (language nil)(name nil)(systems-list nil))
  (if (and language name systems-list)
      `(register-system-dependency-set ,language ',name ,systems-list)
    (warning "Ill-formed system dependency set definition!")))

;;; Thus, whereas the old definition form was:
;;;
;;; (defvar *ordering-regions*) 
;;;  (setf *ordering-regions* '(CLAUSE-REGIONS DETERMINATION-REGION ...))
;;; 
;;; (defvar CLAUSE-REGIONS)
;;; (setq CLAUSE-REGIONS '(ATTITUDE CIRCUMSTANTIAL CLAUSE-COMPLEX...))
;;;
;;; this now becomes:
;;;
;;; (define-dependency-set
;;;    :language :english
;;;    :name CLAUSE-REGIONS
;;;    :systems-list '(ATTITUDE CIRCUMSTANTIAL CLAUSE-COMPLEX...))
;;;
;;; etc. for each such so-called `ordering-region'.

(defvar *ordering-regions* NIL "stubb system dependency variable for Penman")

;;; Code for filling out the macro definition...

(defvar *SYSTEM-DEPENDENCY-SETS* nil)

  ;; ----------------------------------------------------------------------
  ;; 3.2.29 
  ;; Following function was throwing away old definitions for
  ;; already defined languages when new definitions for new
  ;; languages are loaded, thus messing up the dependency
  ;; orderings when generating multilingually.
  ;; ----------------------------------------------------------------------

(defun REGISTER-SYSTEM-DEPENDENCY-SET (lg name system-list)
  (cond ((assoc name *system-dependency-sets*)
	 (setf *system-dependency-sets*
	       (loop for a in *system-dependency-sets*
		     if (eq (first a) name)
		     collect
		     (cons name
			   (let* ((consumed nil)
				  (update
				   (loop for (lgvar depset) in (cdr a)
					 if (eq lgvar lg)
					 collect (progn 
						   (setf consumed T)
						   (list lg system-list))
					 else
					 collect (list lgvar depset))))
			     (if consumed 
				 update
			       (append update (list (list lg system-list))))))
		       else
		       collect a)))
	(t
	 (push (list name
		     (list lg system-list)) *system-dependency-sets*)))
  (setf *network-updated?* (list lg)))


;;; The complete list of dependencies is then declared with the following
;;; macro call...

(defmacro DEFINE-SYSTEM-DEPENDENCIES
  (&key (language nil)(dependencies nil))
  (if (and language dependencies)
      `(merge-in-system-dependencies ,language ,dependencies)
    (warning "Ill-formed system dependency definition!")))


;;; This means that the former definition:
;;;
;;; (setq System-Dependencies 
;;;   '((THING-TYPE-REGION MODIFICATION-REGION-I DETERMINATION-REGION 
;;;			   (QUANTIFICATION) MODIFICATION-REGION-II) 
;;;	(THING-TYPE-REGION MODIFICATION-REGION-I DETERMINATION-REGION 
;;;			   MODIFICATION-REGION-II (NOMINAL-TERM-RESOLUTION)) 
;;;	((CLAUSE-COMPLEXITY DEPENDENCE MOOD-UNIT 
;;;			    INDEPENDENT-CLAUSE-SIMPLEX MOOD-TYPE) 
;;;	 (TRANSITIVITY-UNIT PROCESS-TYPE SENSING REACTIVE-RANGE 
;;;			    PERCEPTION-TYPE PERCEPTIVE-RANGE 
;;;			    CLIENCY VERBAL-RANGE RANGE-MEDIATION AGENCY ...))
;;;	))
;;; 
;;; where systems require an additional level of bracketting over and
;;; above the `regions' is replaced by the following:
;;;
;;;  (define-system-dependencies 
;;;     :language :english
;;;     :dependencies 
;;;       '((THING-TYPE-REGION MODIFICATION-REGION-I DETERMINATION-REGION 
;;;			   (QUANTIFICATION) MODIFICATION-REGION-II) 
;;;	    (THING-TYPE-REGION ...)))
;;;

;;; ----------------------------------------------------------------------
;;; Code for doing this...

;;; 
;;; The structure of the value of the global variable 
;;; SYSTEM-DEPENDENCIES 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
;;; system dependency 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
;;; dependency sets. 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-SYSTEM-DEPENDENCIES (lg dependencies)
  (cond ((eq (car system-dependencies) :multilingual)
	 (let ((modified-dependency-lists nil)
	       (consumed nil))
	   (loop for lg-defaults in (cdr system-dependencies)
		 do
		 (cond ((eq (car lg-defaults) lg)
			(push (list lg dependencies)
			      modified-dependency-lists)
			(warning "System dependencies for language " lg 
				 " being updated.")
			(setf consumed t))
		       (t
			(push lg-defaults modified-dependency-lists))))
	   (unless consumed 
	     (push (list lg dependencies) modified-dependency-lists))
	   (setf system-dependencies 
	     (cons :multilingual
		   modified-dependency-lists))))
	(t
	 (when system-dependencies
	       (warning "Multilingual system dependencies for language "
			lg " are being attempted although previously a non-multilingual set of system dependencies had been loaded; new definition wins, old
ones are lost."))
	 (setf system-dependencies 
		 (cons :multilingual
		       (list (list lg dependencies))))))
  ;; 2.1 was not noticing that an update had been made...
  (pushnew lg *network-updated?*)
  )

;;;
;;; Function call to replace previous monolingual references to
;;; the variable system-dependencies...
;;;

(defun ML-SYSTEM-DEPENDENCIES ()
  (if (eq (car system-dependencies) :multilingual)
      (second (assoc curlan (cdr system-dependencies)))
    system-dependencies))


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

(defun MAKE-KPML-CONFORMING-DEPENDENCY-SETS ()
  (warning "Previously nonmultilingual system dependencies are now being forcibly updated to be multilingually conform and defined for language: " curlan ".")
  (setf *system-dependency-sets*
	(loop for region in *ordering-regions*
	      collect
	      `(,region 
		(,curlan ,(kpml-eval region)))))
  (setf system-dependencies
	`(:multilingual (,curlan ,system-dependencies))))



;;; 

(defun ERASE-NONSYSTEMIC-ORDERINGS ()
  (setq fragment-order-lsts nil)
  (setq *system-dependency-sets* nil)  ;; 0.8: multilingual dependencies.
  (setq System-dependencies nil))
  


