(defun %with-options-error (context)
  (wotstr context ": ~A option ~S."))


(defun %with-options-parse (options assocs context)
  (let ((options (mkprlist options)))
    (dolist (option options)
      (block option-found
        (dolist (assoc assocs)
          (let ((kw (car assoc))
                (value (cdr assoc)))
            (when (eq option kw)
              (ensure (not (car value))
                      (%with-options-error context) "duplicate" kw context)
              (setf (car value) t)
              (return-from option-found))))
          (error (%with-options-error context) "incorrect" option context)))))


(defmacro with-options (((&rest allowed-options) options &key (prefix "") (context "WITH-OPTIONS")) &body body)
  "Check a list of OPTIONS (keywords) against the ALLOWED-OPTIONS, and generate bindings accordingly.
Each keyword in OPTIONS generates a T binding, each missing keyword generates a NIL binding.
Bindings are named according to the keyword, optionally PREFIX'ed."
  (when-safe-compilation
    (%check nempty-keywords-list allowed-options 'with-options))
  (let ((symbols (loop :for option :in allowed-options
                    :collect (cons option (read-from-string (catstr prefix (symbol-name option)))))))
    `(let ,(loop :for symbol :in symbols :collect `(,(cdr symbol) (cons nil nil)))
       (%with-options-parse ,options
                            (list ,@(loop :for symbol :in symbols :collect `(cons ,(car symbol) ,(cdr symbol))))
                            ,context)
       (let ,(loop :for symbol :in symbols :collect `(,(cdr symbol) (car ,(cdr symbol))))
         ,@body))))



(defun test (arg &rest options)
  (with-options ((:a :b :c) options :prefix "OPT-")
    (list arg opt-a opt-b opt-c)))


(test 0)       => (0 NIL NIL NIL)
(test 1 :b)    => (1 NIL T NIL)
(test 2 :a :c) => (2 T NIL T)
(test 0 :x)    => ERROR, :X NOT AN ALLOWED OPTION