src/utils.lisp @ a6a6f6361af3

;;;; This file was automatically generated by Quickutil.
;;;; See http://quickutil.org for details.

;;;; To regenerate:
;;;; (qtlc:save-utils-as "utils.lisp" :utilities '(:DEFINE-CONSTANT :SET-EQUAL) :ensure-package T :package "BONES.UTILS")

(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless (find-package "BONES.UTILS")
    (defpackage "BONES.UTILS"
      (:documentation "Package that contains Quickutil utility functions.")
      (:use #:cl))))

(in-package "BONES.UTILS")

(when (boundp '*utilities*)
  (setf *utilities* (union *utilities* '(:DEFINE-CONSTANT :SET-EQUAL))))

  (defun %reevaluate-constant (name value test)
    (if (not (boundp name))
        value
        (let ((old (symbol-value name))
              (new value))
          (if (not (constantp name))
              (prog1 new
                (cerror "Try to redefine the variable as a constant."
                        "~@<~S is an already bound non-constant variable ~
                       whose value is ~S.~:@>" name old))
              (if (funcall test old new)
                  old
                  (restart-case
                      (error "~@<~S is an already defined constant whose value ~
                              ~S is not equal to the provided initial value ~S ~
                              under ~S.~:@>" name old new test)
                    (ignore ()
                      :report "Retain the current value."
                      old)
                    (continue ()
                      :report "Try to redefine the constant."
                      new)))))))

  (defmacro define-constant (name initial-value &key (test ''eql) documentation)
    "Ensures that the global variable named by `name` is a constant with a value
that is equal under `test` to the result of evaluating `initial-value`. `test` is a
function designator that defaults to `eql`. If `documentation` is given, it
becomes the documentation string of the constant.

Signals an error if `name` is already a bound non-constant variable.

Signals an error if `name` is already a constant variable whose value is not
equal under `test` to result of evaluating `initial-value`."
    `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
       ,@(when documentation `(,documentation))))
  

  (defun set-equal (list1 list2 &key (test #'eql) (key nil keyp))
    "Returns true if every element of `list1` matches some element of `list2` and
every element of `list2` matches some element of `list1`. Otherwise returns false."
    (let ((keylist1 (if keyp (mapcar key list1) list1))
          (keylist2 (if keyp (mapcar key list2) list2)))
      (and (dolist (elt keylist1 t)
             (or (member elt keylist2 :test test)
                 (return nil)))
           (dolist (elt keylist2 t)
             (or (member elt keylist1 :test test)
                 (return nil))))))
  
(eval-when (:compile-toplevel :load-toplevel :execute)
  (export '(define-constant set-equal)))

;;;; END OF utils.lisp ;;;;