992 |
:fill ,fill :adjust ,adjust |
:fill ,fill :adjust ,adjust |
993 |
:base ,base :displace ,displace))) |
:base ,base :displace ,displace))) |
994 |
,@forms)))))))) |
,@forms)))))))) |
995 |
|
|
996 |
|
(defun make-special-integer-vector (contents &key fill adjust displace (etype 'integer)) |
997 |
|
(let* ((len (length contents)) |
998 |
|
(min (reduce #'min contents)) |
999 |
|
(max (reduce #'max contents)) |
1000 |
|
(len2 (if fill (+ len 4) len))) |
1001 |
|
(unless (and (typep min etype) |
1002 |
|
(typep max etype)) |
1003 |
|
(setq etype `(integer ,min ,max))) |
1004 |
|
(if displace |
1005 |
|
(let ((s0 (make-array (+ len2 5) |
1006 |
|
:initial-contents |
1007 |
|
(concatenate 'list |
1008 |
|
(make-list 2 :initial-element |
1009 |
|
(if (typep 0 etype) 0 min)) |
1010 |
|
contents |
1011 |
|
(make-list (if fill 7 3) |
1012 |
|
:initial-element |
1013 |
|
(if (typep 1 etype) 1 max))) |
1014 |
|
:element-type etype))) |
1015 |
|
(make-array len2 :element-type etype |
1016 |
|
:adjustable adjust |
1017 |
|
:fill-pointer (if fill len nil) |
1018 |
|
:displaced-to s0 |
1019 |
|
:displaced-index-offset 2)) |
1020 |
|
(make-array len2 :element-type etype |
1021 |
|
:initial-contents |
1022 |
|
(if fill (concatenate 'list |
1023 |
|
contents |
1024 |
|
(make-list 4 :initial-element |
1025 |
|
(if (typep 2 etype) 2 (floor (+ min max) 2)))) |
1026 |
|
contents) |
1027 |
|
:fill-pointer (if fill len nil) |
1028 |
|
:adjustable adjust)))) |
1029 |
|
|
1030 |
|
(defmacro do-special-integer-vectors ((var vec-form &optional ret-form) &body forms) |
1031 |
|
(let ((vector (gensym)) |
1032 |
|
(fill (gensym "FILL")) |
1033 |
|
(adjust (gensym "ADJUST")) |
1034 |
|
(etype (gensym "ETYPE")) |
1035 |
|
(displace (gensym "DISPLACE"))) |
1036 |
|
`(let ((,vector ,vec-form)) |
1037 |
|
(dolist (,fill '(nil t) ,ret-form) |
1038 |
|
(dolist (,adjust '(nil t)) |
1039 |
|
(dolist (,etype ',(append (loop for i from 1 to 32 collect `(unsigned-byte ,i)) |
1040 |
|
(loop for i from 2 to 32 collect `(signed-byte ,i)) |
1041 |
|
'(integer))) |
1042 |
|
(dolist (,displace '(nil t)) |
1043 |
|
(let ((,var (make-special-integer-vector |
1044 |
|
,vector |
1045 |
|
:fill ,fill :adjust ,adjust |
1046 |
|
:etype ,etype :displace ,displace))) |
1047 |
|
,@forms)))))))) |