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 |
|
|