;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; WITH-COMPILE-TIME-BRANCHING
;;;; © Michał "phoe" Herda 2022
;;;; License: MIT

(defvar *compile-time-branch-bypass* nil
  "Set this to true in order to bypass compile-time branching.")

(define-symbol-macro %true-branches% ())

(defmacro with-compile-time-branching ((&rest branches) &body body
                                       &environment env)
  (cond (*compile-time-branch-bypass*
         `(progn ,@body))
        ((not (null branches))
         (destructuring-bind (branch . other-branches) branches
           (let ((true-branches (macroexpand-1 '%true-branches% env)))
             `(if ,branch
                  (symbol-macrolet ((%true-branches% (,branch . ,true-branches)))
                    (with-compile-time-branching (,@other-branches) ,@body))
                  (with-compile-time-branching (,@other-branches) ,@body)))))
        ((= 0 (length body))
         `(progn))
        ((= 1 (length body))
         (car body))
        (t `(progn ,@body))))

(defmacro compile-time-if (branch then &optional else &environment env)
  (if *compile-time-branch-bypass*
      `(if ,branch ,then ,else)
      (let ((true-branches (macroexpand-1 '%true-branches% env)))
        (if (member branch true-branches)
            then
            (or else `(progn))))))

(defmacro compile-time-when (branch &body body &environment env)
  (if *compile-time-branch-bypass*
      `(when ,branch ,@body)
      (let ((true-branches (macroexpand-1 '%true-branches% env)))
        (if (member branch true-branches)
            `(locally ,@body)
            `(progn)))))

(defmacro compile-time-unless (branch &body body &environment env)
  (if *compile-time-branch-bypass*
      `(unless ,branch ,@body)
      (let ((true-branches (macroexpand-1 '%true-branches% env)))
        (if (member branch true-branches)
            `(progn)
            `(locally ,@body)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; The body of this function...
(defun foo (x y z)
  (with-compile-time-branching (x y z)
    (compile-time-when x
      (print "X is true"))
    (compile-time-unless y
      (print "X is false"))
    (compile-time-if z
      (print "Z is true!")
      (print "Z is false!"))))

;;; ...expands into this:
(defun foo (x y z)
  (if x
      (symbol-macrolet ((%true-branches% (x)))
        (if y
            (symbol-macrolet ((%true-branches% (y x)))
              (if z
                  (symbol-macrolet ((%true-branches% (z y x)))
                    (progn
                      (locally (print "X is true"))
                      (progn)
                      (print "Z is true!")))
                  (progn
                    (locally (print "X is true"))
                    (progn)
                    (print "Z is false!"))))
            (if z
                (symbol-macrolet ((%true-branches% (z x)))
                  (progn
                    (locally (print "X is true"))
                    (locally (print "X is false"))
                    (print "Z is true!")))
                (progn
                  (locally (print "X is true"))
                  (locally (print "X is false"))
                  (print "Z is false!")))))
      (if y
          (symbol-macrolet ((%true-branches% (y)))
            (if z
                (symbol-macrolet ((%true-branches% (z y)))
                  (progn
                    (progn)
                    (progn)
                    (print "Z is true!")))
                (progn
                  (progn)
                  (progn)
                  (print "Z is false!"))))
          (if z
              (symbol-macrolet ((%true-branches% (z)))
                (progn
                  (progn)
                  (locally (print "X is false"))
                  (print "Z is true!")))
              (progn
                (progn)
                (locally (print "X is false"))
                (print "Z is false!"))))))

;;; After cleanup:
(defun foo (x y z)
  (if x
      (if y
          (if z
              (progn
                (print "X is true")
                (print "Z is true!"))
              (progn
                (print "X is true")
                (print "Z is false!")))
          (if z
              (progn
                (print "X is true")
                (print "X is false")
                (print "Z is true!"))
              (progn
                (print "X is true")
                (print "X is false")
                (print "Z is false!"))))
      (if y
          (if z
              (print "Z is true!")
              (print "Z is false!"))
          (if z
              (progn
                (print "X is false")
                (print "Z is true!"))
              (progn
                (print "X is false")
                (print "Z is false!"))))))

;;; Or, if compile-time branching is bypassed, it expands into this:
(defun foo (x y z)
  (progn
    (when x (print "X is true"))
    (unless y (print "X is false"))
    (if z
        (print "Z is true!")
        (print "Z is false!"))))