(in-package "KPML")

;;; File: inquiries.lisp
;;; 
;;; Contains definition of the linguistic object: inquiry.
;;; Fully multilingual.

;;; 1.1 an important change is the inclusion of the initial value 'kb
;;;     for domain. If this is not specified, and a user does not
;;;     give a domain (which may be the case for new users particularly)
;;;     then Lisp will recursively fail trying to evaluate for various
;;;     reasons when attempting to store environment responses. So it
;;;     is very important that this inquiry slot never ends up as NIL.
;;;     (John:Edinburgh:Nov97)

;;; 3.2 clisp usage out.

(defstruct INQUIRY-OPERATOR 
  "the structure of an Inquiry Operator."
  (name nil :type (or symbol list))
  (domain 'kb :type (or symbol list)) ;; 1.1: NOTE THIS IS ESSENTIAL!
  (mode nil :type symbol)  ;!!! heh, this is never a list, or?
  (parameters nil :type (or symbol list))
  (english '("") :type list )
  (operatorcode nil :type (or symbol list))
  (parameterassociationtypes nil :type (or symbol list))
  (answerset nil :type (or symbol list))
  (preselectionguidance nil :type (or symbol list))
  (createdassociationtype nil :type (or symbol list))
  (trivialdefault nil :type (or symbol list term-graph))
  (comments '("") :type (or string list))
  (editor '("") :type (or string list))
  (date '("") :type (or string list)) 
  (patch-status nil :type (or symbol list))    ;; added KPML 0.9
  ;; Following stores the current default value used by the SPL interpreter.
  ;; For non-atomic values, it is a term-graph structure.
  (activedefault nil :type (or symbol list term-graph))
  (LS-set nil :type (or symbol list))
  )

;;; ----------------------------------------------------------------------
;;; User access...

(DEFMACRO AskOperator (&REST ARGLS)
  `(load-ml-inquiry ',ARGLS))

(DEFMACRO IdentifyOperator (&REST ARGLS)
  `(load-ml-inquiry ',ARGLS))

(DEFUN Operator-Definition-P (Operator-Name)	
  (gethash Operator-Name quiry-operators))

(defun INQUIRY-DEFINED-FOR-LG-P (name lg)
  (let ((inquiry-instance (gethash name quiry-operators)))
    (and 
     inquiry-instance
     (member lg (inquiry-operator-ls-set inquiry-instance))
     (eq name (strip-lx (parse-clause (inquiry-operator-name inquiry-instance) lg)))))) 


(defun LIST-INQUIRIES (&optional (lg nil))
  (let ((inquiry-names (hashtable-to-list quiry-operators)))
    (if lg
	(loop for i in inquiry-names
	     when (inquiry-defined-for-lg-p i lg)
	     collect i)
      inquiry-names)))

;;; ----------------------------------------------------------------------
;;; Management functions...

;;; NOTE: structure definition in ml-penman-inquiry-class changed so
;;; that more slots have the list option in order to be properly
;;; conditionalized....

;;; This includes  the   name as indicated  in  the  following changed
;;; function. Note also, that as an exception to the general case, the
;;; monolingual   result  of  the   fields  createdassociationtype and
;;; operatorcode must always be a symbol, never a list.
;;; 0.9 patch-status added.

(defun FETCH-INQUIRY-INFO (quiry-id fld-id &optional ls)
  (let ((x (gethash quiry-id quiry-operators)) tmp)
    
    (unless x (return-from fetch-inquiry-info nil))
    (unless ls (setq ls CurLan))
    (when (eq fld-id 'ls-set)
	  (return-from fetch-inquiry-info (inquiry-operator-ls-set x)))
    (if (and ls (not (member ls (inquiry-operator-LS-set X))))
        (return-from fetch-inquiry-info nil))

    (case fld-id
      ((everything instance) 
       (setf tmp (copy-inquiry-operator x))
       (unless ls (return-from fetch-inquiry-info x))
       (setf (inquiry-operator-domain tmp) 
	 (strip-ml (inquiry-operator-domain X) ls))
       (setf (inquiry-operator-mode tmp) 
	 (strip-ml (inquiry-operator-mode X) ls))
       (setf (inquiry-operator-parameters tmp) 
	 (parse-clause (inquiry-operator-parameters X) ls))
       (setf (inquiry-operator-operatorcode tmp) 
	 (strip-ml (inquiry-operator-operatorcode X) ls))
       (setf (inquiry-operator-parameterassociationtypes tmp) 
	 (parse-clause 
	  (inquiry-operator-parameterassociationtypes X) ls))
       (setf (inquiry-operator-answerset tmp) 
	 (parse-clause (inquiry-operator-answerset X) ls))
       (setf (inquiry-operator-preselectionguidance tmp) 
	 (parse-clause (inquiry-operator-preselectionguidance X) ls))
       (setf (inquiry-operator-createdassociationtype tmp) 
	 (strip-ml (inquiry-operator-createdassociationtype X) ls))
       (setf (inquiry-operator-trivialdefault tmp) 
	 (strip-ml (inquiry-operator-trivialdefault X) ls))
       (setf (inquiry-operator-english tmp)
	 (parse-clause (inquiry-operator-english x) ls))
       (setf (inquiry-operator-activedefault tmp) 
	 (strip-ml (inquiry-operator-activedefault X) ls))
       (setf (inquiry-operator-patch-status tmp)
	 (strip-ml (inquiry-operator-patch-status X) ls))
       tmp)
      (name           (if ls (strip-ml (inquiry-operator-name x) ls)
			(inquiry-operator-name X)))
;;; 0.9 temporary hack to stop blowing up on LEXICON.
      (domain           (let ((r 
			       (if ls (strip-ml (inquiry-operator-domain X) ls)
				 (inquiry-operator-domain X))))
			  (if (or (eq r 'lexicon)
				  (eq r 'lex)) 'tp r)))
      (mode             (if ls (strip-ml (inquiry-operator-mode X) ls)
			  (inquiry-operator-mode X)))
      (parameters     (if ls (parse-clause (inquiry-operator-parameters X) ls)
			(inquiry-operator-parameters X)))
      (english              (if ls (parse-clause (inquiry-operator-english x) ls)
			      (inquiry-operator-english x)))
      (operatorcode         (if ls (strip-ml (inquiry-operator-operatorcode X) ls)
                                   (strip-lx (inquiry-operator-operatorcode X))))
      (patch-status  (if ls (strip-ml (inquiry-operator-patch-status X) ls)
		       (strip-lx (inquiry-operator-patch-status X))))
      (parameterassociationtypes 
                            (if ls (parse-clause (inquiry-operator-parameterassociationtypes X) ls)
                                   (inquiry-operator-parameterassociationtypes X)))
      (answerset            (if ls (parse-clause (inquiry-operator-answerset X) ls)
                                   (inquiry-operator-answerset X)))
      (preselectionguidance (if ls (parse-clause (inquiry-operator-preselectionguidance X) ls)
                                   (inquiry-operator-preselectionguidance X)))
      (createdassociationtype 
                            (if ls (strip-lx
				    (parse-clause 
				     (inquiry-operator-createdassociationtype X) ls))
			      (inquiry-operator-createdassociationtype X)))
      (trivialdefault       (if ls (strip-ml (inquiry-operator-trivialdefault X) ls)
                                   (inquiry-operator-trivialdefault X)))
      (comments             (if ls (strip-ml (inquiry-operator-comments x) ls)
			      (inquiry-operator-comments x)))
      (editor               (if ls (strip-ml (inquiry-operator-editor x) ls)
			      (inquiry-operator-editor x)))
      (date                 (if ls (strip-ml (inquiry-operator-date x) ls)
			      (inquiry-operator-date x)))
      (activedefault        (if *rigidly-monolingual*
				(second (inquiry-operator-activedefault X))
			      (if ls (strip-ml 
				      (inquiry-operator-activedefault X) ls)
				(inquiry-operator-activedefault X))))
      (LS-set               (inquiry-operator-LS-set x))   
      )
))

;--------------------------------------------------------------------------------------------------
; SYNTAX: replace-inquiry-info (inquiry-name, field-name, new-value, &optional ls)
; RETURN: the replaced value of the specified field in the inquiry; the field of the inquiry record
;         is changed to new value;
; TARGET: as indicated;
; ASSUME: due to the complexity of modifying LX expression, we assume that new-value is a LX. Hence
;         ls does not play any role. We simply replace the field with the whole new-value. This func
;         will not create new inquiry when the given inquiry name is not found in the database;
; GLOBAL: ALL_LANGUAGES; quiry-operators;
; SYMBOL: X = an instance from inquiry DB;
; PSEUDO: if inquiry-name not in inquirys, then return nil else X is instantiated; 
;         according to field-name, return(replace (inquiry-field-name X) with the new-value);
;--------------------------------------------------------------------------------------------------

(defun replace-inquiry-info (inquiry-name fld-name new-value &optional ls)
  (declare (ignore ls))
  (let ((x (gethash inquiry-name quiry-operators)))
    (unless x (return-from replace-inquiry-info nil))
    (case fld-name
           ((everything instance)        (setf (gethash inquiry-name quiry-operators) new-value))
	   (name                         (setf (inquiry-operator-name x) new-value))
           (domain                       (setf (inquiry-operator-domain x) new-value))
           (mode                         (setf (inquiry-operator-mode x) new-value))
           (parameters                   (setf (inquiry-operator-parameters x) new-value))
           (english                      (setf (inquiry-operator-english x) new-value))
           (operatorcode                 (setf (inquiry-operator-operatorcode x) new-value))
	   (patch-status   (setf (inquiry-operator-patch-status x) new-value))
           (parameterassociationtypes    (setf (inquiry-operator-parameterassociationtypes x) new-value))
	   (answerset                    (setf (inquiry-operator-answerset x) new-value))
           (preselectionguidance         (setf (inquiry-operator-preselectionguidance x) new-value))
           (createdassociationtype       (setf (inquiry-operator-createdassociationtype x) new-value))
           (trivialdefault               (setf (inquiry-operator-trivialdefault x) new-value))
           (comments                     (setf (inquiry-operator-comments x) new-value))
           (editor                       (setf (inquiry-operator-editor x) new-value))
           (date                         (setf (inquiry-operator-date x) new-value))
	   (activedefault                (setf (inquiry-operator-activedefault x) new-value))
           (LS-set nil                   (setf (inquiry-operator-LS-set x) new-value))  
      )
))


(defsetf fetch-inquiry-info (inquiry-name fld-name &optional LS) (new-value) 
  `(replace-inquiry-info ,inquiry-name ,fld-name ,new-value ,LS) )


;;; ----------------------------------------------------------------------
;;; Loading...

(defun LOAD-ML-INQUIRY (body)
  (let ((seed-instance (apply #'make-inquiry-operator body)))

    ;; 0.7.29 fix combination of defaults and explicit conditionalizations.
    (when (symbolp (inquiry-operator-name seed-instance))
	  (setf (inquiry-operator-name seed-instance)
		(append 
		 (cond 
		  ((and *in-ml-region* *current-default-languages*)
		   (check-language-availability *current-default-languages*)
		   *current-default-languages*)
		  (t  all_languages))
		 (cons (inquiry-operator-name seed-instance) nil))))

    ;; 0.9 add in correct patch status... 
    (setf (inquiry-operator-patch-status seed-instance)
      (append (extract-lg-specifiers (inquiry-operator-name seed-instance))
	      (cons *patch-status* nil)))
    ;; 1.0
    (when *patch-status* (setf *patches-exist* T))

    (setf (inquiry-operator-preselectionguidance seed-instance) 
	  (precompile-preselection-guide 
	   (inquiry-operator-preselectionguidance seed-instance)))
    ;; 1.0
    (register-inquiry-implementation-functions 
     (inquiry-operator-operatorcode seed-instance))
    ;; 3.2.6 -- warn if trivialdefaultcode gets no trivialdefault
    (check-trivialdefault-given seed-instance)
    (setf (inquiry-operator-english seed-instance)
	  (splice-consecutive-strings
	   (inquiry-operator-english seed-instance)))

    (let ((NameLst (get-atom-ls (inquiry-operator-name seed-instance)))
	  instance)
      (loop for name in NameLst do
	   (setf instance 
		 (merge-new-and-old-inquiry 
		  name seed-instance 
		  (if (and *in-ml-region* *current-default-languages*)
		      *current-default-languages*
		    (cdr name))))
;   register inquiry entries
	   (setf (inquiry-operator-LS-set instance) 
		 (union (cdr name) (inquiry-operator-LS-set instance)))
	   (setf (inquiry-operator-name instance) 
		 (append (inquiry-operator-LS-set instance)
			 (list (car name))))
	   (setf (gethash (car name) quiry-operators) 
		 (copy-inquiry-operator instance))
	   (pushnew (car name) inquiry-operators))
      )
    (setf *inquiries-updated?* all_languages)))


(defun PRECOMPILE-PRESELECTION-GUIDE (src-preselection-guidance)    
    (loop for element in src-preselection-guidance collect 
	 (if (consp element)
	     (Let ((Guide (make-preselection-guide)))
		  (SETF (preselection-guide-selection guide) (car element))
		  (SETF (preselection-guide-answer guide) (cdr element))
		  Guide)
	   element)))

;;; 0.8.20
;;; Somewhere a space was being dropped before parameters
;;; to inquiries; make sure some space gets put in...
;;; 0.9
;;; make sure we get rid of pesky newlines in those inquiry
;;; glosses...

(defun SPLICE-CONSECUTIVE-STRINGS (gloss-list)
  (let ((result nil)
	(interim ""))
    (loop for item in gloss-list
	  do
	  (typecase item
		    (symbol 
		     (unless (string= interim "")
			     (push (concatenate 'string interim " ") result))
		     (setf interim "")
		     (push item result))
		    (string
		     (setf interim 
		       (substitute #\space #\newline
				   (concatenate 'string interim " " item)))))
	  finally
	  (unless (string= interim "")(push interim result)))
    (reverse result)))



;;; All functions mentioned as functions in the value of the operator
;;; code slots of evaluated inquiries are entered on the list
;;; of inquiry implementation functions. Deleting an inquiry should
;;; be the only way of removing something from this list.

(defun REGISTER-INQUIRY-IMPLEMENTATION-FUNCTIONS (opcode-slot)
  (etypecase opcode-slot
    (symbol (setf (gethash opcode-slot *inquiry-implementation-functions*) T))
    (cons
     (loop for x in opcode-slot
	 unless (or (keywordp x)(eq x *knot*))
	 do (setf (gethash x *inquiry-implementation-functions*) T)))))

(defun INQUIRY-IMPLEMENTATION-P (symbol)
  (gethash symbol *inquiry-implementation-functions*))

;;; ----------------------------------------------------------------------
;;; Removing...

(defun DELETE-INQUIRY (inquiry-name)
  (remhash inquiry-name quiry-operators)
  (remove inquiry-name inquiry-operators))


;;; Replaces old Penman function: delete-all-inquiry-operators.
;;;
(defun ERASE-INQUIRIES ()
  (setq inquiry-operators nil)
  (clrhash quiry-operators))


;;; ----------------------------------------------------------------------
;;; Utilities...
;;;

  ;;
  ;; KPML4 book-keeping and overview statistics...
  ;;
(defun INQUIRY->METAFUNCTION (inquiry)
  (let* ((choosers 
	  (append (who-can-ask inquiry)
		  (who-can-pose-identifying-inquiry inquiry)))
	 (systems
	  (loop for system in (list-systems)
		when (member (kpml::fetch-system-chooser system) choosers)
		collect system))
	 (mfs
	  (loop for s in systems
		collect (fetch-system-metafunction s))))
    (remove-duplicates mfs)))


(defun INQUIRY-METAFUNCTION-SPREAD (inquiries)
  (let ((c (make-hash-table :test #'equal))
	(metafunctions '(nil ideational experiential blend interpersonal textual logical )))
    (loop for mf in metafunctions
	  do (setf (gethash mf c) 0))
    (loop for i in inquiries do 
	  (loop for m in (inquiry->metafunction i)
		when (gethash m c)
		do (setf (gethash m c) (1+ (gethash m c)))))
    (loop for mf in metafunctions
	  do (format t "~% ~A : ~A" mf (gethash mf c)))))

;;;-----------------------------------------------------------------------
;;; The following functions make use of "fetch-inquiry-info" 
;;; accessing interface, and may be a bit
;;; slower than if using direct "gethash(X quiry-operators)" method, 
;;; but offers a clear strategy
;;;-----------------------------------------------------------------------

(DEFUN set-inquiry-mode (inquiries mode)
  (cond ((null inquiries)
	 (maphash #'(lambda (key val)
		      key
		      (setf (fetch-inquiry-info key 'mode) mode))
		  quiry-operators))
	((atom inquiries)
	 (cond ((gethash inquiries quiry-operators)
		(setf (fetch-inquiry-info inquiries 'mode) mode))
	       (t (printwindow :display-pane (format nil  "~a is not a defined inquiry" inquiries )))))
	(t
	 (loop for I in inquiries
	       if (gethash I quiry-operators)
	        do (setf (fetch-inquiry-info I 'mode) mode)
	       else 
	        do (printwindow 
		    :display-pane 
		    (format nil  "~a is not a defined inquiry" i)))))
  t)


(DEFUN deimplement-queries-with-operator-code ()
  (maphash #'(lambda (key val)
	       key
	       (cond ((fetch-inquiry-info val 'operatorcode)
		      (setf (fetch-inquiry-info val 'mode) nil))))
	   quiry-operators)
  t)

(DEFUN implement-queries-with-trivialdefaultcode ()
  (maphash #'(lambda (key val)
	       key
	       (cond ((equal (fetch-inquiry-info val 'operatorcode) 'trivialdefaultcode)
		      (setf (fetch-inquiry-info val 'mode) 'implemented))))
	   quiry-operators)
  t)


(defun implement-queries-with-operatorcode ()
  (set-inquiry-mode-implemented
    (loop for op in inquiry-operators
	  when (fetch-inquiry-info op 'operatorcode)
	  collect op ))
  t)


;;; ----------------------------------------------------------------------
;;; Added at 3.2.6
;;; 4.0   more warnings.

(defun CHECK-TRIVIALDEFAULT-GIVEN (seed-instance)
  (let ((opcode-slot  (inquiry-operator-operatorcode seed-instance))
	(trivdef-slot (inquiry-operator-trivialdefault seed-instance))
	(answer-set   (inquiry-operator-answerset seed-instance))
	(warn nil))
    (etypecase 
     opcode-slot
     (symbol (if (and (equal opcode-slot 'trivialdefaultcode)
		      (not trivdef-slot))
		 (setf warn T)))
     (cons
      (if (and (member 'trivialdefaultcode
		       (loop for x in opcode-slot
			     unless (or (keywordp x)(eq x *knot*))
			     collect x))
	       (not trivdef-slot))
	  (setf warn T))))
    (when warn
      (warning "Inquiry: "
	       (inquiry-operator-name seed-instance)
	       " specified trivialdefaultcode as operator "
	       " but does not give a trivial default. Beware!!!"))
    ;;
    ;; 4.0 -- this is also worth a warning...
    ;;
    (when trivdef-slot
      (unless (inquiry-operator-createdassociationtype seed-instance)
	(unless (member trivdef-slot answer-set)
	  (warning "Inquiry: "
		   (inquiry-operator-name seed-instance)
		   " specifies as trivialdefault " trivdef-slot
		   " but this is not a member of the answer set " answer-set
		   ". Because this will cause SPL-specified inquiry "
		   " responses to fail, this is being overridden by "
		   (first answer-set) " here! Beware!!")
	  (setf (inquiry-operator-trivialdefault seed-instance) 
		(first answer-set)))))))


;;; ----------------------------------------------------------------------
;;; Additional utility, used in the window interface, although
;;; something like it should already exist somewhere I would have
;;; thought...

(defun INQUIRIES-OF-CHOOSER (ch)
  (let* ((q-inquiries 
	  (mapcar #'first (fetch-chooser-db-elt 'asks ch)))
	 (id-inquiries 
	  (mapcar #'caadr 
		  (fetch-chooser-db-elt 'identifies ch))))
    (remove-duplicates (append q-inquiries id-inquiries))))

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

(defun MERGE-NEW-AND-OLD-INQUIRY (name-para new-instance new-languages)
  (setf (inquiry-operator-ls-set new-instance) new-languages)
  (when *show-loading-actions*
	       (format t "~%Loading inquiry:  ~A" name-para))
  (cond ((and *merging-active*
	      (gethash (first name-para) quiry-operators))
	 (let* ((name (first name-para))
		(old-instance (gethash name quiry-operators))
		(old-languages (remove name (inquiry-operator-name old-instance)))
		(merged-instance nil)
		(old-lg-instance-pairs 
		 (create-set-of-mono-lingual-instances name :inquiry))
		(new-lg-instance-pairs
		 (create-set-of-mono-lingual-instances new-instance :inquiry)))

	   (when *show-loading-actions*
		 (format t "~%...merging; old languages: ~A; new languages: ~A" 
		   old-languages new-languages))

	   (cond ((equal new-languages old-languages)
		  (when (member :inquiries *show-merging-actions*)
			(format t "~%Inquiry ~A multiply defined, new definition wins."
				name))
		  new-instance)
		 ((intersection new-languages old-languages)
		  (when (member :inquiries *show-merging-actions*)
			(format t "~%Merging for inquiry ~A; shared languages" name))
		  (merge-overlapping-inquiry-instances
		   name old-lg-instance-pairs new-lg-instance-pairs))

		 (t
		  (when (member :inquiries *show-merging-actions*)
			(format t 
                                "~%Merging for inquiry ~A; disjunctive languages" name))
		  (delete-inquiry name)
		  (setf merged-instance 
			(apply #'merge-inquiry-instances 
			       (list
				(append old-lg-instance-pairs 
				        new-lg-instance-pairs))))

		  (when (and *step-by-step-merging-behavior*
			     (member :inquiries *show-merging-actions*))
			(format t 
				"~%***Merged: old instance: ~%     ~A~%~
  ***new instance: ~A~%  ***and merged:~A~%" old-instance new-instance merged-instance))
		  merged-instance))))
	(t
	 (let* ((inquiry-name (first name-para))
		(old-instance (gethash inquiry-name quiry-operators)))
	   (when old-instance
		 (unless (subsetp (inquiry-operator-ls-set old-instance) 
				  (cdr name-para))
			 (warning "Previously existing inquiry: " 
				  inquiry-name
				  " is being overwritten by a definition with narrower language coverage: " (cdr name-para) " instead of " 
				  (inquiry-operator-ls-set old-instance) "."))
		 (delete-inquiry inquiry-name)))
	 (return-from merge-new-and-old-inquiry new-instance))))




;;; See definition for systems above...

(defun MERGE-OVERLAPPING-INQUIRY-INSTANCES
  (name old-lg-instance-pairs new-lg-instance-pairs)
  
  (let ((merged-instance nil))
    (delete-inquiry name)
    (setf merged-instance 
	  (apply #'merge-inquiry-instances 
		 (list (replace-keyed-elements
			old-lg-instance-pairs 
			new-lg-instance-pairs))))
    
    (when (and *step-by-step-merging-behavior*
	       (member :inquiries *show-merging-actions*))
	  (format t 
		  "~%***Merged: old language instance pairs: ~%     ~S~%~
  ***new language instance pairs: ~S~%  ***and merged instance:~A~%" old-lg-instance-pairs new-lg-instance-pairs merged-instance))
    merged-instance))


(defun MERGE-INQUIRY-INSTANCES (list-of-lg-instance-pairs)
  (let ((instance   (generalized-merge-instance
		     list-of-lg-instance-pairs
		     '(inquiry-operator-name 
                       inquiry-operator-domain
		       inquiry-operator-parameters
		       inquiry-operator-english 
		       inquiry-operator-operatorcode
		       inquiry-operator-parameterassociationtypes
		       inquiry-operator-answerset 
		       inquiry-operator-preselectionguidance
		       inquiry-operator-createdassociationtype
		       inquiry-operator-trivialdefault
		       inquiry-operator-comments 
		       inquiry-operator-patch-status
		       inquiry-operator-editor
		       inquiry-operator-date)
		     #'make-inquiry-operator)))
    (setf (inquiry-operator-ls-set instance)
	  (mapcar #'first list-of-lg-instance-pairs))
    instance))

;;; ----------------------------------------------------------------------
;;; List conversions...

(defun INQUIRY-TO-LIST-MULTI-TO-MONO (inquiry &optional (language-variety curlan))
  (cond ((inquiry-defined-for-lg-p inquiry language-variety)
	 (list 
	  (if (branching-inquiry-p inquiry) 'askoperator 'identifyoperator)
	  :name inquiry 
	  :domain (fetch-inquiry-info inquiry 'DOMAIN language-variety)
	  :parameters (fetch-inquiry-info inquiry 'PARAMETERS language-variety)
	  :english (fetch-inquiry-info inquiry 'ENGLISH  language-variety)
	  :operatorcode (fetch-inquiry-info inquiry 'OPERATORCODE language-variety)
	  :parameterassociationtypes
	  (fetch-inquiry-info inquiry 'PARAMETERASSOCIATIONTYPES language-variety)
	  :answerset (fetch-inquiry-info inquiry 'ANSWERSET  language-variety)
	  :preselectionguidance
	  (fetch-inquiry-info inquiry 'PRESELECTIONGUIDANCE language-variety)
	  :createdassociationtype
	  (fetch-inquiry-info inquiry 'CREATEDASSOCIATIONTYPE language-variety)
	  :patch-status
	  (fetch-inquiry-info inquiry 'patch-status language-variety)
	  :trivialdefault 
	  (fetch-inquiry-info inquiry 'TRIVIALDEFAULT language-variety)
	  :comments (fetch-inquiry-info inquiry 'COMMENTS  language-variety)
	  :editor (fetch-inquiry-info inquiry 'EDITOR language-variety)
	  :date (fetch-inquiry-info inquiry 'DATE language-variety)))
	(t nil)))

(defun INQUIRY-TO-LIST-MULTI-TO-MULTI (inquiry-name)
  (inquiry-instance-to-list-multi-to-multi 
   (gethash inquiry-name quiry-operators)))

(defun INQUIRY-INSTANCE-TO-LIST-MULTI-TO-MULTI (inquiry)
  (list 
   (if (inquiry-operator-answerset inquiry) 'askoperator 'identifyoperator)
   :name (inquiry-operator-NAME inquiry)
   :domain (inquiry-operator-DOMAIN inquiry)
   :mode (inquiry-operator-MODE  inquiry)
   :parameters (inquiry-operator-PARAMETERS inquiry)
   :english (inquiry-operator-ENGLISH  inquiry)
   :operatorcode (inquiry-operator-OPERATORCODE inquiry)
   :patch-status (inquiry-operator-patch-status inquiry)
   :parameterassociationtypes (inquiry-operator-PARAMETERASSOCIATIONTYPES inquiry)
   :answerset (inquiry-operator-ANSWERSET  inquiry)
   :preselectionguidance (inquiry-operator-PRESELECTIONGUIDANCE inquiry)
   :createdassociationtype (inquiry-operator-CREATEDASSOCIATIONTYPE inquiry)
   :trivialdefault (inquiry-operator-TRIVIALDEFAULT inquiry)
   :comments (inquiry-operator-COMMENTS  inquiry)
   :editor (inquiry-operator-EDITOR inquiry)
   :date (inquiry-operator-DATE inquiry)))

(defun INQUIRY-INSTANCE-TO-LIST-MULTI-TO-MONO 
  (inquiry &optional (language-variety curlan))
  (let ((inquiry-name (strip-ml (inquiry-operator-name inquiry) language-variety)))
    (list
     (if (branching-inquiry-p inquiry-name) 'askoperator 'identifyoperator)
     :name inquiry-name
     :domain 
     (strip-lx (parse-clause (inquiry-operator-DOMAIN inquiry) language-variety))
     :mode 
     (strip-lx (parse-clause (inquiry-operator-MODE  inquiry) language-variety))
     :parameters 
     (strip-lx (parse-clause (inquiry-operator-PARAMETERS inquiry) language-variety))
     :english 
     (strip-lx (parse-clause (inquiry-operator-ENGLISH  inquiry) language-variety))
     :operatorcode
     (strip-ml (inquiry-operator-OPERATORCODE inquiry) language-variety)
     :patch-status
     (strip-ml (inquiry-operator-patch-status inquiry) language-variety)
     :parameterassociationtypes 
     (strip-lx (parse-clause (inquiry-operator-PARAMETERASSOCIATIONTYPES inquiry) 
			      language-variety))
     :answerset 
     (strip-lx (parse-clause (inquiry-operator-ANSWERSET  inquiry) language-variety))
     :preselectionguidance 
     (strip-lx (parse-clause (inquiry-operator-PRESELECTIONGUIDANCE inquiry) 
			      language-variety))
     :createdassociationtype 
     (strip-lx (parse-clause (inquiry-operator-CREATEDASSOCIATIONTYPE inquiry) 
			      language-variety))
     :trivialdefault 
     (strip-lx (parse-clause (inquiry-operator-TRIVIALDEFAULT inquiry) 
			      language-variety))
     :comments 
     (strip-lx (parse-clause (inquiry-operator-COMMENTS  inquiry) language-variety))
     :editor 
     (strip-lx (parse-clause (inquiry-operator-EDITOR inquiry) language-variety))
     :date (strip-lx (parse-clause (inquiry-operator-DATE inquiry) language-variety)))))

