From: LeonardoBizzoni <leo2002714@gmail.com>
Date: Sun, 31 Dec 2023 09:46:37 +0000 (+0100)
Subject: Versione ancora migliore di `is-class`
X-Git-Url: http://git.leonardobizzoni.com/?a=commitdiff_plain;h=f7edc84650a516684bab58373b322e6a359f36c0;p=ObjectOriented-Prolog-Lisp

Versione ancora migliore di `is-class`
---

diff --git a/Lisp/README.org b/Lisp/README.org
index 5b361c2..09c83d8 100644
--- 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 b913d28..3d87ac4 100644
--- 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))