;******************************************************************************* ; UNITES.LSP "22/11/2000" ; Definition de la classe UNITE permettant d'acceder aux objets par leur nom ;******************************************************************************* ; Package pour utiliser CLOS (use-package "CLOS") ; Definition de la classe Unite (defclass unite () ((nom :accessor nom :initarg :nom :type symbol)) (:documentation "les unites sont des objets accessibles par leur nom")) ; Encapsulation d'une variable nommee "les-unites" stockant toutes les ; instances des classes heritant de Unite ; La valeur de la variable les-unites est formee de couple "nom-instance" ; Sa structure est celle d'une table de hashage qui permet d'acceder rapidement ; a une instance (ou objet) a partir de son nom ; Sont egalement definies les fonctions ayant droit d'acces a cette variable (let ((les-unites (make-hash-table))) (defun reset-unites (&rest l) "supprime toutes les unites ou celles des classes indiquees" (if l (maphash #'(lambda (key val) (if (loop for domaine in l thereis (typep val domaine)) (remhash key les-unites))) les-unites) (setf les-unites (make-hash-table)))) (defun une-unite (nom objet) "associe un nom et un objet dans la table des unites" (setf (gethash nom les-unites) objet)) (defmethod suicide ((oself unite)) "enleve un objet de la table des unites" (remhash (nom oself) les-unites)) (defmethod suicide ((oself symbol)) "enleve un objet de la table des unites" (remhash oself les-unites)) (defun l-objet (nom) "retourne l'objet associe a un nom dans la table des unites" (gethash nom les-unites)) (defun lister (&optional (domaine t)) "permet de lister toutes les unites de la table qui sont dans un domaine de types" (maphash #'(lambda (key val) (declare (ignore key)) (if (typep val domaine) (print val))) les-unites)) (defun les-noms (&optional (domaine t)) "retourne la liste des noms des unites de la table qui sont dans un domaine de types" (let ((liste ())) (maphash #'(lambda (key val) (if (typep val domaine) (push key liste))) les-unites) liste)) ) ; Definition d'un reflexe declenche lors de la creation d'une instance ; Les instances n'ayant pas de noms fournis dans les parametres sont ; nommees automatiquement. Ce nom sera obtenu en concatenant le nom de la ; classe de l'instance et un numero genere par le systeme a l'aide de la ; fonction gentemp (defmethod initialize-instance :after ((oself unite) &rest initargs) (declare (ignore initargs)) (unless (slot-boundp oself 'nom) (setf (nom oself) (gentemp (format nil "~s" (type-of oself))))) (une-unite (nom oself) oself)) ;****************************************************************************** ; Quelques exemples de methodes definies pour la classe unite ; Affichage specifique (defmethod print-object :before ((x unite) flot) (format flot "#<~a : ~a" (type-of x) (nom x))) (defmethod print-object ((x unite) flot) (declare (ignore flot))) (defmethod print-object :after ((x unite) flot) (format flot ">")) ; Test d'egalite d'instances (meme nom) (defgeneric meme (oself autre) (:documentation "une fonction qui prolonge l'egalite") (:method (oself autre) (equal oself autre))) (defmethod meme ((oself unite) (autre unite)) (equal (nom oself) (nom autre))) ;****************************************************************************** ; Definition d'un macro-caractere simplifiant l'utilisation de la classe Unite ; ! pour l-objet ; exemple d'utilisation : !cube1 (cube1 est une instance de la classe cube) (defun point-d-exclamation (flot char) (declare (ignore char)) `(l-objet ',(read flot t nil t))) (set-macro-character #\! #'point-d-exclamation) ;****************************************************************************** ; Definition d'une methode permettant d'interfacer la fonction Describe ; quelque soit le type de l'argument (defun |??| (oself &optional (stream t)) (cond ((l-objet oself) (describe (l-objet oself) stream)) ((and (symbolp oself) (find-class oself)) (print-object (find-class oself) stream)) ((clos::class-p oself) (print-object oself stream)) (t (describe oself stream)))) ; definition du macro-caratere ? remplacant l'appel de la fonction ?? ; exemples d'utilisation : ?unite ou ?"chaine" (defun point-d-interrogation (flot char) (declare (ignore char)) `(|??| ',(read flot t nil t))) (set-macro-character #\? #'point-d-interrogation) ;**************************************************************************