Macro with a list of macros as argument in Common Lisp

Question

In Common Lisp, how to define a “meta-macro” which takes as argument a list of macros (and other arguments) and composes these macros to produce the desired code.

The problem is equivalent to writing a “higher-order macro” which defines a macro out of a variable list of other macros.

The concrete situation prompting the question is for me an experiment with CLSQL, where I want to re-express the employee class from the CLSQL-testsuite

(clsql:def-view-class employee ()
  ((employee-id
    :db-kind :key
    :db-constraints (:not-null)
    :type integer)
   (first-name
    :accessor employee-first-name
    :type (string 30)
    :initarg :first-name)
   (last-name
    :accessor employee-last-name
    :type (string 30)
    :initarg :last-name)
   (email
    :accessor employee-email
    :type (string 100)
    :initarg :email)
   (company-id
     :type integer
     :initarg :company-id)
   (company
    :accessor employee-company
    :db-kind :join
    :db-info (:join-class company
              :home-key companyid
              :foreign-key companyid
              :set nil))
   (manager-id
    :type integer
    :nulls-ok t
    :initarg :manager-id)
   (manager
    :accessor employee-manager
    :db-kind :join
    :db-info (:join-class employee
              :home-key managerid
              :foreign-key emplid
              :set nil))))

as

(def-view-class-with-traits employee ()
  (trait-mapsto-company trait-mapsto-manager)
  ((employee-id
    :db-kind :key
    :db-constraints (:not-null)
    :type integer)
   (first-name
    :accessor employee-first-name
    :type (string 30)
    :initarg :first-name)
   (last-name
    :accessor employee-last-name
    :type (string 30)
    :initarg :last-name)
   (email
    :accessor employee-email
    :type (string 100)
    :initarg :email)))

Having this technique at hand would favour consistency and terseness when defining complex database schemas.

I defined the two traits I need as

(defmacro trait-mapsto-company (class super slots &rest cl-options)
  (declare (ignore super slots cl-options))
  (let ((company-accessor-name
          (intern (concatenate 'string (symbol-name class) "-COMPANY"))))
    `((company-id
       :type integer
       :initarg :company-id)
      (company
       :accessor ,company-accessor-name
       :db-kind :join
       :db-info (:join-class company
                 :home-key companyid
                 :foreign-key companyid
                 :set nil)))))

(defmacro trait-mapsto-manager (class super slots &rest cl-options)
  (declare (ignore super slots cl-options))
  (let ((manager-accessor-name
          (intern (concatenate 'string (symbol-name class) "-MANAGER"))))
    `((manager-id
       :type integer
       :initarg :manager-id)
      (manager
       :accessor ,manager-accessor-name
       :db-kind :join
       :db-info (:join-class manager
                 :home-key managerid
                 :foreign-key emplid
                 :set nil)))))

However my attempt to write the def-view-class-with-traits is foiled.

(defmacro def-view-class-with-traits (class super traits slots &rest cl-options)
  (let ((actual-slots
          (reduce (lambda (trait ax) (append (apply trait class super slots cl-options) ax))
                  traits
                  :initial-value slots)))
    `(clsql:def-view-class ,class ,super ,actual-slots ,@cl-options)))

In the lambda used for reducing, the trait stands for a macro, and my use of apply does not make any sense to the Lisp – which is right! – but hopefully convey my intent to other programmers.

How to let def-view-class-with-traits process the list of macros traits in the appropriate way?

@DanRobertson In this case it is not possible to use inheritance together with database normalisation. — Michaël Le Barbier, Jun 11 '18 at 20:00

score 6 · Accepted Answer · answered Jun 08 '18 at 07:29

I would find it much less surprising if you defined the traits as classes themselves and used normal inheritance:

(def-view-class trait-mapsto-company ()
  ((company-id
    :type integer
    :initarg :company-id)
   (company
    :accessor company
    :db-kind :join
    :db-info (:join-class company
              :home-key company-id
              :foreign-key company-id
              :set nil))))

(def-view-class trait-mapsto-manager ()
  ((manager-id
    :type integer
    :initarg :manager-id)
   (manager
    :accessor manager
    :db-kind :join
    :db-info (:join-class manager
              :home-key managerid
              :foreign-key emplid
              :set nil)))

(def-view-class employee (trait-mapsto-company trait-mapsto-manager)
  ((employee-id
    :db-kind :key
    :db-constraints (:not-null)
    :type integer)
   (first-name
    :accessor employee-first-name
    :type (string 30)
    :initarg :first-name)
   (last-name
    :accessor employee-last-name
    :type (string 30)
    :initarg :last-name)
   (email
    :accessor employee-email
    :type (string 100)
    :initarg :email)))

This certainly does not make the accessor name dependent on the name of the inheriting class, but do you really want that? My view is that this way to write it shows that that would actually break a decoupling principle.

I think this is the right way to solve OP’s actual problem, provided clsql does the right thing with the inheritance. — Dan Robertson, Jun 08 '18 at 09:53
I understand your point, however this puts emphasis on inheritance which seems a bit odd to me here because I am factoring state rather than behaviour. — Michaël Le Barbier, Jun 09 '18 at 11:34
Inheritance is not primarily about behaviour. Inheritance with regard to objects/classes means extension. Seen from this side, polymorphic behaviour only follows from the need to have extension be transparent. In Common Lisp/CLOS, the decoupling of class inheritance and polymorphic behaviour is represented by the separation of classes and generic functions. — Svante, Jun 09 '18 at 12:09
One would not normally define any behaviours of the `foo-trait` classes. Except for the behaviour that e.g. you can ask for the manager of anything which inherits from `manager-trait`. What you propose in your question is an ad-hoc, informally specified, low quality version of inheritance. Why not just use the good version. — Dan Robertson, Jun 11 '18 at 20:07

score 4 · Answer 2 · edited Jun 08 '18 at 07:28

The way to “call” a macro is with macroexpand-1:

(defmacro def-view-class-with-traits (class super traits slots
                                      &rest cl-options
                                      &environment env)
  (let ((tslots
           (loop for m in traits
                 append (macroexpand-1 (list* m class super slots options)
                                       env))))
    `(def-view-class ,class ,super (,@tslots ,@slots) ,@cl-options)))

Macro with a list of macros as argument in Common Lisp

2 Answers2