Migliorato chiamata metodi ma rotta la chiamata al corpo

diff --git a/Lisp/README.org b/Lisp/README.org
index f7ced47a4f62f418fc6eea7e7ea8d73b5dd2360c..6149d7295c82497cc0f1a16e570bc5dfc474584a 100644 (file)
--- 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 4eba3f86565d586113c2a788129df70ed4d3567a..35d24e5c2f3bf7002b7332afff76623ed4e3c55d 100644 (file)
--- 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