Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

;;; -*-CLISP-*-
;;; Make it easier for lusers to avoid redefining a built-in function.
;;; This could surely be refined, but it's good enough for now.

(in-package 'user)
(shadow '(defun defmacro))

(defvar *definitions-already-redefined* nil
  "The definitions the user has said it's OK to redefine anyway")

(lisp::defmacro defun (fn &rest rest)
  `(progn
    (multiple-value-bind (sym type)
			 (find-symbol (symbol-name ',fn) *package*)
      (when (and (eq type :inherited)
		 (fboundp ',fn)
		 (not (member ',fn *definitions-already-redefined*
			      :test #'eq)))
	(cerror "Redefine it anyway"
		"Trying to redefine ~s, which is ~
		inherited from the ~a package.~%~
		This could have DISASTEROUS effects if you're not careful."
		',fn (package-name (symbol-package ',fn)))
	(push ',fn *definitions-already-redefined*)))
    (lisp::defun ,fn ,@rest)))

(setf (documentation 'defun 'function)
      (documentation 'lisp::defun 'function))

(lisp::defmacro defmacro (fn &rest rest)
  `(progn
    (multiple-value-bind (sym type)
			 (find-symbol (symbol-name ',fn) *package*)
      (when (and (eq type :inherited)
		 (fboundp ',fn)
		 (not (member ',fn *definitions-already-redefined*
			      :test #'eq)))
	(cerror "Redefine it anyway"
		"Trying to redefine ~s, which is ~
		inherited from the ~a package.~%~
		This could have DISASTEROUS effects if you're not careful."
		',fn (package-name (symbol-package ',fn)))
	(push ',fn *definitions-already-redefined*)))
    (lisp::defmacro ,fn ,@rest)))

(setf (documentation 'defmacro 'function)
      (documentation 'lisp::defmacro 'function))