Aggiunto `get-body`

diff --git a/Lisp/README.org b/Lisp/README.org
index 6149d7295c82497cc0f1a16e570bc5dfc474584a..ad688011bbfa7ad64be2704378929f5f18e39b0f 100644 (file)
--- a/Lisp/README.org
+++ b/Lisp/README.org
@@ -207,15 +207,27 @@
                (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))))))
+              (apply (get-body this (first method)) (append (list this) args)))))
    methods))
 
+
 (defun get-method (methods name)
   (cond ((null methods) nil)
        ((eq (caar methods) name) (car methods))
         (t (get-method (cdr methods) name))))
 #+end_src
 
+*** Get Body
+#+begin_src lisp :tangle ool.lisp
+(defun get-body (this method-name)
+  (eval
+   (append
+    (list 'lambda
+         (append '(this) (cadr (get-method (getf this :methods) method-name))))
+    (cddr
+     (get-method (getf this :methods) method-name)))))
+#+end_src
+
 ** Creazione di un'istanza
 #+begin_src lisp :tangle ool.lisp
 (defun create-instance (listclass new-fields)

diff --git a/Lisp/ool.lisp b/Lisp/ool.lisp
index 35d24e5c2f3bf7002b7332afff76623ed4e3c55d..cd40cf5457ef02119cf9193ff9c52fa40be003cc 100644 (file)
--- a/Lisp/ool.lisp
+++ b/Lisp/ool.lisp
@@ -133,14 +133,23 @@
                (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))))))
+              (apply (get-body this (first method)) (append (list this) args)))))
    methods))
 
+
 (defun get-method (methods name)
   (cond ((null methods) nil)
        ((eq (caar methods) name) (car methods))
         (t (get-method (cdr methods) name))))
 
+(defun get-body (this method-name)
+  (eval
+   (append
+    (list 'lambda
+         (append '(this) (cadr (get-method (getf this :methods) method-name))))
+    (cddr
+     (get-method (getf this :methods) method-name)))))
+
 (defun create-instance (listclass new-fields)
   ;; Se c'è almeno un field da cambiare
   ;; il cui nome non è una proprietà della classe