Succinct CL macro

succinct.alma

macro succinct(name, params, body) {
  return quasi {
    macro {{{name}}}(...args) {
      walk(body, [ // this is ',body in lisp, but Alma needs nothing like that :)
        [Q.Identifier, {identifier: walk.anyOf(params)}, sub (n) {
          my pos = params.indexOf(n.identifier);
          return args[pos];
        })]
      ]);
    };
  };
}

succinct.html

<style>
.cl { color: blue; }
.keyword { color: grey; }
.layer-0 { background-color: lightblue; }
.layer-1 { background-color: lightgreen; }
.layer-2 { background-color: pink; }
</style>
<pre>
<span class="layer-0">(<span class="cl">defmacro</span> defsuccincptp (name params <span class="keyword">&rest</span> body)
  </span><span class="layer-1">`(<span class="cl">defmacro</span> </span><span class="layer-0">,name</span><span class="layer-1"> (<span class="keyword">&rest</span> rep)
     (<span class="cl">labels</span> ((walk (n)
                    (<span class="cl">if</span> (<span class="cl">listp</span> n)
                        (<span class="cl">mapcar</span> #'walk n)
                      (<span class="cl">let</span> ((pos (<span class="cl">position</span> n '</span><span class="layer-0">,params</span><span class="layer-1"> <span class="keyword">:test</span> #'eq)))
                        (<span class="cl">if</span> (<span class="cl">null</span> pos)
                            n
                            (<span class="cl">nth</span> pos rep))))))
       </span><span class="layer-2">`(<span class="cl">progn</span> </span><span class="layer-1">,@(<span class="cl">mapcar</span> #'walk '</span><span class="layer-0">,body</span><span class="layer-1">)</span><span class="layer-2">)</span><span class="layer-1">))</span><span class="layer-0">)</span>
</pre>

succinct.lisp

(defmacro defsuccinct (name params &rest body)
  `(defmacro ,name (&rest rep)
     (labels ((walk (n)
                    (if (listp n)
                        (mapcar #'walk n)
                      (let ((pos (position n ',params :test #'eq)))
                        (if (null pos)
                            n
                            (nth pos rep))))))
       `(progn ,@(mapcar #'walk ',body)))))
(defsuccinct swap (a b)
  (let ((tmp a))
    (setq a b)
    (setq b tmp)))

(defparameter *a* 1)
(defparameter *b* 2)
(swap *a* *b*)
(format t "hey ~d ~d" *a* *b*)
; => 2 1