Paste number 91129: Two macros and a wrapper function

Index of paste annotations: 1

Paste number 91129: Two macros and a wrapper function
Pasted by: sebyte
When:8 months, 3 days ago
Share:Tweet this! | http://paste.lisp.org/+1YBD
Channel:#lisp
Paste contents:
Raw Source | XML | Display As
;;; In this simple example we can see how the arguments to wrapper
;;; function FOOW are appended to form a single list which is then
;;; passed to the macro FOO.

(defmacro foo (arg)
  `(mapcar (lambda (x) (1+ (1+ x))) ,arg))
;;; => FOO
             
(defun foow (a b)
 (foo (append a b)))
;;; => FOOW

(foow '(1) '(2))
;;; => (3 4)

;;; However, the two macros below compile perfectly well (and can be
;;; tested by macroexpanding the direct calls to them immediately
;;; below their definitions) but when it comes to compiling the
;;; wrapper function MAKE-INDEXED-SLOT-QUERY-TOOLS at the bottom of
;;; this page, an error occurs:
;;;
;;; "value INDEXED-SLOTS is not of the expected type LIST.
;;;    [Condition of type TYPE-ERROR]"
;;;
;;; This has me completely stumped, especially given that this error
;;; is happening at load time, not run time.

(defmacro %make-single-query-tools (pclasses indexed-slots &optional arg)
  (let ((gs (gensym)) rv)
    (mapc (lambda (pclass)
            (mapc (lambda (s)
                    (push 
                     ;; result code
                     `(setf (fdefinition
                             ,(intern (concat (if arg "" "%") (symbol-name pclass)
                                              "S-BY-" (symbol-name s))))
                            (lambda (,gs)
                              (get-instances-by-value ',pclass ',s ,gs)))
                     rv))
                  indexed-slots))
          pclasses)
    (push 'progn rv)
    rv))
;(%make-single-query-tools (person student) (id first-name last-name))
;(%make-single-query-tools (person student) (id first-name last-name) t)

(defmacro %make-multi-query-tools (pclasses indexed-slots)
  (let ((psuperclass (car pclasses)) (gs (gensym)) rv)
    (mapc (lambda (indexed-slot)
            (push
             ;; result code
             `(setf (fdefinition
                     ,(intern (concat (symbol-name psuperclass)
                                      "S-BY-"
                                      (symbol-name indexed-slot))))
                    (lambda (,gs)
                      (delete nil
                              ;; inner loop
                              ,(let (rv)
                                 (mapc (lambda (pclass)
                                         (push 
                                          ;; inner result code
                                          `(,(intern (concat "%" (symbol-name pclass) "S-BY-"
                                                             (symbol-name indexed-slot)))
                                             ,gs)
                                          rv))
                                       pclasses)
                                 (push 'append rv)
                                 rv)
                              )))
             rv))
          indexed-slots)
    (push 'progn rv)
    rv))
;(%make-multi-query-tools (person student) (id first-name last-name))


(defun make-indexed-slot-query-tools (pclass psubclasses indexed-slots)
  (if (null psubclasses)
      (%make-single-query-tools (list pclass) indexed-slots t)
    (progn (%make-single-query-tools (append pclass psubclasses) indexed-slots)
           (%make-multi-query-tools (append pclass psubclasses) indexed-slots))))
;(make-indexed-slot-query-tools person () (id height weight))

Annotations for this paste:

Annotation number 1: correction
Pasted by: sebyte
When:8 months, 3 days ago
Share:Tweet this! | http://paste.lisp.org/+1YBD/1
Paste contents:
Raw Source | Display As
Please ignore the very last line above (its inclusion was a mistake)

Colorize as:
Show Line Numbers
Index of paste annotations: 1

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.