;;;		-*- Mode:LISP; Package: DYPAR; Base: 10; -*-

;;;		  LastEditDate =  13:68:19  We, 05-Sep-89  -- Jesus Boti

;;; ---------------------------------------------------------------------------
;;;
;;;                 (c) Copyright, 1989,
;;;                         by Juan Carlos Due¤as Lopez
;;;                         and Jesus Gonzalez Boticario
;;;                         para Rank Xerox Espa¤ola S.A.
;;;                         All rights reserved
;;;
;;; ---------------------------------------------------------------------------

;;; ELIPSIS.LSP

;;;
;;; Contenido:  funci˘n LISP que ejecuta el volcado
;;; de variables de un resultado a otro.
;;; Funciones de an fora, elipsis y
;;; carga de variables necesarias. 	

; HISTORIA
;
; 05-Sep-89 Jesus Gonzalez Boticario para Rank Xerox, Espa¤a
;    Eliminacion de la funcion "sacar-errores" y creacion en su lugar
;   de la funcion "mostrar-elipsis-anafora".
;    Eliminacion de la funcion "activate-elip-anaf" y en su lugar creacion
;   de la funcion "comprobar-elip-anafora" llamada desde "loadgrammar" cada
;   vez que aparece la definicion de una regla de alto nivel.
;    Eliminacion de la variable *reglas-errores* ya que ahora los errores
;   se corrigen en cuanto aparecen.
;    Modificacion de la funcion "corregir-errores" para que solo afecte a 
;   una regla (la que la funcion recibe como argumento).
;    Inclusion de la nueva funcion "inicio-elip-anaf" para reinicializar los
;   valores de las varibles de elipsis y de anafora.
;
; 31-Ago-89 Jesus Gonzalez Boticario para Rank Xerox, Espana
;    Eliminacion del corte en la ejecucion de la funcion 
;   activate-elipsis-anafora para este caso.
;    Creacion de la funcion "corregir-errores" para permitir soslayar
;   los fallos encontrados en las reglas de elipsis y de anafora. 
;
; 30-Ago-89 Jesus Gonzalez Boticario para Rank Xerox, Espana
;   modificacion de la funcion activate-elip-anaf para que
;   solo salgan los mensajes de las reglas de elipsis y anafora
;   en el caso de que las variables que las contienen tengan un
;   valor distinto de NIL
;   
;   Eliminacion de la inicializacion a NIL de las variables *elipsis-rules*
;   y *anafora-rules* de la funcion "activate-elip-anaf" para asi poder
;   guardar todas las reglas de este tipo que aparezcan en la carga 
;   de todos los ficheros que compongan una gramatica, ya que dicha funcion
;   se llama desde "loadgrammar".
 


(in-package "DYPAR"); :use '("LISP" "USER" "GCLISP"))


(proclaim '(special *dypar-previous* *elipsis-rules* *anafora-rules*))


;; inicializacion de las variables que contendran respectivamente
;; las reglas de elipsis y de anafora encontradas en los diferentes ficheros
;; de la gramatica.
(defvar *elipsis-rules* nil)
(defvar *anafora-rules* nil)

;;; funcion para reinicializar las variables de elipsis y de anafora.
(defun  inicio-elip-anafora ()
  (setq *elipsis-rules* nil)
  (setq *anafora-rules* nil))

;;; La siguiente funcion sirve para mostrar al usuario cuales son las reglas
;;; erroneas definidas simultaneamente como de elipsis y de anafora, ademas
;;; se encarga de pedir la correccion de las mismas al usuario.
(defun corregir-errores (regla-vieja)
  (let ((regla-nueva))
    (format t "~2& Las siguiente regla continen en su nombre la palabra ~
	    ~% ELIPSIS y la palabra ANAFORA. Eliminar alguna de estas. ~%")
    (format t "~% Vieja: ~S ~% Nueva: " regla-vieja) 
    (setq regla-nueva  (read))
    (format t "~% Recuerde que tambien tiene que modificar este nombre ~
	    en los ficheros ~% en que aparezca ")
    (format t "~% !!! Pulse cualquier tecla para continuar !!!~&" )
    (read-char)
    regla-nueva))
		     
;;;	quitar lista-de-variables lista-origen.
;;;		quita los pares var,val cuya var aparezca
;;;		en lista-de-variables de lista-origen.
;;;		Entrada: (var1 var2 ...)
;;;			 (regla (var1 val1) (var2 val2) (var3 val3)...)
;;;		Resultado: (regla (var3 val3) ...)
;;;

(defun quitar (lista-var lista-origen)
	(reverse (noassoc lista-var lista-origen)))		    
		    
		    
;;;	elipsis lista-fuente lista-destino.
;;;		pasa todos los pares var,val de las lista fuente
;;;		a la lista destino, eliminando los pares de esta
;;;		en que previamente apareciera var.
;;;		Entrada: (regla-nueva (var1 val1) (var2 val2) ...)
;;;			 (regla-vieja (var2 val4) (var7 val7) ...)
;;;		Resultado: (regla-vieja (var2 val2) (var1 val1)
;;;				(var7 val7) ...)
;;;

(defun elipsis (lista-origen lista-destino)
	(dolist (elemento (cdr lista-origen) lista-destino)
		(and (assoc (car elemento) (cdr lista-destino))
		     (setf lista-destino (quitar (list (car elemento)) 
		     				lista-destino)))
		(setf lista-destino (append (list (car lista-destino)
					          elemento)
					    (cdr lista-destino))))) 
     			     					

;;;	anafora lista-fuente lista-destino.
;;;		pasa todos los pares var,val de las lista fuente
;;;		a la lista destino, excepto aquellos cuya var
;;;		aparezca en lista destino.
;;;		Entrada: (regla-vieja (var1 val1) (var2 val2) ...)
;;;			 (regla-nueva (var2 val4) (var7 val7) ...)
;;;		Resultado: (regla-nueva (var1 val1)
;;;				(var7 val7) (var2 val4)...)
;;;

(defun anafora (lista-origen lista-destino)
  	(setf lista-destino 
	      (append (list (car lista-destino))
			    (cdr (elipsis lista-destino lista-origen)))))




;;; funcion llamada por "applyrule1" en XPAR.LSP para aplicar la elipsis
;;; y la anafora a aquellas reglas que le corresponda.

(defun elip-anaf (regla-bindings)
  (let ((regla (car regla-bindings)))
    (if (member regla *elipsis-rules*) ;modificaciones
	(setf regla-bindings (elipsis regla-bindings *dypar-previous*))) 
    (if (member regla *anafora-rules*) ;modif
	(setf regla-bindings (anafora *dypar-previous* regla-bindings))) 
    (setq *dypar-previous* regla-bindings))) 



;;;  mostrar-elipsis-anafora.
;;;  muestra el resultado de haber tenido en cuenta la elipsis y la 

(defun mostrar-elipsis-anafora ()
  ;; una vez asignadas durante el proceso de carga de la gramatica
  ;; las reglas de elipsis y de anafora a las variables *elipsis-rules*
  ;; y *anafora-rules* se muestra el contenido de dichas variables
  (and *elipsis-rules*
       (format t "~%~% Reglas de alto nivel con elipsis:~
	       ~% ~S ~&" *elipsis-rules*))
  (and *anafora-rules*
       (format t "~%~% Reglas de alto nivel con anafora: ~
	       ~% ~S ~&" *anafora-rules*))
  (values))


;;; funcion llamada en XLOAD.LSP (en "loadgrammar") para comprobar que tipo
;;; de regla es la que en ese momento se este cargando. Lo importante es 
;;; determinar si la regla es de elipsis de anafora o bien es erronea, en
;;; cuyo caso se pide la correccion del nombre de la misma.
(defun comprobar-elip-anafora (nombre-regla)
  (cond ((and (search "ELIPSIS" (string-upcase nombre-regla))
	      (search "ANAFORA" (string-upcase nombre-regla)))
	 ; (return (format t 
	 ; "~A pertenece a elipsis y anafora. Error" nombre-regla)))
	 (comprobar-elip-anafora
	   (corregir-errores nombre-regla)))
	((search "ELIPSIS" (string-upcase nombre-regla))
	 (and (setf *elipsis-rules* 
		    (cons nombre-regla *elipsis-rules*))
	      nombre-regla))
	((search "ANAFORA" (string-upcase nombre-regla))
	 (and (setf *anafora-rules* 
		    (cons nombre-regla *anafora-rules*))
	      nombre-regla))
	(t nombre-regla)))

(defvar *elipsis-loaded* t)