;; heritage - liste des precedence

(clear)

(defclass A (is-a USER))
(describe-class A)
(defclass B (is-a USER))
(describe-class B)
(defclass C (is-a A B))
(describe-class C)
(defclass D (is-a B A))
(describe-class D)
(defclass E (is-a A C))
(describe-class E)

;;Erreur! C est une subclass de A ne peut pas est successeur de A dans la liste.

(defclass E (is-a C A))
(describe-class E)
(defclass F (is-a C B))
(describe-class F)
(defclass G (is-a C D))
(describe-class G)

;;Erreur. 
;;C'est une erreur (violation du règle #2). Le précédence de C veut que A
;;doit précéder B, mais le classe précédence de D dis l'inverse. 

(defclass H (is-a A))
(describe-class H)
(defclass I (is-a B))
(describe-class I)
(defclass J (is-a H I A B))
(describe-class J)

;;
;; Message Handlers
;;

(clear)


(defclass PERSONNE (is-a USER)
	(slot nom (create-accessor read-write))
	(slot pere (create-accessor read-write))
	(slot mere (create-accessor read-write))
	(multislot freres (create-accessor read-write))
	(multislot soeurs (create-accessor read-write))
)


(make-instance [Bernard] of HOMME (nom Bernard))
(make-instance [Emma] of FEMME (nom Emma))
(make-instance [Albert] of HOMME (nom Albert))
(make-instance [Josephte] of FEMME (nom Josephte))
(make-instance [Stephen] of HOMME (nom Stephen) 
   (pere [Bernard]) (mere [Emma]))
(make-instance [Cecile] of FEMME (nom Cecile) 
   (pere [Bernard]) (mere [Emma]))
(make-instance [Jerome] of HOMME (nom Jerome) 
   (pere [Albert]) (mere [Josephte]) (freres [Stephen]))
(make-instance [Eric] of HOMME (nom Eric) 
   (pere [Jerome]) (mere [Cecile]))

(send [Eric]  grandpere-paternale)
(send [Eric]  grandmere-paternale)
(send [Eric]  grandpere-maternale)
(send [Eric]  grandmere-maternale)


(defclass HOMME (is-a PERSONNE ) (role concrete)
	(slot epouse (create-accessor write))
	(slot sexe (access read-only)(default masculin)
				(create-accessor read))
)

(defclass FEMME (is-a PERSONNE ) (role concrete)
	(slot epoux (create-accessor write))
	(slot sexe (access read-only)(default feminin)
				(create-accessor read))
)


(defmessage-handler PERSONNE grandpere-paternale ()
	 (send ?self:pere get-pere)
)

(defmessage-handler PERSONNE grandmere-paternale ()
	(send ?self:pere get-mere)
)


(defmessage-handler PERSONNE grandpere-paternale ()
	(send (send ?self:pere get-pere) get-nom)
)

(defmessage-handler PERSONNE grandmere-paternale ()
	(send (send ?self:pere get-mere) get-nom)
)

(defmessage-handler PERSONNE grandpere-maternale ()
	(send (send ?self:mere get-pere) get-nom)
)

(defmessage-handler PERSONNE grandmere-maternale ()
	(send (send ?self:mere get-mere) get-nom)
)
 




;;;  Exemple de heritage Dynamique

(defclass chose (is-a USER) (role concrete) 
   (multislot AKO (create-accessor read-write)) 
   (slot couleur (create-accessor read-write))
    (message-handler inherit-color)
)

(make-instance [C] of chose (couleur bleu))
(make-instance [D] of chose (couleur blanc))
(make-instance [E] of chose (couleur rouge))
(make-instance [B] of chose (AKO [D] [E]))
(make-instance [A] of chose (AKO [B] [C]))

(defmessage-handler chose inherit-couleur  () 
   (if (neq ?self:couleur nil) then 
        (return ?self:couleur)
   else
      (bind ?couleur)
      (progn$ (?super ?self:AKO)
         (bind ?couleur (send ?super inherit-couleur))
         (if (neq nil ?couleur) then (break))
      )
      (return ?couleur)
   )
)

(send [C] inherit-couleur)
(send [A] inherit-couleur)
(send [B] inherit-couleur)

;;
;; avec message de trace 
;;

(defmessage-handler chose inherit-couleur  () 
   (if (neq ?self:couleur nil) then 
        (return ?self:couleur)
   else
      (bind ?couleur)
      (progn$ (?super ?self:AKO)
         (printout t ?super " ")
         (bind ?couleur (send ?super inherit-couleur))
         (printout t ?couleur crlf)
         (if (neq nil ?couleur) then (break))
      )
      (return ?couleur)
   )
)


(send [C] inherit-color)
(send [B] inherit-color)
(send [A] inherit-color)

;;
;; heritage dynamique par handlers
;;

(defmessage-handler chose mv-inherit-couleur  () 
   (if (neq ?self:couleur nil) then 
        (return ?self:couleur)
   else
      (bind $?couleur (create$))
      (progn$ (?super ?self:AKO)
          (bind ?c (send ?super inherit-couleur))
          (if (neq ?c nil) then 
            (bind $?couleur (insert$ $?couleur 1 ?c))
          )
      )
      (return $?couleur)
   )
)
(defmessage-handler CHOSE inherit-couleur  () 
   (if (neq ?self:couleur nil) then 
        (return ?self:couleur)
   else
      (bind ?couleur)
      (progn$ (?super ?self:AKO)
         (bind ?couleur (send ?super inherit-couleur))
         (if (neq nil ?couleur) then (break))
      )
      (return ?couleur)
   )
)
(send [E] inherit-couleur)
(send [D] inherit-couleur)
(send [C] inherit-couleur)
(send [B] inherit-couleur)
(send [A] inherit-couleur)

;;
;; héritage multiple. Les valeurs sont aussi affecté aux slots. 
;;

(defmessage-handler CHOSE mv-inherit-couleur  () 
   (if (neq ?self:couleur nil) then 
        (return ?self:couleur)
   else
      (bind $?couleur (create$))
      (progn$ (?super ?self:AKO)
          (bind $?c (send ?super inherit-couleur))
          (if (neq $?c nil) then 
            (bind $?couleur (insert$ $?couleur 1 $?c))
          )
      )
      (return $?couleur)
   )
)

(send [C] mv-inherit-couleur)
(send [B] mv-inherit-couleur)
(send [A] mv-inherit-couleur)