;;; -*- Mode: LISP; Package: PENMAN -*-
(in-package "PENMAN")

;;;========================================================================
;;; 
;;; Generalized access to external resources
;;; ----------------------------------------
;;;
;;;
;;; The function INSTANTIATE-FROM-EXTERNAL-RESOURCES takes a
;;; constraint pattern, which is typically in the form of a partially
;;; filled inter-axis-relation structure (i.e., consists of both paradigmatic
;;; and syntagmatic constraints) and returns a list of fully specified
;;; instances of the inter-axis-relation obtained from an external
;;; source --- that is, a source outside of the systemic resources
;;; maintained internal to the system. This is to be used for very
;;; general interfacing with typical external resources such as
;;; databases, domain models, etc., which will usually already exist
;;; in non-systemic forms. The main means of reconciliation of the
;;; external information and internal potential is based on the model
;;; of interaction used between upper model and domain models as
;;; defined in (ISI-)Penman. Only one external source is allowed per
;;; stratum of the semiotic system. Further diversification of
;;; resources and their possible integration remains the responsbility
;;; of the external resource provider. 
;;;
;;; Access to external resouces is provided by  the function
;;; DEFINE-EXTERNAL-RESOURCE, which associates an access function with
;;; a stratum. No internal system recompilation/evaluation is
;;; necessary for using external resources.
;;;
;;;                                     Initial version: John: IPSI: Oct 93
;;;========================================================================


(defvar *external-resources-table* nil)

(defun DEFINE-EXTERNAL-RESOURCES (stratum accessor-fn)
  "Associate an accessor function for external resources with a stratum"
  (cond ((assoc stratum *external-resources-table*)
	 (rplacd (assoc stratum *external-resources-table*) accessor-fn))
	(t
	 (push (cons stratum accessor-fn) *external-resources-table*))))

;;;----------------------------------------------------------------------

;;; It is important that matches obtained during instantiation
;;; remain active for further instantiation (particularly for generic
;;; participants), even when this occurs in subsequent calls to 
;;; the instantiation function... Matches of cycles against external
;;; instances are therefore maintained in the following list. Typically
;;; the match is multiple, so entries on the list have the form:
;;; (future-cycle-label . (list-of-matches)). For generality, the
;;; constraint pattern and its label are treated as separate parameters
;;; to the instantiate function.

(defvar *currently-active-instances* nil)

(defun CLEAR-EXTERNALLY-INSTANTIATED-INSTANCES ()
  (setf *currently-active-instances* nil))

(defun INSTANTIATE-FROM-EXTERNAL-RESOURCES (constraint-pattern label)
  "Obtain externally managed instances (returned as inter-axis-relations) conforming to the pattern"
  (let ((instances 
	 (cond ((inter-axis-relation-p constraint-pattern)
		(let ((access-fn (cdr
				  (assoc 
				   (inter-axis-relation-stratum constraint-pattern)
				   *external-resources-table*))))
		  (cond (access-fn
			 (apply access-fn (list constraint-pattern)))
			(t
			 (warning "No external resources available for stratum"
				  (inter-axis-relation-stratum constraint-pattern))
			 constraint-pattern))))
	       ((member label *external-patterns*)
		(sfk-retriever label))      ;;; <========================MUST BE PARAMETERIZED...
	       ((member label *patterns-known-to-sfk*)
		(sfk-real-retriever label))
	       (t
		(warning "Ununderstood constraint sent for external instantiation:"
			 constraint-pattern)
		(setf *sfk-instances* nil)
		nil))))
    (push (cons label instances) *currently-active-instances*)
    instances))



;;; Plus a little check for when resetting the network...

(defun CHECK-EXTERNAL-RESOURCE-AVAILABILITY ()
  (dolist (a *external-resources-table*)
	  (let ((stratum (car a))
		(fn      (cdr a)))
	    (unless (member stratum (fetch-output-features 'stratification))
		    (warning "External resources allowed for unknown stratum: " stratum))
	    (unless (fboundp fn)
		    (warning "External resource accessor function: " fn " not defined")))))

;;;----------------------------------------------------------------------
;;; Trial of prespecified patterns for external instance retrieval:
;;; to be used, perhaps, when the retrieval mechanisms are sufficiently
;;; involved as to require complete segregation from our general
;;; resources... Also, if an unrecognized constraint-pattern (i.e.,
;;; it is not a inter-axis-relation) is found, it falls through to
;;; here.

(defvar *external-patterns* nil)

;;; List of patterns that are actually known and defined within an SFK image
;;; that can interact with KPML...

(defvar *patterns-known-to-sfk* nil)

;;;================================================================================
;;; Also an interface for networks into external resources...

;;(defvar *input-features-of-intergates* nil)
;;(defvar *list-of-intergates* nil)

;;; the following should more effectively separate internal and external features,
;;; (e.g., :inputs and :external-inputs), but will do for the meantime...

(defmacro INTER-GATE (&rest arguments)
  `(load-ml-system ',arguments :intergate))

;;;----------------------------------------------------------------------
;;; Certain choices will be constrained externally. Allowing this to
;;; be a fully general process is too expensive (i.t.o. requiring full
;;; constraint resolution). Therefore, we provide a limited opportunity
;;; for the resource definer to specify explicitly which options will
;;; be set from outside. These are specified by `external-systems'.
;;(defvar *list-of-external-systems* nil)
;;(defvar *externally-constrained-features* nil)
  
(defmacro EXTERNAL-SYSTEM (&rest arguments)
  `(load-ml-system ',arguments :external))

;;; Above functions previously used special system loading function,
;;; now standard KPML further parameterized to cover these cases.

;;;--------------------------------------------------------------------------------


;;; also need to know what micro-functions are used in the externally
;;; defined network... Following macro defines allowable
;;; micro-functions...

(defmacro DEFINE-EXTERNAL-MICRO-FUNCTIONS (&rest new-mfs)
  `(dolist (mf (quote ,new-mfs)) (pushnew mf *register-micro-functions*)))


;;; Finally, need to change the consistency checking functions
;;; slightly so that they do not get confused about the lack
;;; of externally defined features... (was defined in tests.lisp):

(defun UNREACHABLE-INPUTS-TEST ()
  (let* ((external-and-internal-output-features 
	  (append (hashtable-to-list all-output-features)
		  *input-features-of-intergates*
		  (cons 'start nil))))
  (loop for S in (list-systems Curlan)
       bind Bad Each Feats 
       do (cond
	    ((setq each 
		   (set-difference 
		    (fetch-input-features s) 
		    external-and-internal-output-features))
	     (Push (list  (remove-Duplicates Each :test #'equal) s)
		   Bad )
	     (setq feats (append feats each) )))
       finally (cond
		 (Bad (Warning "Input features not recognized as outputs of any systems: "
			       (Dreverse Bad))))
       (RETURN (sort (remove-Duplicates (copy-list Feats) :test #'equal)
		     #'String<=)))))



