X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fknownfun.lisp;h=3b38e95a331d0f92e5f7b9b6c1685848c38c941a;hb=872175cd9cb5b4966a36d4bd92421cc407a0355b;hp=8a1d3fc06d79dfb7354813a8faf1c69a43dc95bc;hpb=0c54eadbdfd0a1ec1e47e067de53bdf4a06330c5;p=sbcl.git diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index 8a1d3fc..3b38e95 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -169,23 +169,22 @@ (info (make-function-info :attributes attributes :derive-type derive-type :optimizer optimizer)) - (target-env (or *backend-info-environment* *info-environment*))) + (target-env *info-environment*)) (dolist (name names) (let ((old-function-info (info :function :info name))) (when old-function-info - ;; This is an error because it's generally a bad thing to blow - ;; away all the old optimization stuff. It's also a potential - ;; source of sneaky bugs: + ;; This is handled as an error because it's generally a bad + ;; thing to blow away all the old optimization stuff. It's + ;; also a potential source of sneaky bugs: ;; DEFKNOWN FOO ;; DEFTRANSFORM FOO ;; DEFKNOWN FOO ; possibly hidden inside some macroexpansion ;; ; Now the DEFTRANSFORM doesn't exist in the target Lisp. ;; However, it's continuable because it might be useful to do ;; it when testing new optimization stuff interactively. - #+nil (cerror "Go ahead, overwrite it." - "overwriting old FUNCTION-INFO for ~S" name) - (warn "~@" - old-function-info name))) + (cerror "Go ahead, overwrite it." + "~@" + old-function-info name))) (setf (info :function :type name target-env) ctype) (setf (info :function :where-from name target-env) :declared) (setf (info :function :kind name target-env) :function) @@ -199,8 +198,12 @@ ;;; through here. (declaim (ftype (function (t) function-info) function-info-or-lose)) (defun function-info-or-lose (name) - (let ((*info-environment* (or *backend-info-environment* - *info-environment*))) + (let (;; FIXME: Do we need this rebinding here? It's a literal + ;; translation of the old CMU CL rebinding to + ;; (OR *BACKEND-INFO-ENVIRONMENT* *INFO-ENVIRONMENT*), + ;; and it's not obvious whether the rebinding to itself is + ;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*. + (*info-environment* *info-environment*)) (let ((old (info :function :info name))) (unless old (error "~S is not a known function." name)) (setf (info :function :info name) (copy-function-info old)))))