(mac bquote (e)
  (let (sub change) (bqex e nil)
    (if change sub (list 'quote e))))

(def bqex (e n)
  (if (no e)   (list nil nil)
      (atom e) (list (list 'quote e) nil)
               (case (car e)
                 bquote   (bqthru e (list n) 'bquote)
                 comma    (if (no n)
                              (list (cadr e) t)
                              (bqthru e (car n) 'comma))
                 comma-at (if (no n)
                              (list (list 'splice (cadr e)) t)
                              (bqthru e (car n) 'comma-at))
                          (bqexpair e n))))

(def bqthru (e n op)
  (let (sub change) (bqex (cadr e) n)
    (if change
        (list (if (caris sub 'splice)
                  `(cons ',op ,(cadr sub))
                  `(list ',op ,sub))
              t)
        (list (list 'quote e) nil))))

(def bqexpair (e n)
  (with ((a achange) (bqex (car e) n)
         (d dchange) (bqex (cdr e) n))
    (if (or achange dchange)
        (list (if (caris d 'splice)
                  (if (caris a 'splice)
                      `(apply append (spa ,(cadr a)) (spd ,(cadr d)))
                      `(apply cons ,a (spd ,(cadr d))))
                  (caris a 'splice)
                  `(append (spa ,(cadr a)) ,d)
                  `(cons ,a ,d))
              t)
        (list (list 'quote e) nil))))

(def spa (x)
  (if (and x (atom x))
      (err 'splice-atom)
      x))

(def spd (x)
  (pcase x
    no   (err 'splice-empty-cdr)
    atom (err 'splice-atom)
    cdr  (err 'splice-multiple-cdrs)
         x))

(mac comma args
  '(err 'comma-outside-backquote))

(mac comma-at args
  '(err 'comma-at-outside-backquote))

(mac splice args
  '(err 'comma-at-outside-list))