+(declaim (type list *on-package-variance*))
+(defvar *on-package-variance* '(:warn t)
+ "Specifies behavior when redefining a package using DEFPACKAGE and the
+definition is in variance with the current state of the package.
+
+The value should be of the form:
+
+ (:WARN [T | packages-names] :ERROR [T | package-names])
+
+specifying which packages get which behaviour -- with T signifying the default unless
+otherwise specified. If default is not specified, :WARN is used.
+
+:WARN keeps as much state as possible and causes SBCL to signal a full warning.
+
+:ERROR causes SBCL to signal an error when the variant DEFPACKAGE form is executed,
+with restarts provided for user to specify what action should be taken.
+
+Example:
+
+ (setf *on-package-variance* '(:warn (:swank :swank-backend) :error t))
+
+specifies to signal a warning if SWANK package is in variance, and an error otherwise.")
+
+(defun note-package-variance (&rest args &key package &allow-other-keys)
+ (let ((pname (package-name package)))
+ (destructuring-bind (&key warn error) *on-package-variance*
+ (let ((what (cond ((and (listp error) (member pname error :test #'string=))
+ :error)
+ ((and (listp warn) (member pname warn :test #'string=))
+ :warn)
+ ((eq t error)
+ :error)
+ (t
+ :warn))))
+ (ecase what
+ (:error
+ (apply #'error 'sb!kernel::package-at-variance-error args))
+ (:warn
+ (apply #'warn 'sb!kernel::package-at-variance args)))))))
+