Esempio epico coi numeri complessi e ultimi fix a lisp

Se `field-helper` arriva alla fine della lista di fields non
restituisce `nil` ma genera un errore perchè il field richiesto non è presente.

A quanto pare era possibile invertire l'ordine in cui dare `fields` e
`methods` nella definizione della classe.

diff --git a/Lisp/README.org b/Lisp/README.org
index 63f9405262afe4e4cd5b6b7990578d8ceed7f91f..8a77f392e5ea6bf3b7a9ac26b085bacb4a5f7855 100644 (file)
--- a/Lisp/README.org
+++ b/Lisp/README.org
@@ -78,6 +78,38 @@ tra il nome della classe e la lista ottenuta.
   '(methods
     (foo ()
      (format "Favourite number is ~D~%" field(this 'bar)))))
+
+(def-class 'p-complex nil
+          '(fields
+            (:phi 0.0 real)
+            (:rho 1.0 real))
+          '(methods
+            (sum (pcn)
+             (let ((r1 (field this :rho))
+                   (phi1 (field this :phi))
+                   (r2 (field pcn :rho))
+                   (phi2 (field pcn :phi)))
+               (make 'p-complex :rho (+ r1 r2)
+                     :phi (+ phi1 phi2))))
+            (mult (pcn)
+             (let ((r1 (field this :rho))
+                   (phi1 (field this :phi))
+                   (r2 (field pcn :rho))
+                   (phi2 (field pcn :phi)))
+               (make 'p-complex
+                     :rho (- (* r1 r2) (* phi1 phi2))
+                     :phi (+ (* r1 phi2) (* r2 phi1)))))
+            (div (pcn)
+             (let ((r1 (field this :rho))
+                   (phi1 (field this :phi))
+                   (r2 (field pcn :rho))
+                   (phi2 (field pcn :phi))
+                   (denominator (+ (* r2 r2) (* phi2 phi2))))
+               (make 'p-complex
+                     :rho (/ (+ (* r1 r2) (* phi1 phi2)) denominator)
+                     :phi (/ (- (* r1 phi2) (* r2 phi1)) denominator))))
+            (as-complex ()
+             (complex (field this :rho) (field this :phi)))))
 #+end_src
 
 ** make
@@ -127,7 +159,7 @@ sono a loro volta liste /(name value type)/.
   (field-helper (getf instance :fields) field-name))
 
 (defun field-helper (fields field-name)
-  (cond ((null fields) nil)
+  (cond ((null fields) (error "'~A' non è un field valido" field-name))
        ;; 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`
@@ -204,25 +236,32 @@ ereditati dalle classi genitore.
 
 #+begin_src lisp :tangle ool.lisp
 (defun make-class (classname parents fields methods)
-  (unless (null fields)
-    (unless (equal (car fields) 'fields)
-      (error "Il primo argomento della lista di fields ~S"
-            "deve essere il simbolo 'fields'")))
-
-  (unless (null methods)
-    (unless (equal (car methods) 'methods)
-      (error "Il primo argomento della lista di methods ~S"
-             "deve essere il simbolo 'methods'")))
-
-  (define-methods (cdr methods))
-  (validate-fields-type (cdr fields))
-  (inherit
-   (list :classname classname
-        :type 'class
-        :parents parents
-        :fields (cdr fields)
-        :methods (cdr methods))
-   parents))
+  (cond ((and (null fields) (null methods))
+        (inherit
+         (list :classname classname
+               :type 'class
+               :parents parents
+               :fields nil
+               :methods nil)
+         parents))
+       ((and (null methods)
+             (eq 'methods (car fields)))
+        (make-class classname parents nil fields))
+       ((and (eq 'methods (car fields))
+             (eq 'fields (car methods)))
+        (make-class classname parents methods fields))
+       ((and (or (null fields) (eq 'fields (car fields)))
+             (or (null methods) (eq 'methods (car methods))))
+        (define-methods (cdr methods))
+        (validate-fields-type (cdr fields))
+        (inherit
+         (list :classname classname
+               :type 'class
+               :parents parents
+               :fields (cdr fields)
+               :methods (cdr methods))
+         parents))
+       (t (error "Definizione di fields o methods invalida"))))
 #+end_src
 
 *** Ereditarietà dei genitori

diff --git a/Lisp/ool.lisp b/Lisp/ool.lisp
index f57e793d49b215f1669c10241826b31d9c3628bc..fc3f5533ea64cad13f854a18dc0f41b0f6fccffc 100644 (file)
--- a/Lisp/ool.lisp
+++ b/Lisp/ool.lisp
@@ -36,7 +36,7 @@
   (field-helper (getf instance :fields) field-name))
 
 (defun field-helper (fields field-name)
-  (cond ((null fields) nil)
+  (cond ((null fields) (error "'~A' non è un field valido" field-name))
        ;; 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`
@@ -62,25 +62,32 @@
   (gethash name *classes-specs*))
 
 (defun make-class (classname parents fields methods)
-  (unless (null fields)
-    (unless (equal (car fields) 'fields)
-      (error "Il primo argomento della lista di fields ~S"
-            "deve essere il simbolo 'fields'")))
-
-  (unless (null methods)
-    (unless (equal (car methods) 'methods)
-      (error "Il primo argomento della lista di methods ~S"
-             "deve essere il simbolo 'methods'")))
-
-  (define-methods (cdr methods))
-  (validate-fields-type (cdr fields))
-  (inherit
-   (list :classname classname
-        :type 'class
-        :parents parents
-        :fields (cdr fields)
-        :methods (cdr methods))
-   parents))
+  (cond ((and (null fields) (null methods))
+        (inherit
+         (list :classname classname
+               :type 'class
+               :parents parents
+               :fields nil
+               :methods nil)
+         parents))
+       ((and (null methods)
+             (eq 'methods (car fields)))
+        (make-class classname parents nil fields))
+       ((and (eq 'methods (car fields))
+             (eq 'fields (car methods)))
+        (make-class classname parents methods fields))
+       ((and (or (null fields) (eq 'fields (car fields)))
+             (or (null methods) (eq 'methods (car methods))))
+        (define-methods (cdr methods))
+        (validate-fields-type (cdr fields))
+        (inherit
+         (list :classname classname
+               :type 'class
+               :parents parents
+               :fields (cdr fields)
+               :methods (cdr methods))
+         parents))
+       (t (error "Definizione di fields o methods invalida"))))
 
 (defun inherit (class parents)
   (if (null parents)