From 6b6be557a63512383b3c911ba535019f70b72707 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Wed, 19 Feb 1992 16:14:21 +0000
Subject: [PATCH] Added a :important keyword to deftransform that indicates
 that failure notes should be printed even when speed==brevity.

---
 compiler/knownfun.lisp | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/compiler/knownfun.lisp b/compiler/knownfun.lisp
index cc6183065..5d338fa76 100644
--- a/compiler/knownfun.lisp
+++ b/compiler/knownfun.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/knownfun.lisp,v 1.14 1992/01/31 19:10:22 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/knownfun.lisp,v 1.15 1992/02/19 16:14:21 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -144,7 +144,10 @@
   (function (required-argument) :type function)
   ;;
   ;; String used in efficency notes.
-  (note (required-argument) :type string))
+  (note (required-argument) :type string)
+  ;;
+  ;; T if we should spew a failure note even if speed=brevity.
+  (important nil :type (member t nil)))
 
 (defprinter transform type note)
 
@@ -155,18 +158,21 @@
 ;;; with the same type and note.
 ;;;
 (proclaim '(function %deftransform
-		     (t list function &optional (or string null))))
-(defun %deftransform (name type fun &optional note)
+		     (t list function &optional (or string null)
+			(member t nil))))
+(defun %deftransform (name type fun &optional note important)
   (let* ((ctype (specifier-type type))
 	 (note (or note "optimize"))
 	 (info (function-info-or-lose name))
 	 (old (find-if #'(lambda (x)
 			   (and (type= (transform-type x) ctype)
-				(string-equal (transform-note x) note)))
+				(string-equal (transform-note x) note)
+				(eq (transform-important x) important)))
 		       (function-info-transforms info))))
     (if old
-	(setf (transform-function old) fun  (transform-note old) note)
-	(push (make-transform :type ctype :function fun :note note)
+	(setf (transform-function old) fun (transform-note old) note)
+	(push (make-transform :type ctype :function fun :note note
+			      :important important)
 	      (function-info-transforms info)))
     name))
 
-- 
GitLab