[Sbcl-commits] CVS: sbcl/src/code defstruct.lisp,1.62,1.63 typecheckfuns.lisp,1.6,1.7

[Alexey D. <ade...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv27149/src/code

Modified Files:
	defstruct.lisp typecheckfuns.lisp 
Log Message:
0.8.0.63:
        * Declare return type of structure constructors;
        * make some FTYPE declarations to be "exact";
        * GENERATE-TYPE-CHECKS prints too hairy type in the full form;
        * new optimization quality: INSERT-DEBUG-CATCH;
        * avoid using TYPE-SPECIFIER in the VALUES type deriver.


Index: defstruct.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/defstruct.lisp,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -d -r1.62 -r1.63
--- defstruct.lisp	1 Jun 2003 15:44:54 -0000	1.62
+++ defstruct.lisp	12 Jun 2003 06:41:13 -0000	1.63
@@ -1442,17 +1442,26 @@
     (unless (or defaults boas)
       (push (symbolicate "MAKE-" (dd-name defstruct)) defaults))
 
-    (collect ((res))
+    (collect ((res) (names))
       (when defaults
-	(let ((cname (first defaults)))
-	  (setf (dd-default-constructor defstruct) cname)
-	  (res (create-keyword-constructor defstruct creator))
-	  (dolist (other-name (rest defaults))
-	    (res `(setf (fdefinition ',other-name) (fdefinition ',cname)))
-	    (res `(declaim (ftype function ',other-name))))))
+        (let ((cname (first defaults)))
+          (setf (dd-default-constructor defstruct) cname)
+          (res (create-keyword-constructor defstruct creator))
+          (names cname)
+          (dolist (other-name (rest defaults))
+            (res `(setf (fdefinition ',other-name) (fdefinition ',cname)))
+            (names other-name))))
 
       (dolist (boa boas)
-	(res (create-boa-constructor defstruct boa creator)))
+        (res (create-boa-constructor defstruct boa creator))
+        (names (first boa)))
+
+      (res `(declaim (ftype
+                      (sfunction *
+                                 ,(if (eq (dd-type defstruct) 'structure)
+                                      (dd-name defstruct)
+                                      '*))
+                      ,@(names))))
 
       (res))))
 

Index: typecheckfuns.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/typecheckfuns.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- typecheckfuns.lisp	3 May 2003 18:22:57 -0000	1.6
+++ typecheckfuns.lisp	12 Jun 2003 06:41:13 -0000	1.7
@@ -207,7 +207,7 @@
 ;;; The name is slightly misleading, since some cases are memoized, so
 ;;; we might reuse a value which was made earlier instead of creating
 ;;; a new one from scratch.
-(declaim (ftype (function (t) function) typespec-typecheckfun))
+(declaim (ftype (sfunction (t) function) typespec-typecheckfun))
 (defun typespec-typecheckfun (typespec)
   ;; a general-purpose default case, hopefully overridden by the
   ;; DEFINE-COMPILER-MACRO implementation