From c80afc10a96cdbb473ac1d0099798f8c2da52760 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Sun, 10 Mar 1991 18:28:57 +0000 Subject: [PATCH] In find-free-function, added an assertion that the result is not a deleted function or a let. --- compiler/ir1tran.lisp | 39 ++++++++++++++++++++++----------------- 1 file changed, 22 insertions(+), 17 deletions(-) diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index e3da0f853..de464f5d2 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.36 1991/02/20 14:57:53 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.37 1991/03/10 18:28:57 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1556,22 +1556,27 @@ (proclaim '(function find-free-function (t string) (values global-var inlinep))) (defun find-free-function (name context) (let ((found (gethash name *free-functions*))) - (if found - (values found (leaf-inlinep found)) - (ecase (info function kind name) - (:macro - (compiler-error "Found macro name ~S ~A." name context)) - (:special-form - (compiler-error "Found special-form name ~S ~A." name context)) - ((:function nil) - (check-function-name name) - (note-if-setf-function-and-macro name) - (let ((info (info function accessor-for name))) - (values (setf (gethash name *free-functions*) - (if info - (find-slot-accessor info name) - (find-free-really-function name))) - (info function inlinep name)))))))) + (cond + (found + (assert (not (and (typep found 'functional) + (member (functional-kind found) + '(:deleted :let :mv-let))))) + (values found (leaf-inlinep found))) + (t + (ecase (info function kind name) + (:macro + (compiler-error "Found macro name ~S ~A." name context)) + (:special-form + (compiler-error "Found special-form name ~S ~A." name context)) + ((:function nil) + (check-function-name name) + (note-if-setf-function-and-macro name) + (let ((info (info function accessor-for name))) + (values (setf (gethash name *free-functions*) + (if info + (find-slot-accessor info name) + (find-free-really-function name))) + (info function inlinep name))))))))) ;;; IR1-Convert-Variable -- Internal -- GitLab