(in-package #:portaCL)

(defmacro feature-cond (&body clauses)
  "Some things are best shown by example.  Suppose you have:
  #+clisp (do-clisp-thing-1)
  #+clisp (do-clisp-thing-2)
  #+sbcl (do-sbcl-thing)
  #-(or clisp sbcl) (error \"not implemented\")
Using feature-cond, that would be:
  (feature-cond
    (:clisp (do-clisp-thing-1)
            (do-clisp-thing-2))
    (:sbcl (do-sbcl-thing))
    (t (error \"not implemented\")))

Accordingly, putting cl:t into *features* is not recommended.

In general, this probably won't be very useful: read-time conditionals are
often used to read symbols from packages which may not exist across
implementations.  And, of course, because this is a macro, it cannot appear
in places where it won't be macroexpanded (e.g., the conditions of case).

By the time you're in a position where this is actually useful,
  #-(or a b c) (otherwise-clause)
doesn't seem so bad.  At least it'll look the same as your other feature
conditionals!

Note also that this does NOT provide a run-time check of *features*, but is
instead a macroexpansion-time check."
  (let* ((last-clause (car (last clauses)))
         (otherwise-clause (when (member (car last-clause) '(t otherwise) :test #'eq)
                             last-clause)))
    (when otherwise-clause (setf clauses (butlast clauses)))
    `(progn
       ,@(or (loop :for (cond . body) :in clauses
                   :when (featurep cond)
                     :return body)
             (cdr otherwise-clause)))))

(defmacro feature-econd (&body clauses)
  "Like feature-cond, but automatically adds a final clause issuing a
not-implemented error."
  `(feature-cond ,@clauses (t (error 'not-implemented))))

(defmacro feature-if (feature-expression true-form &optional else-form)
  `(if (featurep ,feature-expression)
       ,true-form
       ,else-form))

(defmacro feature-when (feature-expression &body body)
  `(when (featurep ,feature-expression) ,@body))

(defmacro feature-unless (feature-expression &body body)
  `(unless (featurep ,feature-expression) ,@body))

#+nil
(feature-cond
  (:clisp (do-clisp-thing-1)
          (do-clisp-thing-2))
  (:sbcl (do-sbcl-thing))
  (t (error "not implemented")))

#+nil
(feature-cond
  ((not :clisp) (do-clisp-thing-1)
                (do-clisp-thing-2))
  (:sbcl (do-sbcl-thing))
  (t (error "not implemented")))

#+nil
(feature-cond
  ((or :sbcl :clisp) (do-clisp-thing-1)
                     (do-clisp-thing-2))
  (:clisp (do-sbcl-thing))
  (t (error "not implemented")))

#+nil
(feature-cond
  ((and (not :windows) :sbcl)
   (do-sbcl-thing))
  ((and (or :windows :win32) :clisp)
   (do-clisp-thing-1)
   (do-clisp-thing-2))
  (t (error "not implemented")))

#+nil
(feature-econd
  (:sbcl (do-sbcl-thing))
  (:posix (do-posix-thing)))