(defparameter *debug-level* :debug)
(defparameter *debug-levels*
  `((:error . ,(lambda (l) (case l (:error t))))
    (:warn . ,(lambda (l) (case l ((:error :warn) t))))
    (:info . ,(lambda (l) (case l ((:error :warn :info) t))))
    (:debug . ,(lambda (l) (case l ((:error :warn :info :debug) t))))))
(defun set-log-level (level)
  (ecase level
    ((:info :error :warn :debug)
     (setf *debug-level* level))))
(defun f-format (level control-string &rest format-arguments)
  (declare (type keyword *debug-level*))
  (when (funcall
         (cdr (assoc *debug-level* *debug-levels*))
         level)
    (forced-format *error-output* control-string format-arguments)))