From 22749cd8fbf2338fcdfe8ec1bd59968ba90268e5 Mon Sep 17 00:00:00 2001 From: LeonardoBizzoni Date: Sun, 31 Dec 2023 10:31:21 +0100 Subject: [PATCH] aggiunto controllo `is-class` --- Lisp/README.org | 16 ++++++++++++---- Lisp/ool.lisp | 13 +++++++++---- 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/Lisp/README.org b/Lisp/README.org index b05a4f1..c6b53a7 100644 --- 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 44a05e2..00830ad 100644 --- 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)) -- 2.52.0