(setq regles '(
	(R1 si (on-a-fait-le-mit)
	    alors (on-est-intelligent))
	(R2 si (on-a-ete-battu-par-ses-parents)
	    alors (on-est-nevrose))
	(R3 si (on-est-nevrose
		on-est-frustre)
	    alors (on-est-anxieus))
	(R4 si (il-y-a-le-feu
		on-est-dans-un-batiment)
	    alors (on-est-en-danger))
	(R5 si (on-est-en-danger
		on-est-intelligent)
	    alors (on-est-anxieux))
	(R6 si (un-chien-mechant-approche)
	    alors (il y a menace))
	(R7 si (il-y-a-menace)
	    alors (on-est-en-danger))
	    )
)

; tableau I - fonctions utilitaires

(defun partie_gauche:regle (r)(caddr r))
(defun partie_droite:regle (r) (cadr(cdddr r)))
(defun nom:regle (r)(car r))

(defun appliquee?:regle (r)(get (nom:regle r) 'appliquee))
(defun marquer_appliquee:regle(r)(putprop (nom:regle r) t 'appliquee))

(defun r_concluent_sur:prop (p) (get p 'concl))
(defun terminal?:prop (p)(null (r_concluent_sur:prop p)))

(defun demandable?:prop (p)(get p 'demandable))
(defun marquer_demandable:prop (p)(putprop p t 'demandable))
(defun marquer_demandable:liste_de_prop(lp)(mapc 'marquer_demandable:prop lp))

(defun recherchee?:prop (p)(get p 'recherchee))
(defun marquer_recherchee:prop (p)(putprop p 't 'recherchee))

(defun vraie?:prop (p)(get p 'vraie))
(defun marquer-vraie:prop (p)(putprop p t 'vraie))
(defun faux?:prop (p) (and (recherchee?:prop p)
			(not (vraie?:prop p)))
			)

(defun presentee?:prop (p)(get p 'presentee))
(defun marquer_presentee:prop (p)(putprop p t 'presentee))

(defun come (pred liste)
  (cond
    ((null liste) nil)
    ((apply pred (list(car liste)))(car liste))
    (t (come pred (cdr liste)))
  )
)

(defun vraie?:pg(liste_de_prop)
  (not (member nil (mapcar 'vraie?:prop liste_de_prop)))
)


; compilation de la base de règles

(defun initialiser ()
  (cond ((not (boundp 'regles))
  	(print '(vous n'avez pas donné de regles))
	(error)))
  (cond ((not (boundp 'propositions))(compile_regles)))
  (Princ "voulez vous que j'affiche mes pas d'inférences ?")
  (terpri)
  (setq reponse (read))
  (cond ((member reponse '(o y oui))(setq md t))(t (setq md nil)))
  (mapc 'rafraichir:prop propositions)
  (mapc 'rafraichir:regle regles)
)

(defun compile_regles ()
  (setq propositions nil)
  (mapc
    'compile_regle
    regles)
    'compilees
)

(defun compile_regle(r)
  (mapc
    '(lambda (p)
       (setq propositions (cons p propositions))
       (putprop p (cons r (get p 'concl)) 'concl)
     )
     (partie_droite:regle r)
  )
  (mapc '(lambda (p) (setq propositions (cons p prpositions)))
  	  (partie_gauche:regle r)
  )
)

(defun rafraichir:prop (p)
 (remprop p 'recherchee)
 (remporp p 'vraie)
 (remprop p 'presentee)
)

(defun rafraichir:regle (r)
  (remprop (nom:regle r) 'appliquee)
)

; chainage arrière

(defun probleme (p)
  (initialiser)
  (etablir:prop p)
  (presenter_resultats)
)

(defun etablir:prop (p)
  (cond
   ((recherchee?:prop p)
    (cond
     ((vraie?:prop p) t)
     (t nil)))
   ((terminal?:prop p)
    (marquer_recherchee:prop p)
    (questionner_et_conclure:prop p))
   ((demandable?:prop p)
    (cond((questionner_et_conclure:prop p) t)
    	 ((eq reponse '?)(inferer:prop p))
    )
   )
   (t
     (marquer_recherchee:prop p)
     (inferer:prop p))
 )
)

(defun questionner_et_conclure:prop (p)
  (poser_question:prop p)
  (setq reponse (read))
  (cond
    ((member reponse '(y yes oui o))
     (marquer_vraie:prop p)
      t)
    ((member reponse '(no ? non n))
      nil)
     (t
      (princ "repondez oui ou non ou ? (si vous ne savez pas)")
      (terpri)
      (questionner_et_conclure:prop (p))
     )
   )
)

(defun inferer:prop (p)
 (let
  ((liste_de_regles (r_concluent_sur:prop p)))
  (inferer1 p liste_de_regles)
 )
)

(defun inferer1 (p lisreg1)
  (cond
   ((null lisreg1)
     nil)
   (t (essayer:regle (car lisreg1))
      (cond
       ((vraie?:prop p) t)
       (t (inferer1 p (cdr lisreg1)))
      )
   )
  )
)

(defun essaye:regle (r)
  (cond ((and (boundp 'md) md)
  	 (princ "j'essaye la regle ")
	 (terpri)
	 (princ r)(terpri)))
  (cond
   ((appliquee?:regle r)nil) ;dejà appliquée? si oui ne fait rien
   (t
    (let ((v (etablir_partie_gauche:pg (partie_gauche:regle r))))
      (cond
       ((null v) nil) ; lapartie gauche est fausse? la regle echoue sinon les propositions de la partie droite sont marquées vraies
       (t (applique_partie_droite:pd (partie_droite:regle r)))
      )
      (marquer_appliquee:regle r) ; la règle ne peut plus être réutilisée
     )
   )
  )
)

(defun etablir_partie_gauche:pg (liste_de_prop)
  (cond
    ((scme 'faux?:prop liste_de_prop)nil) ; y a-t-il une prop deja connu fausse? si oui on s'arrête là et on rend nil
    (t (etablir_pg1:pg liste_de_prop))
  )
)

(defun etablir_pg1:pg (liste_de_prop)
  (cond
    ((null liste_de_prop) t)
    ((null (etablir:prop (car liste_de_prop))) nil)
    (t (etablir_pg1:pg (cdr liste_de_prop)))
  )
)

(defun applique_partie_droite:pd (lp) ;lp une liste de propositions
  (mapc 'marquer_vraie:prop lp) ;on les marque toutes a vrai
  (mapc 'montre_deduction:prop lp) ;eventuellement on montre ce que l'on fait
)

(defun montre_deduction:prop (p)
  (cond
   ((and (boundp 'md) md) ;l'atome md a-t-iil deja une valeur et est elle vraie?
    (print (list 'je 'deduis p))
   )
  )
)

; CHAINAGE AVANT

(defun chainer_avant (liste_de_prop)
 (initialiser)
 (mapc 'marquer_vraie:prop liste_de_prop)
 (chainer_avant1)
 (presenter_resultats)
)

(defun chainer_avant1 ()
  (setq rc (some 'appliquer:regle regles))
  (cond
   ((null rc)())
   (t (chainer_avant1))
  )
)

(defun appliquer:regle (r)
 (cond
  ((appliquee?:regle r) nil) ;arrêter si deja appliqué
  ((vraie?:g (partie_gauche:regle r)) ;allez y si partie gauche est vraie
   (marquer_appliquee:regle r)
   (cond ((and (boundp 'md) md) ;eventuellement pour montrer ce qui se passe
   	  (terpri)
	  (princ "j'applique la regle")
	  (terpri)
	  (princ r)(terpri)
	 )
   )
   (applique_partie_droite:pd (partie_droite:regle r))
   t)
 )
)

(defun presenter_resultats ()
 (terpri)(terpri)(terpri)
 (princ "Voici ce que j'en conclus")
 (terpri)
  (mapc
   'presenter:prop
   propositions)
  'Cest_tout
)

(defun presenter:prop (p)
  (cond
   ( (prensentee?:prop p) nil)
   ( t (marquer_prensentee:prop p)
       (cond
        ((vraie?:prop p)
	 (print (list p 'est 'vraie))
	)
	((faux?:prop p)
	 (print (list p 'est 'faux))
	)
	(md (print (list 'je 'ne 'peux 'rien 'dire 'quant 'a p)))
       )
    )
   )
)