From: LeonardoBizzoni <leo2002714@gmail.com>
Date: Mon, 1 Jan 2024 16:01:43 +0000 (+0100)
Subject: fatta la `make`
X-Git-Url: http://git.leonardobizzoni.com/?a=commitdiff_plain;h=cbeaca9f130dd8c089c7727501717655cb1fefc2;p=ObjectOriented-Prolog-Lisp

fatta la `make`
---

diff --git a/Lisp/README.org b/Lisp/README.org
index 4d017cb..e510d36 100644
--- a/Lisp/README.org
+++ b/Lisp/README.org
@@ -27,7 +27,10 @@
   ;; Aggiunge la coppia `classname` e classe in forma di lista
   ;; all'hash-table
   (add-class-spec classname (setf (symbol-value classname)
-				  (make-class classname parents fields methods)))
+				  (make-class classname
+					      parents
+					      fields
+					      methods)))
   ;; e restituisce il nome della classe
   classname)
 #+end_src
@@ -41,6 +44,14 @@
 
 *** Implementazione
 #+begin_src lisp :tangle ool.lisp
+(defun make (classname &rest fields)
+  (unless (is-class classname)
+    (error "'~A' non è una classe" classname))
+
+  ((lambda (instance)
+     (setf (getf instance :type) 'object)
+     (create-instance instance fields))
+   (copy-list (class-spec classname))))
 #+end_src
 
 *** Esempio pratico
@@ -157,6 +168,42 @@
           (field-name-exists name (rest fields)))))
 #+end_src
 
+** Creazione di un'istanza
+#+begin_src lisp :tangle ool.lisp
+(defun create-instance (listclass new-fields)
+  ;; Se c'è almeno un field da cambiare
+  ;; il cui nome non è una proprietà della classe
+  (unless (or (null new-fields)
+	      (field-name-exists (car new-fields)
+				 (getf listclass :fields)))
+    (error "Non esiste il field `~A` in '~A'"
+	   (car new-fields)
+	   (getf listclass :classname)))
+
+  (if (null new-fields)
+      listclass
+      (create-instance
+       (set-instance-field listclass
+			   (first new-fields)   ;; nome del field
+			   (second new-fields)) ;; nuovo valore
+       (cdr (cdr new-fields)))))
+
+(defun set-instance-field (instance name value)
+  ;; `setf` modifica in-place
+  (setf (getf instance :fields)
+	(set-field (getf instance :fields) name value))
+
+  ;; quindi serve resistuire `instance`
+  instance)
+
+(defun set-field (fields name value)
+  (cond ((null fields) nil)
+	    ((equal (first (car fields)) name)
+	       (cons (list (first (car fields)) value) (cdr fields)))
+	    (t (append (list (car fields))
+		       (set-field (cdr fields) name value)))))
+#+end_src
+
 ** Stabilire se un simbolo è una classe
 #+begin_src lisp :tangle ool.lisp
 (defun is-class (name)
diff --git a/Lisp/ool.lisp b/Lisp/ool.lisp
index 902124f..f1878c7 100644
--- a/Lisp/ool.lisp
+++ b/Lisp/ool.lisp
@@ -14,11 +14,21 @@
   ;; Aggiunge la coppia `classname` e classe in forma di lista
   ;; all'hash-table
   (add-class-spec classname (setf (symbol-value classname)
-				  (make-class classname parents fields methods)))
+				  (make-class classname
+					      parents
+					      fields
+					      methods)))
   ;; e restituisce il nome della classe
   classname)
 
+(defun make (classname &rest fields)
+  (unless (is-class classname)
+    (error "'~A' non è una classe" classname))
 
+  ((lambda (instance)
+     (setf (getf instance :type) 'object)
+     (create-instance instance fields))
+   (copy-list (class-spec classname))))
 
 
 
@@ -99,6 +109,39 @@
       (or (equal name (first (first fields)))
           (field-name-exists name (rest fields)))))
 
+(defun create-instance (listclass new-fields)
+  ;; Se c'è almeno un field da cambiare
+  ;; il cui nome non è una proprietà della classe
+  (unless (or (null new-fields)
+	      (field-name-exists (car new-fields)
+				 (getf listclass :fields)))
+    (error "Non esiste il field `~A` in '~A'"
+	   (car new-fields)
+	   (getf listclass :classname)))
+
+  (if (null new-fields)
+      listclass
+      (create-instance
+       (set-instance-field listclass
+			   (first new-fields)   ;; nome del field
+			   (second new-fields)) ;; nuovo valore
+       (cdr (cdr new-fields)))))
+
+(defun set-instance-field (instance name value)
+  ;; `setf` modifica in-place
+  (setf (getf instance :fields)
+	(set-field (getf instance :fields) name value))
+
+  ;; quindi serve resistuire `instance`
+  instance)
+
+(defun set-field (fields name value)
+  (cond ((null fields) nil)
+	    ((equal (first (car fields)) name)
+	       (cons (list (first (car fields)) value) (cdr fields)))
+	    (t (append (list (car fields))
+		       (set-field (cdr fields) name value)))))
+
 (defun is-class (name)
   (if (equal (getf (class-spec name) :type) 'class)
       (class-spec name)