macros are fun

.cl

;;;;
;;;; BEFORE
;;;;

(defclass op-code ()
  ((name :accessor op-code-name
         :initarg  :name
         :initform (error "must provide a name for a given op-code"))
   (type :accessor op-code-type
         :initarg  :type
         :initform (error "must provide a type for a given op-code"))
   (body :accessor op-code-body
         :initarg  :body
         :initform (error "must provide a body for a given op-code")))
  (:documentation ""))

(defclass op-group ()
  ((name :accessor op-group-name
         :initarg  :name
         :initform (error "must provide :name for a given op-group"))
   (static-mask-and :accessor op-group-static-mask-and
                    :initarg  :static-mask-and
                    :initform (error "must provide :static-mask-and for a given op-group"))
   (static-mask-equal :accessor op-group-static-mask-equal
                      :initarg  :static-mask-equal
                      :initform (error "must provide :static-mask-equal for a given op-group"))
   (variable-bits :accessor op-group-variable-bits
                  :initarg  :variable-bits
                  :initform (error "must provide :variable-bits for a given op-group"))
   (variable-shift :accessor op-group-variable-shift
                   :initarg  :variable-shift
                   :initform (error "must provide :variable-shift for a given op-group"))
   (body :accessor op-group-body
         :initarg  :body
         :initform (error "must provide :body for a given op-group")))
  (:documentation ""))

(defclass op-type ()
  ((name :accessor op-type-name
         :initarg  :name
         :initform (error "must provide :name for a given op-type"))
   (consumers :accessor op-type-consumers
              :initarg  :consumers
              :initform (error "must provide :consumers for a given op-type"))
   (producers :accessor op-type-producers
              :initarg  :producers
              :initform (error "must provide :producers for a given op-type"))
   (binds :accessor op-type-binds
          :initarg  :binds
          :initform (error "must provide :binds for a given op-type"))
   (format-string :accessor op-type-format-string
                  :initarg  :format-string
                  :initform (error "must provide :format-string for a given op-type")))
  (:documentation ""))

(defclass op-bind ()
  ((name :accessor op-bind-name
         :initarg  :name
         :initform (error "must provide :name for a given op-bind"))
   (in-vars :accessor op-bind-in-vars
            :initarg  :in-vars
            :initform (error "must provide :in-vars for a given op-bind"))
   (body :accessor op-bind-body
                  :initarg  :body
                  :initform (error "must provide :body for a given op-bind")))
  (:documentation ""))


;;;;
;;;; AFTER
;;;;

(defmacro defclass-plain (name superclasses binds &body options)
  `(defclass ,name ,superclasses
     ,(mapcar
        #'(lambda (x)
            `(,x :accessor ,(intern (concatenate 'string
                                                 (symbol-name name)
                                                 "-"
                                                 (symbol-name x)))
                 :initarg  ,(intern (symbol-name x) "KEYWORD")
                 :initform (error
                             ,(concatenate 'string
                                           "must provide a "
                                           (string-downcase (symbol-name x))
                                           " for a given "
                                           (string-downcase (symbol-name name))))))
        binds)
     ,@options))

(defclass-plain op-code ()
                (name type body)
  (:documentation ""))

(defclass-plain op-group ()
                (name static-mask-and static-mask-equal
                 variable-bits variable-shift body)
  (:documentation ""))

(defclass-plain op-type ()
                (name consumers producers binds format-string)
  (:documentation ""))

(defclass-plain op-bind ()
                (name in-vars body)
  (:documentation ""))