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