(in-package "KPML")

;;; File: initializations.lisp
;;;
;;; Contains those functions that set things up for
;;; generation... manage the system network as a whole...

;;;-----------------------------------------------------------------------
;;; Note   that       the  function    (reset-system-network)    calls
;;; compute-dependencies etc., and this   function only fills  in  the
;;; preselection   information for   the *current  language*  value of
;;; curlan. It should  fill  in information  for  all languages;  this
;;; makes this  operation quite expensive,  but probably better to get
;;; it over and   done with during loading  rather  than elsewhere. In
;;; anycase, for quicker  use,  there is  now  an additional  optional
;;; parameter: if this is true,  then  the old behaviour is  obtained:
;;; for  quicker setting  up of  network  when working   with a single
;;; language.

(defun RESET-SYSTEM-NETWORK (&optional restrict-to-current-language)
  (let ((languages-to-setup 
	  (if restrict-to-current-language (list curlan) all_languages))
	(previous-curlan curlan))
    (loop for language-being-checked in languages-to-setup
	if (list-systems language-being-checked)
	do (setf curlan language-being-checked)
	   (printwindow :display-pane  
			(concatenate 'string  
			  "Setting up connectivity for language variety: " 
			  (string curlan)))
	   (let ((root-of-network (primitive-find-input 'start)))
	     (cond (root-of-network
		    (setf (fetch-exact-feature-def-field 'waiting 'start) 
		      root-of-network) ;; 0.7.39: is now already a list
		    (setq paths-valid nil) ;; true when path augmentations up to date...
		    (setq system-dependencies-valid nil)
		    (check-derived-data)
		    (analyze-choosers)
		    (set-all-selectors 'choice-master)
		    ;; for external field options (John: Budapest: Sep94)
		    (when *stratification?*
		      (check-external-resource-availability))
		    (setf *inquiries-updated?* 
		      (remove curlan *inquiries-updated?*))
		    (setf *network-updated?*
		      (remove curlan *network-updated?*)))
		   (t
		    (warning 
		     "Network has no start-feature!!!! Unable to reset."))))
	else 
	do 
	(printwindow :display-pane  
			(concatenate 'string  
			  "Language variety "
			  (string language-being-checked)
			  " has no systems loaded. " ))
	(setf *network-updated?*
	  (remove curlan *network-updated?*)) ;; 1.1
	)
    (setf curlan previous-curlan)))

(defun PRIMITIVE-FIND-INPUT (feature)
;;; 0.7.39: update to return list, not first.
  (loop for sys in (list-systems curlan)
	when (eq (fetch-system-inputs sys) feature)
	collect sys))

;;; ----------------------------------------------------------------------
;;; ----------------------------------------------------------------------
;;; The following functions are inserted at strategic points 
;;; (i.e., in express for resetting the network, and in
;;; say-plan for loading defaults), to try 
;;; and avoid the situation that a user forgets to do reset-system-network.
;;; We try and recognize when it becomes necessary for a reset to
;;; be done; this may be fine-tuned. Also attempts to check that the
;;; defaults have been set...   (John:IPSI:Apr95)

(defun RESET-NETWORK-IF-NECESSARY ()
  (when (or (and (> (hash-table-count choosers) 0)    ;; 1.1
		 (null chooser-db))
;;; *network-updated?* is set to all_languages when a system, chooser or
;;; new systemic dependencies are loaded.
	    (member curlan *network-updated?*))
	(reset-system-network)))


;;; If it appears that a langauge has not had the active defaults for
;;; its inquiries set up, then they will be activated (but no new
;;; definitions will be loaded: only the file containing the 
;;; begin-default-environment statements. These have as side effect
;;; that the activedefaults of the relevant inquiries are set up
;;; for the current language. (This does not then have any effect
;;; on the existing activedefaults for other languages). Also
;;; have to ensure that those inquiries with trivialdefaults only
;;; (i.e., and are not subject to default environments) also receive
;;; activation.

(defun RESET-DEFAULTS-IF-NECESSARY ()
  (loop for curlan in *inquiries-updated?*
	do
	(ml-activate-defaults curlan))
  (setf *inquiries-updated?* nil))

;;; ----------------------------------------------------------------------
;;; And the following provides a way of forcing all necessary 
;;; initializations to be done before starting generation.
;;;
  ;; 3.2.48
  ;;   Appears that the old definition of do-all-kpml-initializations
  ;;   was causing some problems because it was activating 
  ;;   defaults but then doing  setup-spl afterwards, which appears then
  ;;   to have squashed the correctly activated defaults. So, we 
  ;;   now move the default activation so that it is after the 
  ;;   setup-spl. I hope that we do not need in fact to 
  ;;   activate defaults both before *and* after setup-spl!
;;; ----------------------------------------------------------------------

(defun DO-ALL-KPML-INITIALIZATIONS ()
  ;;  3.2.48
  ;;  Following moved below...
  ;;  (loop for curlan in all_languages do (ml-activate-defaults curlan))
  (setf *inquiries-updated?* nil)
  (reset-system-network)
  (kb-initializations)
  (setup-spl)              ;; 2.1 was missing this one!
  (loop for curlan in all_languages do (ml-activate-defaults curlan))
  (values))

;;; Maybe the following is overkill; experiment with leaving
;;; it out.

(defun CHECK-DEFAULTS-LOADED (lg)
  (let ((old-curlan curlan))
    (setf curlan lg)
    (dolist (inq (list-inquiries))
	    (let ((triv (fetch-inquiry-info inq 'trivialdefault)))
	      (when (and triv
			 (symbolp triv)
			 (not (eq triv
				  (fetch-inquiry-info inq 'activedefault))))
		    (message "For inquiry " 
			     inq
			     " active and trivial default mismatch for "
			     lg 
			     ". Activating SPL defaults.")
		    (return-from check-defaults-loaded T))))
    (setf curlan old-curlan)
    nil))

;;;--------------------------------------------------------------------
;;; Following needs to be  aware of multilingual conditionalization...
;;; ;;; (Keith's fix; ITRI seems to have problems with this definition
;;; though...)
;;; 1.1 removed eval of defun by a noncompiler-dependent version,
;;;     added keyword for optionally hitting where-am-i-id-code too.

(defun FLUSH-INQUIRY-IMPLEMENTATION-FUNCTIONS (&key (force-p nil))
;;; 0.7.15 fixed attempted flushing of nonexistent inquiry implemntations
  (dolist (x (if force-p inquiry-operators
	       (remove 'where-am-i-id inquiry-operators)))
    ;;(format t "inquiry operator: ~A~%" x)
    (let* ((z (fetch-inquiry-info x 'operatorcode)))
      (unless (or 
               (eq z 'trivialdefaultcode)
               (null z)  ;;; why should I have to add this???  knvl 7-feb-95
	       (not (fboundp z)))
	(setf (symbol-function z) 
	  #'(lambda (&rest args)
	      (declare (ignore args))
	      nil))))))





