/[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.10 by camm, Fri Oct 7 22:00:24 2005 UTC revision 1.11 by camm, Wed Oct 12 19:14:06 2005 UTC
# Line 32  Line 32 
32    
33  (eval-when (compile) (proclaim '(optimize (safety 1) (space 3))))  (eval-when (compile) (proclaim '(optimize (safety 1) (space 3))))
34    
35    (defun make-sequence-vector (element-type size iesp initial-element)
36      (unless element-type
37        (assert-type type '(member list array)))
38      (let ((sequence (si:make-vector element-type size nil nil nil nil nil)))
39        (when iesp
40          (do ((i 0 (1+ i))
41               (size size))
42              ((>= i size))
43              (declare (fixnum i size))
44              (setf (elt sequence i) initial-element)))
45        sequence))
46    
47  (defun make-sequence (type size &key (initial-element nil iesp))  (defun make-sequence (type size &key (initial-element nil iesp))
48    
49    (let ((x (sequence-type-length-type type)))    (let ((x (sequence-type-length-type type)))
50      (when x (assert-type size x)))      (when x (assert-type size x)))
51    (cond    (cond
52       ((member type '(list cons null));;FIXME these are accelerators
53        (make-list size :initial-element (and iesp initial-element)))
54       ((eq type 'string)
55        (make-sequence-vector 'character size iesp initial-element))
56       ((eq type 'vector)
57        (make-sequence-vector t size iesp initial-element))
58     ((subtypep1 type 'list)     ((subtypep1 type 'list)
59      (make-list size :initial-element (and iesp initial-element)))      (make-list size :initial-element (and iesp initial-element)))
60     ((subtypep1 type 'array)     ((subtypep1 type 'array)
61      (let ((element-type (sequence-type-element-type type)))      (make-sequence-vector (sequence-type-element-type type)size iesp initial-element))
       (unless element-type  
         (assert-type type '(member list array)))  
       (let ((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)))  
62     ((assert-type type '(member list array)))))     ((assert-type type '(member list array)))))
63    
64    

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

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