/[gcl]/gcl/lsp/gcl_seq.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_seq.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by camm, Sun Sep 18 02:46:35 2005 UTC revision 1.10 by camm, Fri Oct 7 22:00:24 2005 UTC
# Line 33  Line 33 
33  (eval-when (compile) (proclaim '(optimize (safety 1) (space 3))))  (eval-when (compile) (proclaim '(optimize (safety 1) (space 3))))
34    
35    
36  (defun make-sequence (type size &key (initial-element nil iesp)  (defun make-sequence (type size &key (initial-element nil iesp))
37                                  &aux element-type sequence)    
38    (setq element-type    (let ((x (sequence-type-length-type type)))
39          (cond ((eq type 'list)      (when x (assert-type size x)))
40                 (return-from make-sequence    (cond
41                  (if iesp     ((subtypep1 type 'list)
42                      (make-list size :initial-element initial-element)      (make-list size :initial-element (and iesp initial-element)))
43                      (make-list size))))     ((subtypep1 type 'array)
44                ((or (eq type 'simple-string) (eq type 'string)) 'character)      (let ((element-type (sequence-type-element-type type)))
45                ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit)        (unless element-type
46                ((or (eq type 'simple-vector) (eq type 'vector)) t)          (assert-type type '(member list array)))
47                (t        (let ((sequence (si:make-vector element-type size nil nil nil nil nil)))
48                 (when (subtypep type 'list)          (when iesp
49                   (let ((nn (subtypep type 'null)))            (do ((i 0 (1+ i))
50                     (when (if nn (/= size 0) (= size 0))                 (size size))
51                       (specific-error :wrong-type-argument "~S is not of type ~S."                ((>= i size))
52                                       type (format nil "list (size ~S)" size)))                (declare (fixnum i size))
53                     (return-from make-sequence                (setf (elt sequence i) initial-element)))
54                       (if iesp          sequence)))
55                           (make-list size :initial-element initial-element)     ((assert-type type '(member list array)))))
                          (make-list size)))))  
                (let ((normalized-type (normalize-type type)))  
 ;                 (when (member (car normalized-type) '(cons null))  ;(subtypep (car normalized-type) 'list)  
 ;                   (if (or (and (eq 'null (car normalized-type)) (not (equal size 0)))  
 ;                           (and (eq 'cons (car normalized-type)) (equal size 0)))  
 ;                       (specific-error :wrong-type-argument "~S is not of type ~S."  
 ;                                       type (format nil "list (size ~S)" size)))  
 ;                   (return-from make-sequence  
 ;                     (if iesp  
 ;                         (make-list size :initial-element initial-element)  
 ;                         (make-list size))))  
 ;                 (when (and (equal normalized-type '(member nil)) (equal size 0))  
 ;                   (return-from make-sequence nil))  
                  (unless (or (eq (car normalized-type) 'array)  
                              (eq (car normalized-type) 'simple-array))  
                    (specific-error :wrong-type-argument "~S is not of type ~S."  
                                    type 'sequence))  
                  (let ((ssize (caddr normalized-type)))  
                    (if (listp ssize) (setq ssize (car ssize)))  
                    (if (not (si::fixnump ssize)) (setq ssize size))  
                    (unless (equal ssize size)  
                      (specific-error :wrong-type-argument "~S is not of type ~S."  
                                      type (format nil "~S (size ~S)" type size))))  
                  (or (cadr normalized-type) t)))))  
   (setq element-type (si::best-array-element-type element-type))  
   (setq sequence (si:make-vector element-type size nil nil nil nil nil))  
   (when iesp  
         (do ((i 0 (1+ i))  
              (size size))  
             ((>= i size))  
           (declare (fixnum i size))  
           (setf (elt sequence i) initial-element)))  
   sequence)  
56    
57    
58  (defun concatenate (result-type &rest sequences)  (defun concatenate (result-type &rest sequences)

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26