Writing Macros in Lisp

One should not write Lisp macros arbitrarily (at least, I don’t think so).

I first pretend that I’m just doing symbolic manipulation of static lists.

(defun rpgtk-roll-mods (dice-pool &rest forms)
  `(thread-last dice-pool
      ,(seq-map 'rpgtk--roll-mod-dispatcher forms)))

Dispatcher:

(defun rpgtk--roll-mod-dispatcher (form)
  "Where FORM is a list"
  (if (seq-contains-p form 'die)
      (cl-case (car form)
        (filter `(seq-filter (lambda (die) ,(cdr form))))
        (reducer `(seq-reduce (lambda (acc die) ,(cdr form))))
        (adjuster `(seq-map (lambda (die) ,(cdr form))))
        (t "ouch"))
    (cl-case (car form)
      (filter `(seq-filter (lambda (die) ,(append (cdr form) '(die)))))
      (reducer `(seq-reduce (lambda (acc die) ,(append (cdr form) '(die)))))
      (adjuster `(seq-map (lambda (die) ,(append (cdr form) '(die)))))
      (t "ouch"))))

Where something like:

(rpgtk--roll-mod-dispatcher '(filter evenp))

Basic validation:

(should (equal
         (rpgtk--roll-mod-dispatcher '(adjuster + 3))
         (rpgtk--roll-mod-dispatcher '(adjuster + 3 die))))

Top-level validation:

(rpgtk-roll-mods '(1 2 3)
  '(filter evenp)
  '(adjuster + 3))

Not quite right!

(defun rpgtk-roll-mods (dice-pool &rest forms)
  (cons 'thread-last
        (cons 'dice-pool
              (seq-map 'rpgtk--roll-mod-dispatcher forms)))))

Top-level validation, again:

(rpgtk-roll-mods '(1 2 3)
  '(filter evenp)
  '(adjuster + 3))

That’s it. Now for real:

(defmacro rpgtk-roll-mods (dice-pool &rest forms)
  (cons 'thread-last
        (cons dice-pool
              (seq-map 'rpgtk--roll-mod-dispatcher forms)))))

And a basic test:

(rpgtk-roll-mods '(1 2 3)
  (filter evenp)
  (adjuster + 3))

But … I want to store the results of each transformation.

(defun thread-last-keep (initial-lst &rest forms)
  (let* ((reducer (lambda (acc form)
                    (cons (funcall form (car acc)) acc))))
    (seq-reverse
     (seq-reduce reducer forms (list initial-lst)))))

Validate:

(thread-last-keep '(1 2 3)
                  (lambda (lst) (seq-filter (lambda (d) (evenp d)) lst))
                  (lambda (lst) (seq-map (lambda (d) (+ 4 d)) lst)))

Version 2 where the lambdas are extracted:

(defun thread-last-keep (initial-lst &rest forms)
  (let* ((reducer (lambda (acc form)
                    (cons
                     `((lambda (d) ,form) (car acc))
                     acc))))
    (seq-reverse
     (seq-reduce reducer forms (list initial-lst)))))

(thread-last-keep '(1 2 3)
                  '(seq-filter (lambda (d) (evenp d)) lst)
                  '(seq-map (lambda (d) (+ 4 d)) lst))

Macro that guy:

(defun thread-last-keep (initial-lst &rest forms)
  `(seq-reverse
   (seq-reduce (lambda (acc form)
                 (cons (funcall form (car acc)) acc))
               ,forms ,(list initial-lst))))

(thread-last-keep '(1 2 3)
                  (lambda (lst) (seq-filter (lambda (d) (evenp d)) lst))
                  (lambda (lst) (seq-map (lambda (d) (+ 4 d)) lst)))
(seq-reverse
 (seq-reduce
  (lambda
    (acc form)
    (cons
     (funcall form
              (car acc))
     acc))
  ((lambda
     (lst)
     (seq-filter
      (lambda
        (d)
        (evenp d))
      lst))
   (lambda
     (lst)
     (seq-map
      (lambda
        (d)
        (+ 4 d))
      lst)))
  ((1 2 3))))

Can we get the correct results by replacing it? Let’s start with validating it from a function:

(defun rpgtk-roll-mods (dice-pool &rest forms)
  (cons 'thread-last-keep
        (cons 'dice-pool
              (seq-map 'rpgtk--roll-mod-dispatcher forms))))

(defmacro rpgtk-roll-mods (dice-pool &rest forms)
  (cons 'thread-last-keep
        (cons dice-pool
              (seq-map 'rpgtk--roll-mod-dispatcher forms))))

And the validator:

(rpgtk-roll-mods '(1 2 3)
  (filter evenp)
  (adjuster + 3))

(filter evenp) -> (seq-filter (lambda (die) (evenp die)) dice)
(adjust + 2)   -> (seq-map (lambda (die) (+ 2 die)) dice)
(reduce +)     -> (seq-reduce (lambda (acc die) (+ acc die)) dice 0)
(rpgtk--roll-mod-dispatcher '(reduce +))

(defun rpgtk-dice--roll-mod-dispatcher (form)
  "Return an expanded version of FORM.
Implements DSL for `rpgtk-dice-roll-mod'."
  (unless (seq-contains-p form 'die)
    (setq form (append form '(die))))

  (cl-case (car form)
    (filter `(seq-filter (lambda (die) ,(cdr form)) dice))
    (remove `(seq-remove (lambda (die) ,(cdr form)) dice))
    (reduce `(list (seq-reduce (lambda (acc die) ,(append (cdr form) '(acc))) dice 0)))
    (adjust `(seq-map (lambda (die) ,(cdr form)) dice))
    (t "ouch"))
  (cl-case (car form)
    (sum    `(list (seq-reduce (lambda (acc die) (+ acc die)) dice 0)))
    (-      `(seq-map (lambda (die) '(- die ,(cdr form)))) dice)
    (filter `(seq-filter (lambda (die) ,(append (cdr form) '(die))) dice))
    (remove `(seq-remove (lambda (die) ,(append (cdr form) '(die))) dice))
    (reduce `(list (seq-reduce (lambda (acc die) ,(append (cdr form) '(acc die))) dice 0)))
    (adjust `(seq-map (lambda (die) ,(append (cdr form) '(die))) dice))
    (t "ouch"))))

(defun rpgtk-dice--roll-mods (dice forms)
  (when forms
    (let ((new-dice (eval (rpgtk--roll-mod-dispatcher (car forms)))))
      (cons new-dice
            (rpgtk--roll-mods new-dice (cdr forms))))))

;; (defun rpgtk-roll-mods (dice-pool &rest forms)
;;   "Do it"
;;   (cons dice-pool
;;         (rpgtk--roll-mods dice-pool forms)))

(defmacro rpgtk-dice-roll-mod (dice-pool &rest forms)
  "Transform a list of integers, DICE-POOL, through FORMS.
Where each form can be one of the following:

  (filter func)
 "
  `(cons ,dice-pool
         (rpgtk-dice--roll-mods ,dice-pool ',forms)))

(defun rpgtk-dice-display-roll (roll-of-nums)
  "Convert ROLLS from a list of lists of integers to a string."
  (let ((roll-of-strs (seq-map 'number-to-string roll-of-nums)))
    (concat "「" (string-join roll-of-strs " ") "」")))

(defun rpgtk-dice-display (rolls)
  "Convert ROLLS from a list of lists of integers to a string.
Given:   ((3 4 1 2) (4 2) (6) (-3))
Return: 「3 4 1 2」→「4 2」→「6」→「-3」 "
  (let ((s-rolls (seq-map 'rpgtk-dice-display-roll rolls)))
    (string-join s-rolls "→")))

(rpgtk-dice-display
 (rpgtk-dice-roll-mod '(3 4 1 2)
                      (filter evenp)
                      (reduce +)
                      (adjust - 3)))

(rpgtk-dice-display
 (rpgtk-dice-roll-mod '(3 4 1 2)
                      (filter eq 0 (mod die 3))
                      (reduce +)
                      (adjust - 3)))

(mod 8 3)