Versione ancora migliore di `is-class`

diff --git a/Lisp/README.org b/Lisp/README.org
index 5b361c25e889054ae1919df63b1869000b920696..09c83d8e095cf0c69978a83b89f5113e93ca151d 100644 (file)
--- a/Lisp/README.org
+++ b/Lisp/README.org
@@ -78,7 +78,8 @@
 ** Creazione della classe in formato lista
 #+begin_src lisp :tangle ool.lisp
 (defun make-class (parents fields methods)
-  (inherit (list :parents parents
+  (inherit (list :type 'class
+                    :parents parents
                     :fields (cdr fields)
                     :methods (cdr methods)) parents))
 #+end_src
@@ -94,7 +95,8 @@
             (error "`~A` non è una classe" (car parents)))))
 
 (defun merge-class (child super)
-  (list :parents (merge-parents (getf super :parents)
+  (list :type 'class
+        :parents (merge-parents (getf super :parents)
                                 (getf child :parents))
         :fields (merge-parts (getf super :fields)
                              (getf child :fields))
@@ -139,5 +141,7 @@
 ** Stabilire se un simbolo è una classe
 #+begin_src lisp :tangle ool.lisp
 (defun is-class (name)
-  (class-spec name))
+  (if (equal (getf (class-spec name) :type) 'class)
+      (class-spec name)
+      nil))
 #+end_src

diff --git a/Lisp/ool.lisp b/Lisp/ool.lisp
index b913d288b9f03b1451cc5ba0cceffebf3ee0b6a8..3d87ac4b84de6026588a9314f85faacb69bd9317 100644 (file)
--- a/Lisp/ool.lisp
+++ b/Lisp/ool.lisp
@@ -30,7 +30,8 @@
   (gethash name *classes-specs*))
 
 (defun make-class (parents fields methods)
-  (inherit (list :parents parents
+  (inherit (list :type 'class
+                    :parents parents
                     :fields (cdr fields)
                     :methods (cdr methods)) parents))
 
@@ -43,7 +44,8 @@
             (error "`~A` non è una classe" (car parents)))))
 
 (defun merge-class (child super)
-  (list :parents (merge-parents (getf super :parents)
+  (list :type 'class
+        :parents (merge-parents (getf super :parents)
                                 (getf child :parents))
         :fields (merge-parts (getf super :fields)
                              (getf child :fields))
@@ -79,4 +81,6 @@
           (field-name-exists name (rest fields)))))
 
 (defun is-class (name)
-  (class-spec name))
+  (if (equal (getf (class-spec name) :type) 'class)
+      (class-spec name)
+      nil))