From: LeonardoBizzoni Date: Wed, 10 Jan 2024 11:51:50 +0000 (+0100) Subject: Documentazione e fixato errore field* X-Git-Url: http://git.leonardobizzoni.com/?a=commitdiff_plain;h=13174d89dec81fb3ffbff3436d4896c4f1d0a523;p=ObjectOriented-Prolog-Lisp Documentazione e fixato errore field* (field* instance 'field1 'field2 'field3) diventava (field* (field instance 'field1) (('field2 'field3))) nella seconda chiamata ricorsiva --- diff --git a/Lisp/README.org b/Lisp/README.org index d4e66fa..6fd05ab 100644 --- a/Lisp/README.org +++ b/Lisp/README.org @@ -1,19 +1,42 @@ #+title: 🔥 OOΛ in Common Lisp 🔥 #+author: Bizzoni Leonardo (899629) -#+author: Barone Matteo(894594) #+author: Kier Mirko Tolentino(899728) * Breve descrizione -42 +Ai tempi di Simula e del primo Smalltalk, molto molto tempo prima di +Python, Ruby, Perl e SLDJ, i programmatori Lisp già producevano una pletora +di linguaggi object oriented. +Questo progetto consiste nella costruzione di un’estensione "object oriented" +di Common Lisp, chiamata OOΛ, e di un’estensione "object oriented" +di Prolog, chiamata OOΠ. +OOΛ è un linguaggio object-oriented con eredità multipla. Il suo scopo è +didattico e mira soprattutto ad evidenziare aspetti dell’implementazione di +linguaggi object-oriented: +1) il problema di dove e come recuperare i valori ereditati. +2) come rappresentare i metodi e le loro chiamate. +3) come manipolare il codice nei metodi stessi. * Primitive principali ** def_class *** Definizione -Nel predicato def-class si definisce una classe dato: il nome, una lista di genitori ed eventuali fields e metodi, -che definiscono il comportamento della classe e le caratteristiche, -in seguito si inserisce la nuova classe dentro una tabella hash table in forma di chiave e valore. -Come chiave abbiamo il nome della classe e come valore la lista che rappresenta la classe. -Il predicato restituisce: il nome della classe messo in realazione alla lista della classe, di conseguenza per l'interprete Lisp il nome rappresenza la classe. +Definisce una classe dato un atomo rappresentante il nome della classe, +una lista possibilmente vuota di genitori (/classi definite in precedenza/ +/da cui ereditare/), un’opzionale lista contenente la definizione di +proprietà nella forma /(name value type)/ oppure /(name value)/ e +un'opzionale lista contenente la definizione di metodi nella forma +/(name args body)/. + +In particolare: +- la lista di proprietà deve iniziare con il simbolo /fields/ + (Es. /'(fields (field1 valore1) (field2 valore2 tipo2))/) +- la lista di metodi deve iniziare con il simbolo /methods/ + (Es. /'(methods (name (args) (print "La risposta è: ") (print 42) 43))/) + +Il risultato della definizione della classe è una lista contenente la +struttura della classe. +Questa lista viene aggiunta all'hash-table creando quindi un'associazione +tra il nome della classe e la lista ottenuta. + *** Implementazione #+begin_src lisp :tangle ool.lisp ;;;; @@ -57,8 +80,14 @@ Il predicato restituisce: il nome della classe messo in realazione alla lista de ** make *** Definizione -Il predicato controlla se esiste /classname/, qualora sia presente si procede con l'operazione, -trovando la lista che rappresenta la classe nell'hast-table, chiamiamo *create-istance* che resituisce l'istanza. +Rispetto alla version Prolog questo predicato è molto più semplice in +quanto svolge soltanto l'operazione di creazione dell'istanza. + +La creazione di un'istanza avviene recuperando dall'hash-table la lista +che definisce la struttura della classe da instanziare, modificando +il valore della keyword /type/ in /object/ e restituendo il risultato. +Questa modifica ci permette di differenziare un'istanza da una classe nei +predicati di controllo seguenti. *** Implementazione #+begin_src lisp :tangle ool.lisp @@ -80,7 +109,14 @@ trovando la lista che rappresenta la classe nell'hast-table, chiamiamo *create-i ** field *** Definizione -Data un'istanza e il nome di un field, cerca nei campi dell'instanza se è prensete il valore del field ricevuto in ingresso. +A differenza della versione Prolog questo predicato è in grado di +effettuare solo la lettura del valore di un field. + +Data un'istanza e il nome di un field, cerchiamo all'interno della lista +di fields dell'istanza il field corretto e ne restituiamo il valore. +La ricerca viene effettuata da un predicato helper in quanto i field +sono a loro volta liste /(name value type)/. + *** Implementazione #+begin_src lisp :tangle ool.lisp (defun field (instance field-name) @@ -92,7 +128,7 @@ Data un'istanza e il nome di un field, cerca nei campi dell'instanza se è prens (cond ((null fields) nil) ;; Se sono uguali il primo elemento della prima lista di `fields` ;; ed il nome del field restituisci il secondo - ;; elemento della prima lista di `fields` + ;; elemento della prima lista di `fields` ((eq (caar fields) field-name) (cadar fields)) (t (field-helper (cdr fields) field-name)))) #+end_src @@ -101,44 +137,60 @@ Data un'istanza e il nome di un field, cerca nei campi dell'instanza se è prens ** field* *** Definizione -boh ci penso sta sera, mentre farmo su star rail. +Data un’istanza, sia essa una variabile o un atomo, ed una lista +non vuota di field, estrae il valore associato all’ultimo elemento della +lista di field dell’ultima istanza. + +Questo predicato e la seguente clausola sono equivalenti. +#+begin_src lisp +(eq (field (field (field instance 'field1) 'field2) 'field3) + (field* instnace 'field1 'field2 'field3)) ;; t +#+end_src + *** Implementazione #+begin_src lisp :tangle ool.lisp (defun field* (instance &rest fields) - (cond ((null fields) nil) - ((null (cdr fields)) (field instance (car fields))) - (t (field* (field instance (car fields)) (cdr fields))))) + (if (null fields) + (error "La lista di fields non può essere vuota") + (field*-helper instance fields))) + +(defun field*-helper (instance fields) + (if (null (cdr fields)) + (field instance (car fields)) + (field*-helper (field instance (car fields)) (cdr fields)))) #+end_src *** Esempio pratico * Predicati helper -Definisce un semplice sistema per la gestione di specifiche di classi, -mantenendo un hash-table in cui associare nomi di classi a specifiche di classe. +Predicati forniti dal testo dell'esercizio utilizzati principalmente +per la creazione di classi e di metodi. -Diachiariamo e inizializziamo una variabile globale come un hash-table vuoto, che verrà utilizzato per memorizzare le specifiche delle classi. #+begin_src lisp :tangle ool.lisp (defparameter *classes-specs* (make-hash-table)) -#+end_src -La funzione aggiunge una nuova associazione all'hash-table, utilizzando il nome della classe come chiave e la specifica della classe come valore. -#+begin_src lisp :tangle ool.lisp + (defun add-class-spec (name class-spec) (setf (gethash name *classes-specs*) class-spec)) -#+end_src -Restituiamo la specifica della classe associata a quel nome dall'hash-table. -#+begin_src lisp :tangle ool.lisp + (defun class-spec (name) (gethash name *classes-specs*)) #+end_src ** Creazione della classe in formato lista -Creiamo la classe, se abbiamo una lista di fields *non vuota* il primo elemento deve essere l'atomo /fiedls/. -In egual modo, in una lista di metodi il primo elemento deve essere l'atomo /methods/. +Come già detto nella descrizione del predicato [[*def_class][def-class]], una classe viene +rappresentata da una lista nella forma +/(:classname :type 'class :fields :methods)/ in particolare /fields/ e /methods/ +conterranno rispettivamente: +- la lista di field meno il simbolo iniziale 'fields +- la lista di metodi meno il simbolo iniziale 'methods +per semplificare l'accesso ai valori. + +Il valore restituito da questo predicato è una lista rappresentante +la classe contenente i vari field e metodi della classe stessa e quelli +ereditati dalle classi genitore. -Dopodichè creiamo i metodi come funzioni, si controlla che i fields siano del tipo corretto. -Infine si prendono i fields del genitore e li aggiungiamo alla lista di fields alla classe creata. #+begin_src lisp :tangle ool.lisp (defun make-class (classname parents fields methods) (unless (null fields) @@ -163,8 +215,18 @@ Infine si prendono i fields del genitore e li aggiungiamo alla lista di fields a #+end_src *** Ereditazione dai genitori -Controlliamo se esiste una classe genitore, qualora ci sia si unisce il genitore alla classe figlio. -Ripetendo ricorsivamente il predicato, si forma una classe formata: dall'unione dei genitori, dei fields e dei metodi. +Il problema dell'ereditazione dei campi, metodi e genitori dei genitori +viene risolto unendo le informazioni relative alla classe figlio +con quelle del primo genitore nella lista e procedendo ricorsivamente. + +In questo modo inizialmente si hanno solo le informazioni del figlio, +se c'è almeno un genitore vengono aggiunte le informazioni mancanti +dal figlio (/per evitare di sovrascrivere field e metodi +estesi da esso/) andando così a creare la classe figlio completa di tutti +field, metodi e genitori dei genitori. +Questo permette anche un semplice modo per verificare l'ordine gerarchico +di 2 classi, il che tornerà utile nel controllo dei tipi. + #+begin_src lisp :tangle ool.lisp (defun inherit (class parents) (if (null parents) @@ -183,11 +245,7 @@ Ripetendo ricorsivamente il predicato, si forma una classe formata: dall'unione (getf child :fields)) :methods (merge-parts (getf super :methods) (getf child :methods)))) -#+end_src -**** Merge dei genitori delle superclassi con quelli della classe figlio -In questa merge controlliamo che la classe genitore è nella lista dei genitori, se *non* è prensete nella lista lo aggiungiamo. -#+begin_src lisp :tangle ool.lisp (defun merge-parents (super-parents child-parent) (if (null super-parents) child-parent @@ -201,12 +259,7 @@ In questa merge controlliamo che la classe genitore è nella lista dei genitori, (cons (car super-parents) child-parent)) ;; altrimenti vai al prossimo senza aggiungerlo (merge-parents (cdr super-parents) child-parent)))) -#+end_src -**** Merge field/method dei genitori con quelli della classe figlio -Si aggiungono i fields e i metodi del genitore alla classe figlio, -controllado che il field (o metodo) del genitore non sia presente nella lista del figlio. -#+begin_src lisp :tangle ool.lisp (defun merge-parts (parent-fields class-fields) (if (null parent-fields) class-fields @@ -227,9 +280,8 @@ controllado che il field (o metodo) del genitore non sia presente nella lista de #+end_src *** Creazione di metodi -Per ogni lista dei metodi, creiamo una funzione che in ingresso 'this' e gli argomenti. -Il corpo controlla che /this/ sia un istanza, verificando che dentro l'istanza è definito il metodo. -Recuperiamo il corpo del metodo e lo richiamiamo con gli argomenti della funzione creata. + + #+begin_src lisp :tangle ool.lisp (defun define-methods (methods) ;; Per ogni metodi @@ -267,8 +319,8 @@ Recuperiamo il corpo del metodo e lo richiamiamo con gli argomenti della funzion #+end_src ** Creazione di un'istanza -Data una lista, creiamo i field dell'istanza, che possono essere composti da: nome e valore oppure da nome, valore e tipo. -Se ci sono field da modicare, cerco il field e ne modifico il valore successivamente richiamo ricorsivamente il predicato. + + #+begin_src lisp :tangle ool.lisp (defun create-instance (listclass new-fields) ;; Se c'è almeno un field da cambiare @@ -290,9 +342,8 @@ Se ci sono field da modicare, cerco il field e ne modifico il valore successivam #+end_src *** Impostare i campi dell'istanza -Si definiscono i nuovi fields dell'istanza, cerchiamo il field con lo stesso nome -(nel caso il field ha un tipo, viene controllato che il nuovo valore sia del tipo corretto) e ne si sostituisce il valore, -dopodichè si restituisce l'istanza. + + #+begin_src lisp :tangle ool.lisp (defun set-instance-field (instance name value) ;; `setf` modifica in-place @@ -312,8 +363,8 @@ dopodichè si restituisce l'istanza. #+end_src ** Stabilire se un simbolo è una classe -Se il valore associato al nome della classe ha l'attributo ':type' con valore 'class, -viene restituita la lista che rappresenta la classe. + + #+begin_src lisp :tangle ool.lisp (defun is-class (name) (if (equal (getf (class-spec name) :type) 'class) @@ -322,12 +373,8 @@ viene restituita la lista che rappresenta la classe. #+end_src ** Controlla se il simbolo passato è un'instance della classe -Per controllare che il simbolo è instanza della classe si controlla se esiste la classe. -Se esiste: - -controlliamo che l'istanza ha un attributo ':type' uguale a 'object. -Se non esiste: - -controlliamo se l'istanza è una lista o è la classe stessa o fa parte della lista dei genitori. -Se nessuno di questi controlli va a buon fine il simbolo non è un'istanza della classe. + + #+begin_src lisp :tangle ool.lisp (defun is-instance (instance &optional (class-name t)) (if (eq class-name t) @@ -342,12 +389,8 @@ Se nessuno di questi controlli va a buon fine il simbolo non è un'istanza della #+end_src ** Controllo tipo valore -Predicati dedicati al controlli dei tipi. -Nello specifico: --possiamo controllare che tutti i campi della lista abbiamo il tipo corretto. --possaimo controllare se il campo è una terna o una coppia valida (?). --dato un campo e un valore possiamo verificare che il valore sia del tipo corretto in base al campo. --dato un tipo e un valore possiamo controllare se il valore è del tipo specificato. + + #+begin_src lisp :tangle ool.lisp (defun validate-fields-type (fields) (cond ((null fields) nil) diff --git a/Lisp/ool.lisp b/Lisp/ool.lisp index 7d68024..381de6f 100644 --- a/Lisp/ool.lisp +++ b/Lisp/ool.lisp @@ -7,9 +7,9 @@ ((not (listp methods)) (error "`methods` non è una lista")) ((or (null classname) (not (symbolp classname))) (error "'~A' non è un simbolo" - classname)) - ((is-class classname) - (error "'~A' è una classe già definita" classname))) + classname)) + ((is-class classname) + (error "'~A' è una classe già definita" classname))) ;; Aggiunge la coppia `classname` e classe in forma di lista ;; all'hash-table @@ -31,22 +31,17 @@ (copy-list (class-spec classname)))) (defun field (instance field-name) - (unless (listp instance) + (unless (is-instance instance) (error "~A non è un instanza" instance)) (field-helper (getf instance :fields) field-name)) (defun field-helper (fields field-name) (cond ((null fields) nil) - ;; Se sono uguali il primo elemento della prima lista di `fields` - ;; ed il nome del field restituisci il secondo - ;; elemento della prima lista di `fields` - ((eq (caar fields) field-name) (cadar fields)) - (t (field-helper (cdr fields) field-name)))) - -(defun field* (instance &rest fields) - (cond ((null fields) nil) - ((null (cdr fields)) (field instance (car fields))) - (t (field* (field instance (car fields)) (cdr fields))))) + ;; Se sono uguali il primo elemento della prima lista di `fields` + ;; ed il nome del field restituisci il secondo + ;; elemento della prima lista di `fields` + ((eq (caar fields) field-name) (cadar fields)) + (t (field-helper (cdr fields) field-name)))) (defparameter *classes-specs* (make-hash-table)) @@ -70,20 +65,20 @@ (define-methods (cdr methods)) (validate-fields-type (cdr fields)) (inherit - (list :classname classname - :type 'class - :parents parents - :fields (cdr fields) - :methods (cdr methods)) - parents)) + (list :classname classname + :type 'class + :parents parents + :fields (cdr fields) + :methods (cdr methods)) + parents)) (defun inherit (class parents) (if (null parents) class (if (is-class (car parents)) - (inherit (merge-class class (class-spec (car parents))) - (cdr parents)) - (error "`~A` non è una classe" (car parents))))) + (inherit (merge-class class (class-spec (car parents))) + (cdr parents)) + (error "`~A` non è una classe" (car parents))))) (defun merge-class (child super) (list :classname (getf child :classname) @@ -133,16 +128,16 @@ (lambda (method) ;; definisci una funzione (setf (symbol-function (first method)) - ;; con primo argomento l'istanza su cui chiamare il metodo - ;; e gli altri argomenti del metodo - (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))) - (apply (get-method-body this (first method)) - (append (list this) args))))) + ;; con primo argomento l'istanza su cui chiamare il metodo + ;; e gli altri argomenti del metodo + (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))) + (apply (get-method-body this (first method)) + (append (list this) args))))) methods)) @@ -165,19 +160,19 @@ ;; 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))) + (field-name-exists (car new-fields) + (getf listclass :fields))) (error "Non esiste il field `~A` in '~A'" - (car new-fields) - (getf listclass :classname))) + (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))))) + (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 @@ -189,11 +184,11 @@ (defun set-field (fields name value) (cond ((null fields) nil) - ((equal (first (car fields)) name) - (type-check-field (car fields) value) - (cons (list (first (car fields)) value) (cdr fields))) - (t (append (list (car fields)) - (set-field (cdr fields) name value))))) + ((equal (first (car fields)) name) + (type-check-field (car fields) value) + (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) @@ -204,7 +199,7 @@ (if (eq class-name t) (or (null instance) (and (listp instance) - (eq (getf instance :type) 'object))) + (eq (getf instance :type) 'object))) (and (listp instance) (or (eq (getf instance :classname) class-name) @@ -213,14 +208,14 @@ (defun validate-fields-type (fields) (cond ((null fields) nil) - (t (validate-field-type (car fields)) + (t (validate-field-type (car fields)) (validate-fields-type (cdr fields))))) (defun validate-field-type (field) (unless (listp field) (error "~S ~S" - "Un field di un classe o è una terna (name value type)" - "o una coppia (name value)")) + "Un field di un classe o è una terna (name value type)" + "o una coppia (name value)")) (cond ;; Se non c'è un tipo allora @@ -228,8 +223,8 @@ ((= (length field) 2) t) ((= (length field) 3) (type-check (second field) (third field))) (t (error "Un field di un classe ~S ~S" - "o è una terna (name value type)" - "o una coppia (name value)")))) + "o è una terna (name value type)" + "o una coppia (name value)")))) (defun type-check-field (field value) (if (eq (length field) 2) @@ -239,6 +234,6 @@ (defun type-check (value type) (if (is-class type) (if (is-instance value type) - t - (error "~A non è di tipo ~A" value type)) + t + (error "~A non è di tipo ~A" value type)) (unless (typep value type) (error "~A non è di tipo ~A" value type))))