From ae3338d2f8bf5cb99dc7a858ce0f446f624947a7 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Fri, 20 Aug 1993 17:46:57 +0000
Subject: [PATCH] Flushed compiler-constantp.  Moved some functions here that
 want to be native compiled.

---
 compiler/ir1util.lisp | 84 +++++++++++++++++++++++++++++++++----------
 1 file changed, 65 insertions(+), 19 deletions(-)

diff --git a/compiler/ir1util.lisp b/compiler/ir1util.lisp
index 0c7ccefd7..13d8f65b1 100644
--- a/compiler/ir1util.lisp
+++ b/compiler/ir1util.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/ir1util.lisp,v 1.68 1993/08/17 16:53:10 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.69 1993/08/20 17:46:57 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2172,21 +2172,67 @@
        (undefined-value))))
 
 
-;;; Compiler-Constantp  --  Interface
-;;;
-;;;    We don't want to assume that a variable is a constant just because it is
-;;; in the current lisp environment.
-;;;
-;;; ### For now, just use CONSTANTP to avoid bootstrapping problems with having
-;;; to have the INFO database available at meta-compile time.
-;;;
-(proclaim '(function compiler-constantp (t) boolean))
-(defun compiler-constantp (exp)
-  "Like constantp, only uses the compilation environment rather than the
-  current Lisp environment."
-#|
-  (if (symbolp exp)
-      (eq (info variable kind exp) :constant)
-      (constantp exp))
-|#
-  (constantp exp))
+;;;; Utilities used at run-time for parsing keyword args in IR1:
+
+;;; Find-Keyword-Continuation  --  Internal
+;;;
+;;;    This function is used by the result of Parse-Deftransform to find the
+;;; continuation for the value of the keyword argument Key in the list of
+;;; continuations Args.  It returns the continuation if the keyword is present,
+;;; or NIL otherwise.  The legality and constantness of the keywords should
+;;; already have been checked. 
+;;;
+(proclaim '(function find-keyword-continuation (list keyword) (or continuation null)))
+(defun find-keyword-continuation (args key)
+  (do ((arg args (cddr arg)))
+      ((null arg) nil)
+    (when (eq (continuation-value (first arg)) key)
+      (return (second arg)))))
+
+
+;;; Check-Keywords-Constant  --  Internal
+;;;
+;;;    This function is used by the result of Parse-Deftransform to verify that
+;;; alternating continuations in Args are constant and that there is an even
+;;; number of args.
+;;;
+(proclaim '(function check-keywords-constant (list) boolean))
+(defun check-keywords-constant (args)
+  (do ((arg args (cddr arg)))
+      ((null arg) t)
+    (unless (and (rest arg)
+		 (constant-continuation-p (first arg)))
+      (return nil))))
+
+
+;;; Check-Transform-Keys  --  Internal
+;;;
+;;;    This function is used by the result of Parse-Deftransform to verify that
+;;; the list of continuations Args is a well-formed keyword arglist and that
+;;; only keywords present in the list Keys are supplied.
+;;;
+(proclaim '(function check-transform-keys (list list) boolean))
+(defun check-transform-keys (args keys)
+  (and (check-keywords-constant args)
+       (do ((arg args (cddr arg)))
+	   ((null arg) t)
+	 (unless (member (continuation-value (first arg)) keys)
+	   (return nil)))))
+
+
+;;; %EVENT  --  Interface
+;;;
+;;;    Called by the expansion of the EVENT macro.
+;;;
+(proclaim '(function %event (event-info (or node null))))
+(defun %event (info node)
+  (incf (event-info-count info))
+  (when (and (>= (event-info-level info) *event-note-threshold*)
+	     (if node
+		 (policy node (= brevity 0))
+		 (policy nil (= brevity 0))))
+    (let ((*compiler-error-context* node))
+      (compiler-note (event-info-description info))))
+
+  (let ((action (event-info-action info)))
+    (when action (funcall action node))))
-- 
GitLab