(in-package "KPML")

;;; File: conversions.lisp

;;;===========================================================================
;;;
;;; Misc. conversion functions for changing from older resource sets
;;; to resource sets compatible with current requirements.
;;;
;;;==========================================================================

;;;
;;; Lexical Features
;;; ----------------

;;; Lexical features used to be a completely distinct symbol set.
;;; This is no longer guaranteed, since there are moves towards
;;; systemicized word class hierarchies. 

;;; To use, load a version of the grammar and lexicon, set the
;;; variable *classify-feature-conversion-list* to the conversions
;;; required (an example is given below), run the the function
;;; (remove-classify-feature-clashes), and then write out the
;;; resources (including both grammar and loaded lexicon).

(defvar *classify-feature-conversion-list* nil)

(setf *classify-feature-conversion-list*
      '(
	;;    conversions come here as dotted pairs such as the following,
	;;    which take an ISI Penman93/4 Nigel release up to a KPML
	;;    compatible set of resources with nonclashing classify 
	;;    and lexical features...
	
	(VOLITION . volition-aux) 
	(HAVEAUX . have-aux)
	(NOT-ABILITY . not-ability-aux)
	(POSSIBILITY . possibility-aux)
	(NECESSITY . necessity-aux)
	(MODALAUXILIARY . modal-aux)
	(ABILITY . ability-aux)
	(FUTUREAUXILIARY . future-aux)
	(VERB . verb)
	(BEAUX . be-aux)
	(SORT . sort-noun)
	(TYPE . type-noun)
	(CLASS . class-noun)
	(CATEGORY . category-noun)
	(POSSESSION . possesion-verb)
	(COST . cost-verb)
	(WEIGHT . weight-verb)
	(MEASURE . measure-verb)
	(LAST . last-verb)
	(COVER . cover-verb)
	(NUMBERING . numbering-verb)
	(MATTER . matter-verb)
	(MANNER . manner-verb)
	(LOCATION . location-verb)
	(RELATIONALBE . relational-be-verb)
	(EXTENT . extent-verb)
	(EQUALITY . equality-verb)
	(SIGNIFICATION . signification-verb)
	(SYMBOL . symbol-verb)
	(CIRCUMSTANTION . circumstantion-verb)
	(CAUSE . cause-verb)
	(INTENSION . intension-verb)
	(SENSATION . sensation-verb)
	(ACCOMPANIMENT . accompaniment-verb)
	(ROLE . role-verb) 
	(PREPOSITION-word . preposition)
	(REASON . reason-prep)
	(PROCESSNEGATIVE . processnegative)
	(MODALITYNEGATIVE . modalitynegative)
	(CONDITIONALITY . conditionality-aux)
	(NOMINALIZATION . nominalization-noun)
	(PHASE . phase-verb)
	(PERCEPTION . perception-verb)
	(REACTION . reaction-verb)
	(COGNITION . cognition-verb)
	(LIKE . like-verb)
	(DISLIKE . dislike-verb)
	(FEAR . fear-verb)
	(DOVERB . do-verb)
	(EXPERIENCEVERB . experience-verb)
	(SYMBOLICVERB . symbolic-verb)
	(RELATIONAL . relational-verb)
	(VISUAL . visual-verb)
	(AUDITORY . auditory-verb)
	(TACTILE . tactile-verb)
	(GUSTATORY . gustatory-verb)
	(OLFACTORY . olfactory-verb)
	(METEOROLOGY . meteorology-verb)
	(CREATION . creation-verb)
	(DISPOSAL . disposal-verb)
	(OPINING . opining-verb)
	(EPISTEMIC . epistemic-verb)
	(MNEMONIC . mnemonic-verb)
	(APPEARANCE . appearance-verb)
	(MIDDLE . middle-verb)
	(EFFECTIVE . effective-verb)
	(NEGATIVE . negative-aux)
	(GREETING . greeting)
	(INTERJECTION . interjection)
	(DOAUX . do-aux)
	(COMMON . common-noun)
	(DEGREE . degree-adj)
	(PROPERNOUN . proper-noun)
	(UNCOUNTABLE-noun-word . uncountable-noun)
	(COUNTABLE-noun-word . countable-noun)
	(NOUN . noun)
	(EXISTENTIAL . existential-verb)
	(ADVERB . adverb)
	(ATTITUDINALADVERB . attitudinal-adverb)
	(LINKER . linker)
	(ADJECTIVE . adjective)
	))


;;; 0.8.13 addition of outclassifies and further checks here.

(defun REMOVE-CLASSIFY-FEATURE-CLASHES ()
  (remove-classify-feature-clashes-in-grammar)
  (remove-classify-feature-clashes-in-lexicon)
  (format t "~%Conversion completed: BEWARE! internal data structures
now in inconsistent state,  save resources and reload before use!~%")
  )

(defun REMOVE-CLASSIFY-FEATURE-CLASHES-IN-GRAMMAR ()
  (let ((who-can-classify 
	 (append (who-can-classify)
		 (who-can-out-classify))))
    (format t "~%Updating classify features used in grammatical systems...")
    (when (check-new-lexical-feature-uniqueness)
	  (return-from remove-classify-feature-clashes-in-grammar nil))
    (loop for classifying-system in who-can-classify
	  do
	  (let* ((sys-def 
		  (gethash (first classifying-system) system-table))
		 (outputs (system-outputs sys-def)))
	    (format t "c")
	    (setf (system-outputs sys-def)
		  (mapcar 
		   #'(lambda (feature-def)
		       (if (cddr feature-def)
			   (append 
			    (list (first feature-def)
				  (second feature-def))
			    (classify-convert
			     (cddr feature-def)))
			 (list (first feature-def)
			       (second feature-def))))
		  outputs))))))


(defun REMOVE-CLASSIFY-FEATURE-CLASHES-IN-LEXICON ()
  (format t "~%Updating classify features used in lexical entries...")
  (maphash #'(lambda (key value)
	       (declare (ignore key))
	       (format t "c")
	       (setf (lexical-item-features value)
		 (loop for feature in (lexical-item-features value)
		     collect
		       (let ((c (assoc feature 
				       *classify-feature-conversion-list*)))
			 (if c
			     (cdr c)
			   feature)))))
	   lexicon))



;;; 



(defun CLASSIFY-CONVERT (realization-list)
  (mapcar #'(lambda (realization)
	      (cond ((or (eq (first realization) 'classify)
			 (eq (first realization) 'outclassify))
		     (append
		      (list
		       (first realization)
		       (second realization))
		      (loop for r in (cddr realization)
			    collect
			    (let ((c (assoc 
				      r 
				      *classify-feature-conversion-list*)
				     ))
			      (if c
				  (cdr c)
				r)))))
		    (t
		     realization)))
	  realization-list))


;;; Following additional check reports if the conversion introduces
;;; any new potential ambiguities in the lexical and grammatical
;;; features...

(defun CHECK-NEW-LEXICAL-FEATURE-UNIQUENESS ()
  (let ((new-ambiguities nil))
    (loop for lex-feature in *classify-feature-conversion-list*
	  when (who-has-as-output (cdr lex-feature))
	  do (pushnew (cdr lex-feature) new-ambiguities))
    (cond (new-ambiguities
	   (format t "~%Following new lexical features would reintroduce ambiguities: ~%~S~%" new-ambiguities)
	   (y-or-n-p "Break conversion?"))
	  (t nil))))
				   

(defun CHECK-LEXICAL-FEATURE-UNIQUENESS ()
  (let ((overlaps nil)
	(who-can-classify 
	 (append (who-can-classify)
		 (who-can-out-classify))))
    (format t "~%;;; Survey of lexical and grammatical feature overlaps:")
    (loop for classifying-systems in who-can-classify ;; 1.1 bug.
	  do 
	  (loop for realization in (second classifying-systems)
		when (who-has-as-output (third realization))
		do (pushnew (third realization) overlaps)))
    (format t "~%;;; ... following are both lexical and grammatical: ~S~%"
	    overlaps)))


