;*********************************************************************
; Módulo: IERL
; Uso:    IAAA Experimental Representation Language
; Autor:  Roberto Sobreviela Ruiz
; email:  419245@cepsz.unizar.es
;         sobreviela@teleline.es
;*********************************************************************
; Fichero: IERL Forward.lsp Fecha Creación: 20 de diciembre de 1999
; Versión: 0.0.2          Fecha Modificación: 12 de enero del 2000
; Estado:  Desarrollo     Autor: Roberto Sobreviela Ruiz
;---------------------------------------------------------------------
; Uso: Extensión del lenguaje IERL.
; Comentarios:
;    Motor de inferencia mediante encadenamiento progresivo según la 
;   propuesta de Patrick Henry Winston [Lisp, Winston & Horn 3th ed].
; Historia:
;   Versión 0.0.1:  Implementación de las funciones del motor de
;       inferencia.
;   Version 0.0.2:  Extension para manejo de frames en las reglas.
;*********************************************************************
    
;; Funciones del motor de inferencia de encadenamiento progresivo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun FC-filtra-flujo-de-ligaduras (patron flujo)
    (concatena-flujo
        (transforma-flujo
            #'(lambda (ligaduras)
                    (corresponde-patron-con-afirmaciones patron ligaduras))
            flujo)))

;;; Extension para la version 0.0.2:
;;; 
(defun FC-filtra-flujo-de-ligaduras-frames (patron flujo)
    (concatena-flujo
        (transforma-flujo
            #'(lambda (ligaduras)
                    (corresponde-patron-con-frames patron ligaduras))
            flujo)))

;;; Modificacion de la version 0.0.2:
;;; 
;; (defun FC-aplica-filtros (patrones flujo-inicial-entrada)
;;     (if (endp patrones)
;;         flujo-inicial-entrada
;;         (FC-aplica-filtros
;;             (rest patrones)
;;             (FC-filtra-flujo-de-ligaduras 
;;                 (first patrones) 
;;                 flujo-inicial-entrada))))

(defun FC-aplica-filtros (patrones flujo-inicial-entrada)
    (if (endp patrones)
        flujo-inicial-entrada
        (if (variable-frame-p (first (first patrones)))
	    (FC-aplica-filtros
	    	(rest patrones)
		(FC-filtra-flujo-de-ligaduras-frames
		    (first patrones)
		    flujo-inicial-entrada))
	    (FC-aplica-filtros
                (rest patrones)
                (FC-filtra-flujo-de-ligaduras 
                    (first patrones) 
                    flujo-inicial-entrada)))))

;;; Modificacion de la version 0.0.2:
;;; 
;; (defun FC-particulariza-variables (patron lista-a)
;;     (cond ((atom patron) 
;; 	   patron)
;;           ((eq '? (first patron))
;;            (extrae-valor (encuentra-ligadura patron lista-a)))
;;           (t (cons (FC-particulariza-variables (first patron) lista-a)
;;                    (FC-particulariza-variables (rest patron) lista-a)))))

(defun FC-particulariza-variables (patron lista-a)
    (cond ((atom patron) 
	   patron)
          ((eq '? (first patron))
           (extrae-valor (encuentra-ligadura patron lista-a)))
          ((eq 'objeto (first patron))
           (extrae-valor (encuentra-ligadura patron lista-a)))	   
          (t (cons (FC-particulariza-variables (first patron) lista-a)
                   (FC-particulariza-variables (rest patron) lista-a)))))

(defun usa-regla (regla)
    (let ((flujo-ligaduras
            (FC-aplica-filtros (antecedentes-de-la-regla regla)
                            (construye-flujo nil 'FLUJO-VACIO))))
        (do ((flujo-ligaduras flujo-ligaduras 
                              (resto-del-flujo flujo-ligaduras))
             (exito nil))
            ((final-del-flujo-p flujo-ligaduras) exito)
            (let ((resultado (FC-particulariza-variables
                                (consecuente-de-la-regla regla)
                                (principio-del-flujo flujo-ligaduras))))
                (when (recuerda-afirmacion resultado)
                    (format t "~%La regla ~a indica que ~a."
                        (nombre-de-la-regla regla) resultado)
                    (setf exito t))))))

(defun encadenamiento-progresivo ()
    (do ((flujo-de-reglas *reglas* (resto-del-flujo flujo-de-reglas))
         (repite nil))
        ((final-del-flujo-p flujo-de-reglas)
         (if repite
            (progn
                (format t "~%Probando las reglas de nuevo.")
                (encadenamiento-progresivo))
            (progn
                (format t "~%No hay mas cambios.")
                'HECHO)))
        (when (usa-regla (principio-del-flujo flujo-de-reglas))
            (setf repite t))))
