Search code examples
macroslispcommon-lispclos

Lisp - Passing unquoted list to macro


I'm currently experimenting with macro's in Lisp and I would like to write a macro which can handle syntax as follows:

(my-macro (args1) (args2))

The macro should take two lists which would then be available within my macro to do further processing. The catch, however, is that the lists are unquoted to mimic the syntax of some real Lisp/CLOS functions. Is this possible?

Currently I get the following error when attempting to do something like this:

Undefined function ARGS1 called with arguments ().

Thanks in advance!


Solution

  • I think you need to show what you have tried to do. Here is an example of a (silly) macro which has an argument pattern pretty much what yours is:

    (defmacro stupid-let ((&rest vars) (&rest values) &body forms)
      ;; Like LET but with a terrible syntax
      (unless (= (length vars) (length values))
        (error "need exactly one value for each variable"))
      (unless (every #'symbolp vars)
        (error "not every variable is a symbol"))
      `(let ,(mapcar #'list vars values) ,@forms))
    

    Then

    > (macroexpand '(stupid-let (a b c) (1 2 3) (+ a b c)))
    (let ((a 1) (b 2) (c 3)) (+ a b c))
    

    The above macro depends on defmacro's arglist-destructuring, but you don't have to do that:

    (defun proper-list-p (l)
      ;; elaborate version with an occurs check, quadratic.
      (labels ((plp (tail tails)
                 (if (member tail tails)
                     nil
                   (typecase tail
                     (null t)
                     (cons (plp (rest tail) (cons tail tails)))
                     (t nil)))))
        (plp l '())))
    
    (defmacro stupid-let (vars values &body forms)
      ;; Like LET but with a terrible syntax
      (unless (and (proper-list-p vars) (proper-list-p values))
        (error "need lists of variables and values"))
      (unless (= (length vars) (length values))
        (error "need exactly one value for each variable"))
      (unless (every #'symbolp vars)
        (error "not every variable is a symbol"))
      `(let ,(mapcar #'list vars values) ,@forms))
    

    As a slightly more useful example, here is a macro which is a bit like the CLOS with-slots / with-accessors macros:

    (defmacro with-mindless-accessors ((&rest accessor-specifications) thing
                                       &body forms)
      "Use SYMBOL-MACROLET to define mindless accessors for THING.
    
    Each accessor specification is either a symbol which names the symbol
    macro and the accessor, or a list (macroname accessorname) which binds
    macroname to a symbol macro which calls accessornam.  THING is
    evaluated once only."
      (multiple-value-bind (accessors functions)
          (loop for accessor-specification in accessor-specifications
                if (symbolp accessor-specification)
                collect accessor-specification into acs
                and collect accessor-specification into fns
                else if (and (proper-list-p accessor-specification)
                             (= (length accessor-specification) 2)
                             (every #'symbolp accessor-specification))
                collect (first accessor-specification) into acs
                and collect (second accessor-specification) into fns
                else do (error "bad accessor specification ~A" accessor-specification)
                end
                finally (return (values acs fns)))
        (let ((thingn (make-symbol "THING")))
        `(let ((,thingn ,thing))
           (symbol-macrolet ,(loop for accessor in accessors
                                   for function in functions
                                   collect `(,accessor (,function ,thingn)))
             ,@forms)))))
    

    So now we can write this somewhat useless code:

    > (with-mindless-accessors (car cdr) (cons 1 2)
        (setf cdr 3)
        (+ car cdr))
    4
    

    And this:

    > (let ((l (list 1 2)))
        (with-mindless-accessors (second) l
          (setf second 4)
          l))
    (1 4)