From: William H. N. <wn...@us...> - 2002-12-14 22:10:15
|
Update of /cvsroot/sbcl/sbcl/src/cold In directory sc8-pr-cvs1:/tmp/cvs-serv26198/src/cold Modified Files: defun-load-or-cload-xcompiler.lisp shared.lisp with-stuff.lisp Log Message: 0.7.10.18: merged Robert E. Brown shush-the-compiler patch (sbcl-devel 2002-12-13) minor changes... ...removed DECLAIM FTYPE for SLOT-ACCESSOR-INLINE-EXPANSION-DESIGNATORS on the theory that it's too fragile (since (1) S-A-I-E-D does currently return functions, but could validly return nonfunctions in some later implementation, and (2) SBCL's declarations-are-assertions still doesn't work right for DECLAIM FTYPE) ...sometimes used THE instead of DECLARE (didn't do yet, but still intend to: add some documentation related to drichards' #lisp question about :NOT-HOST) Index: defun-load-or-cload-xcompiler.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/cold/defun-load-or-cload-xcompiler.lisp,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- defun-load-or-cload-xcompiler.lisp 13 Jun 2002 08:54:37 -0000 1.8 +++ defun-load-or-cload-xcompiler.lisp 14 Dec 2002 22:10:09 -0000 1.9 @@ -13,6 +13,8 @@ ;;; cross-compilation host Common Lisp. (defun load-or-cload-xcompiler (load-or-cload-stem) + (declare (type function load-or-cload-stem)) + ;; The running-in-the-host-Lisp Python cross-compiler defines its ;; own versions of a number of functions which should not overwrite ;; host-Lisp functions. Instead we put them in a special package. Index: shared.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/cold/shared.lisp,v retrieving revision 1.28 retrieving revision 1.29 diff -u -d -r1.28 -r1.29 --- shared.lisp 13 Aug 2002 14:40:41 -0000 1.28 +++ shared.lisp 14 Dec 2002 22:10:09 -0000 1.29 @@ -59,11 +59,12 @@ ;;; a function of one functional argument, which calls its functional argument ;;; in an environment suitable for compiling the target. (This environment ;;; includes e.g. a suitable *FEATURES* value.) +(declaim (type function *in-target-compilation-mode-fn*)) (defvar *in-target-compilation-mode-fn*) -;;; designator for a function with the same calling convention as -;;; CL:COMPILE-FILE, to be used to translate ordinary Lisp source files into -;;; target object files +;;; a function with the same calling convention as CL:COMPILE-FILE, to be +;;; used to translate ordinary Lisp source files into target object files +(declaim (type function *target-compile-file*)) (defvar *target-compile-file*) ;;; designator for a function with the same calling convention as @@ -130,6 +131,8 @@ (compile-file #'compile-file) ignore-failure-p) + (declare (type function compile-file)) + (let* (;; KLUDGE: Note that this CONCATENATE 'STRING stuff is not The Common ;; Lisp Way, although it works just fine for common UNIX environments. ;; Should it come to pass that the system is ported to environments @@ -327,6 +330,7 @@ ;;; Execute function FN in an environment appropriate for compiling the ;;; cross-compiler's source code in the cross-compilation host. (defun in-host-compilation-mode (fn) + (declare (type function fn)) (let ((*features* (cons :sb-xc-host *features*)) ;; the CROSS-FLOAT-INFINITY-KLUDGE, as documented in ;; base-target-features.lisp-expr: Index: with-stuff.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/cold/with-stuff.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- with-stuff.lisp 30 Jan 2002 19:18:29 -0000 1.3 +++ with-stuff.lisp 14 Dec 2002 22:10:10 -0000 1.4 @@ -65,13 +65,17 @@ ;;; helper functions for WITH-ADDITIONAL-NICKNAMES and WITHOUT-GIVEN-NICKNAMES (defun %with-additional-nickname (package-designator nickname body-fn) + (declare (type function body-fn)) (with-additional-nickname (package-designator nickname) (funcall body-fn))) (defun %without-given-nickname (package-designator nickname body-fn) + (declare (type function body-fn)) (without-given-nickname (package-designator nickname) (funcall body-fn))) (defun %multi-nickname-magic (nd-list single-nn-fn body-fn) + (declare (type function single-nn-fn)) (labels ((multi-nd (nd-list body-fn) ; multiple nickname descriptors + (declare (type function body-fn)) (if (null nd-list) (funcall body-fn) (single-nd (first nd-list) @@ -81,6 +85,7 @@ (destructuring-bind (package-descriptor nickname-list) nd (multi-nn package-descriptor nickname-list body-fn))) (multi-nn (nn-list package-descriptor body-fn) ; multiple nicknames + (declare (type function body-fn)) (if (null nn-list) (funcall body-fn) (funcall single-nn-fn |