#+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
;;;; <Cognome> <Nome> <Matricola>
** 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
** 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)
(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
** 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)
#+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)
(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
(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
#+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
#+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
#+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
#+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)
#+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 <class-name> esiste:
- -controlliamo che l'istanza ha un attributo ':type' uguale a 'object.
-Se <class-name> 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)
#+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)
((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
(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))
(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)
(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))
;; 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
(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)
(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)
(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
((= (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)
(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))))
projects / ObjectOriented-Prolog-Lisp / commitdiff