clsql/base cmucl-compat.lisp,1.3,1.4

"Kevin M. Rosenberg" <[email protected]> Thu, 1 May 2003 21:05:56 -0600
Newsgroups gmane.lisp.clsql.cvs
Message-ID <[email protected]>
Update of /pubcvs/clsql/base
In directory boa.b9.com:/tmp/cvs-serv1523/base

Modified Files:
	cmucl-compat.lisp 
Log Message:


Index: cmucl-compat.lisp
===================================================================
RCS file: /pubcvs/clsql/base/cmucl-compat.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** cmucl-compat.lisp	21 Oct 2002 07:45:49 -0000	1.3
--- cmucl-compat.lisp	2 May 2003 03:05:54 -0000	1.4
***************
*** 17,21 ****
  ;;;; *************************************************************************
  
- (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  (in-package :cl-user)
  
--- 17,20 ----
***************
*** 57,63 ****
         (let ((,new-vec (make-array ,len :element-type
  				   (array-element-type ,vec))))
! 	 (dotimes (i ,len)
! 	   (declare (fixnum i))
! 	   (setf (aref ,new-vec i) (aref ,vec i)))
  	 (setq ,vec ,new-vec)))
        ((typep ,vec 'vector)
--- 56,64 ----
         (let ((,new-vec (make-array ,len :element-type
  				   (array-element-type ,vec))))
! 	 (check-type ,len fixnum)
! 	 (locally (declare (speed 3) (safety 0) (space 0)) 
! 	   (dotimes (i ,len)
! 	     (declare (fixnum i))
! 	     (setf (aref ,new-vec i) (aref ,vec i))))
  	 (setq ,vec ,new-vec)))
        ((typep ,vec 'vector)
***************
*** 69,93 ****
  
  
! 
! #-(or cmu sbcl scl)
  (defun make-sequence-of-type (type length)
    "Returns a sequence of the given TYPE and LENGTH."
!   (declare (fixnum length))
!   (case type
!     (list 
!      (make-list length))
!     ((bit-vector simple-bit-vector) 
!      (make-array length :element-type '(mod 2)))
!     ((string simple-string base-string simple-base-string)
!      (make-string length))
!     (simple-vector 
!      (make-array length))
!     ((array simple-array vector)
!      (if (listp type)
! 	 (make-array length :element-type (cadr type))
!        (make-array length)))
!     (t
!      (make-sequence-of-type (result-type-or-lose type t) length))))
! 
  
  #+(or cmu scl)
--- 70,77 ----
  
  
! #-(or cmu scl)
  (defun make-sequence-of-type (type length)
    "Returns a sequence of the given TYPE and LENGTH."
!   (make-sequence type length))
  
  #+(or cmu scl)
***************
*** 98,106 ****
      (system::make-sequence-of-type type len)))
  
! #+sbcl
! (defun make-sequence-of-type (type len)
!   (sb-impl::make-sequence-of-type type len))
! 
! #-(or cmu sbcl scl)
  (defun result-type-or-lose (type nil-ok)
    (unless (or type nil-ok)
--- 82,86 ----
      (system::make-sequence-of-type type len)))
  
! #-(or cmu scl)
  (defun result-type-or-lose (type nil-ok)
    (unless (or type nil-ok)
***************
*** 122,127 ****
  (defun result-type-or-lose (type nil-ok)
    (lisp::result-type-or-lose type nil-ok))
- 
- #+sbcl
- (defun result-type-or-lose (type nil-ok)
-   (sb-impl::result-type-or-lose type nil-ok))
--- 102,103 ----