Le 06/02/2021 à 14:45, Manfred Bergmann a écrit :
Hello.

I am trying to discover design patterns and how they are implemented in Common 
Lisp.

Using defmacro.

Have a look at:
http://groups.google.com/group/comp.lang.lisp/msg/ee09f8475bc7b2a0
http://groups.google.com/group/comp.programming/msg/9e7b8aaec1794126



According to Peter Norvig 
(http://norvig.com/design-patterns/design-patterns.pdf) and this source 
(https://wiki.c2.com/?AreDesignPatternsMissingLanguageFeatures) some design 
pattern are more simple in Common Lisp, or are actually not needed at all 
because the language can be extended to achieve the same thing: extendability, 
separation, abstraction.

Taking an Abstract Factory for example, the sources say that metaclasses can 
help do this.
I’ve read a bit about metaclasses and the MOP but I fail to see how.
I could probably come up with something.

A GUI framework for example. I could create something like this :

—
(defclass meta-button (standard-class)
   ((gui-button-backend :initform nil
                        :accessor gui-button-backend)))

(defmethod closer-mop:validate-superclass
     ((class meta-button)
      (superclass standard-class))
   t)

(defclass button () () (:metaclass meta-button))
(defun make-button ()
   (make-instance 'button))
—

This code is incomplete. It doesn't specify the concrete gui-button-backend, and how it's used to make an instance of button.

Also, it doesn't really implement the abstract factory design pattern, because defclass being a macro, that specifies that the metaclass IS the name of the metaclass, not that it is EVALUATED to a name of a metaclass, you cannot create a class with a metaclass in a variable (not directly at least; you could do it using eval and building a defclass form at run-time). Fundamentally defclass is a compilation-time operator, while the abstract factory design pattern is designed to select the concrete classes at run-time.


And configure a QT or GTK, Motif (or whatever) button backend to the metaclass 
on startup (or so).
But I think this would just be the pattern somehow turned into a metaclass.
Doesn’t feel like the right thing.

Does anyone know what Peter Norvig had in mind when he said that metaclasses 
can be used instead of Abstract Factory pattern?

As an abstraction mechanism, metaclasses can probably help to implement some design patterns. However, the code presented above doesn't demonstrate it.

That said, I won't try to define such a metaclass, because in lisp there are easier ways to define the abstract factory design pattern.

First, let's remember that design patterns were invented to paper over deficiencies in OO programming languages. Lisp doesn't have a lot of deficiencies, and it has defmacro which let you add features to the lisp language easily.

Next, concerning the Asbtract Factory design pattern, it seems to me that an important part of this design pattern is the abstract classes of the factory, and of the concrete classes. Abstract classes are important in a number of OO programming languages because 1) methods are attached to classes, and 2) they are a way to define interfaces.

However, some OO programming languages have other abstractions to define interfaces (eg. @protocols in Objective-C), or just don't need an abstract superclass to have a bunch of concrete classes implementing the same set of methods (or even methods implemented generically for all of them). OO programming languages that allow duck typing such as Python for example, or indeed, Common Lisp CLOS where the methods are attached to generic functions, not to classes and where all classes are subclass of the standard-object class.

So when you remove the abstract superclasses, it remains only the parameterisation of the concrete classes that must be created.

In the case of CLOS, the MAKE-INSTANCE generic function already takes the class as parameter!!! There is absolutely no need for an asbtract factory design pattern in CLOS, because CLOS doesn't have the deficiency in the first place!

There's a last aspect of that design pattern (all design patterns actually), which is the participants and collaboration structure. But note that in the case of the Abstract Factory design pattern, the description given is actually a meta design pattern, because the participants and collaborations are given as a mere example, not in a concrete form. When you actually implement the design patter, you will choose the exact set of participants (the concrete classes) and their relationships. So the question is how you want to represent this aspect.

It can be just a variable containing the class. Perhaps it could be a list of classes. Or a structure or clos object with a set of classes in slots. Or a hash-table or other map such as a-list.

Of course, you can also define a class, and define a bunch of methods returning the concrete class names. There would be little reason to do that, unless for some reason this class would need attributes (slots) used to compute the concrete class names in the various methods of the various generic functions.

Let's also remember that you can specialize generic function on specific lisp objects, not only on classes.

To recapitulate, here are various examples of code:

(defclass x11-window ()
  ((title :initarg :title)
   (subviews :initarg :subviews)))
(defclass x11-pane ()
  ())
(defclass x11-button ()
  ((title :initarg :title)))
(defclass x11-textfield ()
  ((value :initarg :value)))

;;; Using a mere variable to store the concrete class:

(defparameter *button-class* 'button)

(defun configure (backend)
  (ecase backend
    (x11 (setf *button-class* 'x11-button))
    (macos (setf *button-class 'macos-button))
    ...))

(make-instance *button-class* :title "OK")

;;; Of course you can define a bunch of variables for several concrete classes.



;;; Using a map (here an a-list) for several concrete classes:

(defparameter *gui-factory* '((window    . x11-window)
                              (pane      . x11-pane)
                              (button    . x11-button)
                              (textfield . x11-textfield)))

(defun aget (alist key)
  (cdr (assoc key alist)))

(defun window-class (factory) (aget factory 'window))
(defun pane-class (factory) (aget factory 'pane))
(defun button-class (factory) (aget factory 'button))
(defun textfield-class (factory) (aget factory 'textfield))

(make-instance (window-class *gui-factory*)
               :title "Example Window"
               :subviews (list
                          (make-instance (textfield-class *gui-factory*)
                                         :value "Is it a good example?")
                          (make-instance (button-class *gui-factory*)
                                         :title "Yep")
                          (make-instance (button-class *gui-factory*)
                                         :title "Nope")))


;;; Using a structure (or a clos object, it would be similar):

(defclass classes ()
  ((window :initarg :window :reader window-class)
   (pane :initarg :pane :reader pane-class)
   (button :initarg :button :reader button-class)
   (textfield :initarg :textfield :reader textfield-class)))

(defparameter *gui-factory* (make-instance 'classes
                                           :window    'x11-window
                                           :pane      'x11-pane
                                           :button    'x11-button
                                           :textfield 'x11-textfield))

(make-instance (window-class *gui-factory*)
               :title "Example Window"
               :subviews (list
                          (make-instance (textfield-class *gui-factory*)
                                         :value "Is it a good example?")
                          (make-instance (button-class *gui-factory*)
                                         :title "Yep")
                          (make-instance (button-class *gui-factory*)
                                         :title "Nope")))

;; It's actually the same as with the map, in both cases, instead of
;; using aget or structure or clos instance accessors, we can define a
;; function implementing a common API.


;;; Using methods:

(defgeneric window-class (factory))
(defgeneric pane-class (factory))
(defgeneric button-class (factory))
(defgeneric textfield-class (factory))

;; the you can define an abstract factory class, and implement the methods:

(defclass x11-factory ()
  ())

(defmethod window-class ((factory x11-factory)) 'x11-window)
(defmethod pane-class ((factory x11-factory)) 'x11-pane)
(defmethod button-class ((factory x11-factory)) 'x11-button)
(defmethod textfield-class ((factory x11-factory)) 'x11-textfield)

(defparameter *gui-factory* (make-instance 'x11-factory))

(make-instance (window-class *gui-factory*)
               :title "Example Window"
               :subviews (list
                          (make-instance (textfield-class *gui-factory*)
                                         :value "Is it a good example?")
                          (make-instance (button-class *gui-factory*)
                                         :title "Yep")
                          (make-instance (button-class *gui-factory*)
                                         :title "Nope")))

;; But as you can see, the methods are constant functions, the classes
;; are hard-coded.  So we could avoid the useless factory class, and
;; dispatch only on a value, for example a symbol:

(defmethod window-class ((factory (eql 'x11))) 'x11-window)
(defmethod pane-class ((factory (eql 'x11))) 'x11-pane)
(defmethod button-class ((factory (eql 'x11))) 'x11-button)
(defmethod textfield-class ((factory (eql 'x11))) 'x11-textfield)

(defparameter *gui-factory* 'x11)

(make-instance (window-class *gui-factory*)
               :title "Example Window"
               :subviews (list
                          (make-instance (textfield-class *gui-factory*)
                                         :value "Is it a good example?")
                          (make-instance (button-class *gui-factory*)
                                         :title "Yep")
                          (make-instance (button-class *gui-factory*)
                                         :title "Nope")))

;; As you can see, no difference.



Now, where would defmacro enter the scene? We could define a few macros and supporting functions to be able to define factories with their set of concrete classes; the macro would expand to the boilerplate code, such as the generic and methods, according to the implementation choice (alist, factory class, factory symbol, etc).


(define-abstract-factory gui-factory
   (window pane button textfield))

(define-factory x11-factory gui-factory
   (x11-window x11-pane x11-button x11-textfield))

(define-factory x11-factory gui-factory
   (macos-window macos-pane macos-button macos-textfield))

(defparameter *gui-factory* (make-factory 'x11-factory))

(make-instance (window-class *gui-factory*)
               :title "Example Window"
               :subviews (list
                          (make-instance (textfield-class *factory*)
                                         :value "Is it a good example?")
                          (make-instance (button-class *factory*)
                                         :title "Yep")
                          (make-instance (button-class *factory*)
                                         :title "Nope")))

(define-abstract-factory enterprise-factory
   (employee invoice tax))

(define-factory incorporated-enterprise (enterprise-factory)
   (inc-employee inc-invoice inc-tax))

(define-factory limited-enterprise (enterprise-factory)
   (ltd-employee ltd-invoice ltd-tax))

(defparameter *enterprise-factory* (make-factory 'incorporated-enterprise))

(make-instance (employee-class *enterprise-factory*) :name "John Doe"))



In effect, the abstract factory meta design pattern is thus implemented in lisp as a define-abstract-factory macro, and the concrete abstract factory design pattern as a define-factory macro.


--
__Pascal Bourguignon__

Reply via email to