aggiunto controllo `is-class`

diff --git a/Lisp/README.org b/Lisp/README.org
index b05a4f172ef853b188a25eb7dec2785c27268813..c6b53a7e8a610ebe2c35932cac213e9c212a29f5 100644 (file)
--- a/Lisp/README.org
+++ b/Lisp/README.org
@@ -88,16 +88,18 @@
 (defun inherit (class parents)
   (if (null parents)
       class
-      (inherit (merge-class class (class-spec (car parents)))
-               (cdr parents))))
+      (if (is-class (car parents))
+                 (inherit (merge-class class (class-spec (car parents)))
+                          (cdr parents))
+            (error "`~A` non è una classe" (car parents)))))
 
 (defun merge-class (child super)
   (list :parents (merge-parents (getf super :parents)
                                 (getf child :parents))
         :fields (merge-parts (getf super :fields)
-                              (getf child :fields))
+                             (getf child :fields))
         :methods (merge-parts (getf super :methods)
-                               (getf child :methods))))
+                              (getf child :methods))))
 #+end_src
 
 **** Merge dei genitori delle superclassi con quelli della classe figlio
@@ -133,3 +135,9 @@
       (or (equal name (first (first fields)))
           (field-name-exists name (rest fields)))))
 #+end_src
+
+** Stabilire se un simbolo è una classe
+#+begin_src lisp :tangle ool.lisp
+(defun is-class (name)
+  (if (class-spec name) t nil))
+#+end_src

diff --git a/Lisp/ool.lisp b/Lisp/ool.lisp
index 44a05e2adcbc2eeba38541a99491f20bd6af0778..00830ad4ddb035ec1da5aee4cb273b6f90a138e1 100644 (file)
--- a/Lisp/ool.lisp
+++ b/Lisp/ool.lisp
@@ -37,16 +37,18 @@
 (defun inherit (class parents)
   (if (null parents)
       class
-      (inherit (merge-class class (class-spec (car parents)))
-               (cdr parents))))
+      (if (is-class (car parents))
+                 (inherit (merge-class class (class-spec (car parents)))
+                          (cdr parents))
+            (error "`~A` non è una classe" (car parents)))))
 
 (defun merge-class (child super)
   (list :parents (merge-parents (getf super :parents)
                                 (getf child :parents))
         :fields (merge-parts (getf super :fields)
-                              (getf child :fields))
+                             (getf child :fields))
         :methods (merge-parts (getf super :methods)
-                               (getf child :methods))))
+                              (getf child :methods))))
 
 (defun merge-parents (super-parents child-parent)
   (if (null super-parents)
@@ -75,3 +77,6 @@
       nil
       (or (equal name (first (first fields)))
           (field-name-exists name (rest fields)))))
+
+(defun is-class (name)
+  (if (class-spec name) t nil))