From fa869ede20d2297b6dd48eb7f6911c4599793105 Mon Sep 17 00:00:00 2001 From: pw <pw> Date: Sat, 3 Mar 2001 16:50:10 +0000 Subject: [PATCH] Fixes to make proclaim and declaim work as in ANSI spec. --- code/macros.lisp | 6 +++--- compiler/ir1tran.lisp | 22 ++++++++++++---------- compiler/proclaim.lisp | 36 +++++++++++++++++++++--------------- 3 files changed, 36 insertions(+), 28 deletions(-) diff --git a/code/macros.lisp b/code/macros.lisp index 53ff777ea..b30b1597e 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.65 2000/10/06 15:19:59 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.66 2001/03/03 16:50:08 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -365,7 +365,7 @@ value, the old value is not clobbered. The third argument is an optional documentation string for the variable." `(progn - (proclaim '(special ,var)) + (declaim (special ,var)) ,@(when valp `((unless (boundp ',var) (setq ,var ,val)))) @@ -379,7 +379,7 @@ variable special and sets its value to VAL. The third argument is an optional documentation string for the parameter." `(progn - (proclaim '(special ,var)) + (declaim (special ,var)) (setq ,var ,val) ,@(when docp `((setf (documentation ',var 'variable) ',doc))) diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index 46f3bcb95..713de808f 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.121 2001/03/01 21:45:34 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.122 2001/03/03 16:50:10 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2219,7 +2219,8 @@ ;;; processing code. We play with the dynamic environment and eval stuff, then ;;; call Fun with a list of forms to be processed at load time. ;;; -(defun do-eval-when-stuff (situations body fun toplevel-p) + +(defun do-eval-when-stuff (situations body fun &optional toplevel-p) (when (or (not (listp situations)) (set-difference situations '(compile load eval @@ -2227,7 +2228,7 @@ (compiler-error "Bad Eval-When situation list: ~S." situations)) (if toplevel-p - ;; Can only get here from compile-file. + ;; Can only get here from compile-file (progn (when (intersection '(compile :compile-toplevel) situations) (eval `(progn ,@body))) @@ -2246,9 +2247,9 @@ "EVAL-WHEN (Situation*) Form* Evaluate the Forms in the specified Situations, any of :COMPILE-TOPLEVEL, :LOAD-TOPLEVEL, :EXECUTE." - (do-eval-when-stuff - situations body #'(lambda (forms) (ir1-convert-progn-body start cont forms)) - nil)) + (do-eval-when-stuff situations body + #'(lambda (forms) + (ir1-convert-progn-body start cont forms)))) ;;; DO-MACROLET-STUFF -- Interface @@ -2619,8 +2620,9 @@ (make-new-inlinep var (cdr (assoc kind inlinep-translations))))))))) +(defknown %declaim (list) void) -(def-ir1-translator proclaim ((what) start cont :kind :function) +(def-ir1-translator %declaim ((what) start cont :kind :function) (if (constantp what) (let ((form (eval what))) (unless (consp form) @@ -2679,11 +2681,11 @@ form))))) (unless ignore - (%proclaim form)) + (proclaim form)) (if ignore (ir1-convert start cont nil) - (ir1-convert start cont `(%proclaim ,what))))) - (ir1-convert start cont `(%proclaim ,what)))) + (ir1-convert start cont `(proclaim ,what))))) + (ir1-convert start cont `(proclaim ,what)))) ;;; %Compiler-Defstruct IR1 Convert -- Internal diff --git a/compiler/proclaim.lisp b/compiler/proclaim.lisp index 7405c22d2..fa660df2f 100644 --- a/compiler/proclaim.lisp +++ b/compiler/proclaim.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.33 2001/01/18 03:12:42 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.34 2001/03/03 16:50:09 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -307,22 +307,29 @@ ;;; DECLAIM -- Public ;;; -;;; For now, just PROCLAIM without any EVAL-WHEN. -;;; + (defmacro declaim (&rest specs) "DECLAIM Declaration* Do a declaration for the global environment." - `(progn ,@(mapcar #'(lambda (x) - `(proclaim ',x)) - specs))) - + `(progn + (eval-when (:load-toplevel :execute) + ,@(mapcar #'(lambda (x) + `(proclaim ',x)) + specs)) + (eval-when (:compile-toplevel) + ,@(mapcar #'(lambda (x) + `(%declaim ',x)) + specs)))) -;;; %Proclaim -- Interface +(defun %declaim (x) + (proclaim x)) + +;;; %declaim -- Interface ;;; ;;; This function is the guts of proclaim, since it does the global ;;; environment updating. ;;; -(defun %proclaim (form) +(defun proclaim (form) (unless (consp form) (error "Malformed PROCLAIM spec: ~S." form)) @@ -374,8 +381,8 @@ ;; FTYPE. (when *type-system-initialized* (if (and (<= 2 (length args) 3) (listp (second args))) - (%proclaim `(ftype (function . ,(rest args)) ,(first args))) - (%proclaim `(type function . ,args))))) + (proclaim `(ftype (function . ,(rest args)) ,(first args))) + (proclaim `(type function . ,args))))) (optimize (setq *default-cookie* (process-optimize-declaration form *default-cookie*))) @@ -405,15 +412,14 @@ ((start-block end-block)) ; ignore. (t (cond ((member kind type-specifier-symbols) - (%proclaim `(type . ,form))) + (proclaim `(type . ,form))) ((or (info type kind kind) (and (consp kind) (info type translator (car kind)))) - (%proclaim `(type . ,form))) + (proclaim `(type . ,form))) ((not (info declaration recognized kind)) (warn "Unrecognized proclamation: ~S." form)))))) (undefined-value)) -;;; -(setf (symbol-function 'proclaim) #'%proclaim) + ;;; %NOTE-TYPE-DEFINED -- Interface ;;; -- GitLab