From 4ab6b0472a48e5ad8a02d6569f9644b1d6333452 Mon Sep 17 00:00:00 2001
From: kier-mirko <mirkotolentino1@gmail.com>
Date: Sun, 7 Jan 2024 13:40:55 +0100
Subject: [PATCH] Aggiunto `get-body`

---
 Lisp/README.org | 14 +++++++++++++-
 Lisp/ool.lisp   | 11 ++++++++++-
 2 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/Lisp/README.org b/Lisp/README.org
index 6149d72..ad68801 100644
--- 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 35d24e5..cd40cf5 100644
--- 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
-- 
2.52.0