From 11e3c743c47902fbc91a81f9d41fff32517e3c1a Mon Sep 17 00:00:00 2001 From: LeonardoBizzoni Date: Wed, 3 Jan 2024 16:27:51 +0100 Subject: [PATCH] Migliorato chiamata metodi ma rotta la chiamata al corpo --- Lisp/README.org | 21 +++++++++++++++------ Lisp/ool.lisp | 21 +++++++++++++++------ 2 files changed, 30 insertions(+), 12 deletions(-) diff --git a/Lisp/README.org b/Lisp/README.org index f7ced47..6149d72 100644 --- a/Lisp/README.org +++ b/Lisp/README.org @@ -198,13 +198,22 @@ (defun create-methods (classname methods) (mapcar (lambda (method) - (eval (list* 'defun - (first method) - (append '(inst) (second method)) - (append '((unless (is-instance inst) - (error "~A non è un'istanza" inst))) - (cddr method))))) + (setf (symbol-function (first method)) + (lambda (this &rest args) + (unless (is-instance this) + (error "~A non è un'istanza" this)) + (unless (get-method (getf this :methods) (first method)) + (error "~A non ha un metodo ~A" (getf this :classname) (first method))) + (unless (eq (length args) + (length (second (get-method (getf this :methods) (first method))))) + (error "~A numero di argomenti errato" (first method))) + (cddr (get-method (getf this :methods) (first method)))))) methods)) + +(defun get-method (methods name) + (cond ((null methods) nil) + ((eq (caar methods) name) (car methods)) + (t (get-method (cdr methods) name)))) #+end_src ** Creazione di un'istanza diff --git a/Lisp/ool.lisp b/Lisp/ool.lisp index 4eba3f8..35d24e5 100644 --- a/Lisp/ool.lisp +++ b/Lisp/ool.lisp @@ -124,14 +124,23 @@ (defun create-methods (classname methods) (mapcar (lambda (method) - (eval (list* 'defun - (first method) - (append '(inst) (second method)) - (append '((unless (is-instance inst) - (error "~A non è un'istanza" inst))) - (cddr method))))) + (setf (symbol-function (first method)) + (lambda (this &rest args) + (unless (is-instance this) + (error "~A non è un'istanza" this)) + (unless (get-method (getf this :methods) (first method)) + (error "~A non ha un metodo ~A" (getf this :classname) (first method))) + (unless (eq (length args) + (length (second (get-method (getf this :methods) (first method))))) + (error "~A numero di argomenti errato" (first method))) + (cddr (get-method (getf this :methods) (first method)))))) methods)) +(defun get-method (methods name) + (cond ((null methods) nil) + ((eq (caar methods) name) (car methods)) + (t (get-method (cdr methods) name)))) + (defun create-instance (listclass new-fields) ;; Se c'è almeno un field da cambiare ;; il cui nome non è una proprietà della classe -- 2.52.0