1;; -*- Lisp -*- vim:filetype=lisp 2 3(FORMAT T "~%double-float arrays~%") NIL 4 5(EQUALP 6 (SETQ DA1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS 7 '(((1.0D0 2.0D0 3.0D0) (4.0D0 5.0D0 6.0D0)) 8 ((7.0D0 8.0D0 9.0D0) (10.0D0 11.0D0 12.0D0)) 9 ((13.0D0 14.0D0 15.0D0) (16.0D0 17.0D0 18.0D0)) 10 ((19.0D0 20.0D0 21.0D0) (22.0D0 23.0D0 24.0D0))) 11 :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT))) 12 '#3A(((1.0D0 2.0D0 3.0D0)(4.0D0 5.0D0 6.0D0)) 13 ((7.0D0 8.0D0 9.0D0)(10.0D0 11.0D0 12.0D0)) 14 ((13.0D0 14.0D0 15.0D0)(16.0D0 17.0D0 18.0D0)) 15 ((19.0D0 20.0D0 21.0D0) (22.0D0 23.0D0 24.0D0)))) 16T 17 18(AREF DA1 0 0 0) 1.0D0 19 20(AREF DA1 0 0 1) 2.0D0 21 22(AREF DA1 0 0 2) 3.0D0 23 24(AREF DA1 0 1 0) 4.0D0 25 26(AREF DA1 0 1 1) 5.0D0 27 28(AREF DA1 0 1 2) 6.0D0 29 30(AREF DA1 1 0 0) 7.0D0 31 32(AREF DA1 1 0 1) 8.0D0 33 34(AREF DA1 1 0 2) 9.0D0 35 36(AREF DA1 1 1 0) 10.0D0 37 38(AREF DA1 1 1 1) 11.0D0 39 40(AREF DA1 1 1 2) 12.0D0 41 42(AREF DA1 2 0 0) 13.0D0 43 44(AREF DA1 2 0 1) 14.0D0 45 46(AREF DA1 2 0 2) 15.0D0 47 48(AREF DA1 2 1 0) 16.0D0 49 50(AREF DA1 2 1 1) 17.0D0 51 52(AREF DA1 2 1 2) 18.0D0 53 54(AREF DA1 3 0 0) 19.0D0 55 56(AREF DA1 3 0 1) 20.0D0 57 58(AREF DA1 3 0 2) 21.0D0 59 60(AREF DA1 3 1 0) 22.0D0 61 62(AREF DA1 3 1 1) 23.0D0 63 64(AREF DA1 3 1 1) 23.0D0 65 66(FORMAT T "~%single-float arrays~%") NIL 67 68(EQUALP (SETQ FA1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS 69 '(((1.0 2.0 3.0) (4.0 5.0 6.0)) 70 ((7.0 8.0 9.0) (10.0 11.0 12.0)) 71 ((13.0 14.0 15.0) (16.0 17.0 18.0)) 72 ((19.0 20.0 21.0) (22.0 23.0 24.0))) 73 :ELEMENT-TYPE (QUOTE SINGLE-FLOAT))) 74 '#3A(((1.0 2.0 3.0)(4.0 5.0 6.0)) 75 ((7.0 8.0 9.0)(10.0 11.0 12.0)) 76 ((13.0 14.0 15.0)(16.0 17.0 18.0)) 77 ((19.0 20.0 21.0)(22.0 23.0 24.0)))) 78T 79 80(AREF FA1 0 0 0) 1.0 81 82(AREF FA1 0 0 1) 2.0 83 84(AREF FA1 0 0 2) 3.0 85 86(AREF FA1 0 1 0) 4.0 87 88(AREF FA1 0 1 1) 5.0 89 90(AREF FA1 0 1 2) 6.0 91 92(AREF FA1 1 0 0) 7.0 93 94(AREF FA1 1 0 1) 8.0 95 96(AREF FA1 1 0 2) 9.0 97 98(AREF FA1 1 1 0) 10.0 99 100(AREF FA1 1 1 1) 11.0 101 102(AREF FA1 1 1 2) 12.0 103 104(AREF FA1 2 0 0) 13.0 105 106(AREF FA1 2 0 1) 14.0 107 108(AREF FA1 2 0 2) 15.0 109 110(AREF FA1 2 1 0) 16.0 111 112(AREF FA1 2 1 1) 17.0 113 114(AREF FA1 2 1 2) 18.0 115 116(AREF FA1 3 0 0) 19.0 117 118(AREF FA1 3 0 1) 20.0 119 120(AREF FA1 3 0 2) 21.0 121 122(AREF FA1 3 1 0) 22.0 123 124(AREF FA1 3 1 1) 23.0 125 126(AREF FA1 3 1 1) 23.0 127 128(FORMAT T "~%array limits~%") NIL 129 130(let ((s (prin1-to-string ARRAY-RANK-LIMIT ))) 131 (or #+XCL (equal s "256") 132 #+CLISP (equal s "4294967296") #+CLISP (equal s "65536") 133 #+CLISP (equal s (prin1-to-string lambda-parameters-limit)) 134 #+(or AKCL ECL) (equal s "64") #+GCL (equal s "63") 135 #+ALLEGRO (equal s "65536") 136 #+(or CMU SBCL) (equal s "65529") 137 #+OpenMCL (equal s "8192") 138 #+LISPWORKS (equal s "253") 139 #-(or XCL CLISP AKCL ECL GCL ALLEGRO CMU SBCL OpenMCL LISPWORKS) "UNKNOWN")) 140T 141 142(let ((s (prin1-to-string ARRAY-DIMENSION-LIMIT ))) 143 (or #+XCL (equal s "17920") 144 #+(or AKCL ECL) (equal s "16777216") #+GCL (equal s "2147483647") 145 #+CLISP (equal s "4294967296") 146 #+CLISP (equal s (prin1-to-string most-positive-fixnum)) 147 #+(and CLISP MACOS WORD-SIZE=64) (equal s "16777215") 148 #+ALLEGRO (equal s "16777216") 149 #+(or CMU SBCL) (equal s "536870911") 150 #+OpenMCL (equal s "16777216") 151 #+LISPWORKS (equal s "8388607") 152 #-(or XCL CLISP AKCL ECL GCL ALLEGRO CMU SBCL OpenMCL LISPWORKS) "UNKNOWN")) 153T 154 155(let ((s (prin1-to-string ARRAY-TOTAL-SIZE-LIMIT ))) 156 (or #+XCL (equal s "17920") 157 #+(or AKCL ECL) (equal s "16777216") #+GCL (equal s "2147483647") 158 #+CLISP (equal s "4294967296") 159 #+CLISP (equal s (prin1-to-string most-positive-fixnum)) 160 #+(and CLISP MACOS WORD-SIZE=64) (equal s "16777215") 161 #+ALLEGRO (equal s "16777216") 162 #+(or CMU SBCL) (equal s "536870911") 163 #+OpenMCL (equal s "16777216") 164 #+LISPWORKS (equal s "1048448") 165 #-(or XCL CLISP AKCL ECL GCL ALLEGRO CMU SBCL OpenMCL LISPWORKS) "UNKNOWN")) 166T 167 168(<= ARRAY-DIMENSION-LIMIT ARRAY-TOTAL-SIZE-LIMIT) 169T 170 171(FORMAT T "~%simple vectors~%") NIL 172 173(EQUALP (SETQ SV (VECTOR (QUOTE A) (QUOTE B) (QUOTE C) 1.0S0 3.7D0 4.1)) 174 '#(A B C 1.0S0 3.7D0 4.1)) 175T 176 177(SVREF SV 0) A 178 179(SVREF SV 1) B 180 181(SVREF SV 2) C 182 183(SVREF SV 3) 1.0S0 184 185(SVREF SV 4) 3.7D0 186 187(FORMAT T "~%set elements~%") NIL 188 189(SETF (SVREF SV 0) (QUOTE TEST)) TEST 190 191(EQUALP SV '#(TEST B C 1.0S0 3.7D0 4.1)) T 192 193(FORMAT T "~%test array-element-type~%") NIL 194 195(ARRAY-ELEMENT-TYPE SV) T 196 197(ARRAY-ELEMENT-TYPE DA1) 198#+(or XCL ALLEGRO CMU SBCL OpenMCL LISPWORKS) DOUBLE-FLOAT #+CLISP T #+(or AKCL ECL) LONG-FLOAT 199#-(or XCL CLISP AKCL ECL ALLEGRO CMU SBCL OpenMCL LISPWORKS) UNKNOWN 200 201(FORMAT T "~%test rank~%") NIL 202 203(ARRAY-RANK DA1) 3 204 205(ARRAY-RANK FA1) 3 206 207(FORMAT T "~%test individual dimensions~%") NIL 208 209(ARRAY-DIMENSION DA1 0) 4 210 211(ARRAY-DIMENSION DA1 1) 2 212 213(ARRAY-DIMENSION DA1 2) 3 214 215(ARRAY-DIMENSION DA1 3) ERROR 216 217(FORMAT T "~%0-dim. array pseudo-scalar with contents mod 5~%") NIL 218 219(PROGN (SETQ ZERO (MAKE-ARRAY (QUOTE NIL) :ELEMENT-TYPE (QUOTE (MOD 5)))) T) 220T 221 222(ARRAY-RANK ZERO) 0 223 224(SETF (AREF ZERO) 4) 4 225 226(SETF (AREF ZERO) 1.0) 227#+(or XCL CLISP AKCL ECL ALLEGRO CMU SBCL OpenMCL LISPWORKS) ERROR 228#-(or XCL CLISP AKCL ECL ALLEGRO CMU SBCL OpenMCL LISPWORKS) UNKNOWN 229 230(FORMAT T "~%3-dim general array~%") NIL 231 232(EQUALP (SETQ A1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS 233 '(((A B C) (1 2 3)) ((D E F) (3 1 2)) 234 ((G H I) (2 3 1)) ((J K L) (0 0 0))))) 235 '#3A(((A B C)(1 2 3))((D E F)(3 1 2)) 236 ((G H I)(2 3 1))((J K L)(0 0 0)))) 237T 238 239(AREF A1 0 0 0) A 240 241(AREF A1 0 0 1) B 242 243(AREF A1 0 0 2) C 244 245(AREF A1 0 1 0) 1 246 247(AREF A1 0 1 1) 2 248 249(AREF A1 0 1 2) 3 250 251(AREF A1 1 0 0) D 252 253(AREF A1 1 0 1) E 254 255(AREF A1 1 0 2) F 256 257(AREF A1 1 1 0) 3 258 259(AREF A1 1 1 1) 1 260 261(AREF A1 1 1 2) 2 262 263(AREF A1 2 0 0) G 264 265(AREF A1 2 0 1) H 266 267(AREF A1 2 0 2) I 268 269(AREF A1 2 1 0) 2 270 271(AREF A1 2 1 1) 3 272 273(AREF A1 2 1 2) 1 274 275(AREF A1 3 0 0) J 276 277(AREF A1 3 0 1) K 278 279(AREF A1 3 0 2) L 280 281(AREF A1 3 1 0) 0 282 283(AREF A1 3 1 1) 0 284 285(AREF A1 3 1 1) 0 286 287(FORMAT T "~%2-dim adjustable displaced array~%") NIL 288 289(PROGN (SETQ M (MAKE-ARRAY (QUOTE (4 4)) :ADJUSTABLE T :INITIAL-CONTENTS 290 '((ALPHA BETA GAMMA DELTA) (EPSILON ZETA ETA THETA) 291 (IOTA KAPPA LAMBDA MU) (NU XI OMICRON PI)))) T) 292T 293 294(AREF M 0 0) ALPHA 295 296(AREF M 0 1) BETA 297 298(AREF M 0 2) GAMMA 299 300(AREF M 0 3) DELTA 301 302(AREF M 1 0) EPSILON 303 304(AREF M 1 1) ZETA 305 306(AREF M 1 2) ETA 307 308(AREF M 1 3) THETA 309 310(AREF M 2 0) IOTA 311 312(AREF M 2 1) KAPPA 313 314(AREF M 2 2) LAMBDA 315 316(AREF M 2 3) MU 317 318(AREF M 3 0) NU 319 320(AREF M 3 1) XI 321 322(AREF M 3 2) OMICRON 323 324(AREF M 3 3) PI 325 326(FORMAT T "~%sisplaced~%") NIL 327 328(equalp (SETQ MD0 (MAKE-ARRAY 4 :DISPLACED-TO M)) 329 '#(ALPHA BETA GAMMA DELTA)) 330t 331 332(equalp (SETQ MD1 (MAKE-ARRAY 4 :DISPLACED-TO M :DISPLACED-INDEX-OFFSET 4)) 333 '#(EPSILON ZETA ETA THETA)) 334t 335 336(equalp (SETQ MD2 (MAKE-ARRAY 4 :DISPLACED-TO M :DISPLACED-INDEX-OFFSET 8)) 337 '#(IOTA KAPPA LAMBDA MU)) 338t 339 340(FORMAT T "~%adjust m~%") NIL 341 342(PROGN (ADJUST-ARRAY M (QUOTE (3 5)) :INITIAL-ELEMENT (QUOTE BAZ)) T) T 343 344(AREF M 0 0) ALPHA 345 346(AREF M 0 1) BETA 347 348(AREF M 0 2) GAMMA 349 350(AREF M 0 3) DELTA 351 352(AREF M 0 4) BAZ 353 354(AREF M 1 0) EPSILON 355 356(AREF M 1 1) ZETA 357 358(AREF M 1 2) ETA 359 360(AREF M 1 3) THETA 361 362(AREF M 1 4) BAZ 363 364(AREF M 2 0) IOTA 365 366(AREF M 2 1) KAPPA 367 368(AREF M 2 2) LAMBDA 369 370(FORMAT T "~%Test interaction of the keywords~%") NIL 371 372(PROGN (SETQ DV (MAKE-ARRAY 10 :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT) 373 :INITIAL-CONTENTS 374 '(0.0D0 1.0D0 2.0D0 3.0D0 4.0D0 5.0D0 6.0D0 375 7.0D0 8.0D0 9.0D0))) 376 T) 377T 378#| *************************************************************************** 379 (SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT) 380 :INITIAL-CONTENTS '((1.0D0 2.0D0) (3.0D0 4.0D0 5.0D0)))) 381 ERROR 382 383 (SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT) 384 :INITIAL-CONTENTS '((1.0D0 2.0D0) (3.0D0 4.0D0)) 385 :DISPLACED-TO DV :DISPLACED-INDEX-OFFSET 8)) 386 ERROR 387 388 (SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT) 389 :INITIAL-CONTENTS (QUOTE ((1.0D0 2.0D0) (3.0D0 4.0D0))) 390 :DISPLACED-TO DV :DISPLACED-INDEX-OFFSET 8)) 391 ERROR 392 393 (SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT) 394 :DISPLACED-TO DV :DISPLACED-INDEX-OFFSET 8)) 395 ERROR 396***************************************************************************|# 397 398(AREF DV 0) 0.0D0 399 400(AREF DV 1) 1.0D0 401 402(AREF DV 2) 2.0D0 403 404(AREF DV 3) 3.0D0 405 406(AREF DV 4) 4.0D0 407 408(AREF DV 5) 5.0D0 409 410(AREF DV 6) 6.0D0 411 412(AREF DV 7) 7.0D0 413 414(AREF DV 8) 8.0D0 415 416(AREF DV 9) 9.0D0 417 418(SETF (AREF DV 5) -5.0D0) -5.0D0 419 420(FORMAT T "~%test indeces~%") NIL 421 422(DEFUN ARRAY-INDEX-TEST (A &REST SUBS) 423 (UNLESS (APPLY (FUNCTION ARRAY-IN-BOUNDS-P) A SUBS) 424 (RETURN-FROM ARRAY-INDEX-TEST (QUOTE ERROR))) 425 (= (APPLY (FUNCTION ARRAY-ROW-MAJOR-INDEX) A SUBS) 426 (APPLY (FUNCTION +) 427 (MAPLIST #'(LAMBDA (X Y) (* (CAR X) (APPLY (FUNCTION *) (CDR Y)))) 428 SUBS (ARRAY-DIMENSIONS A))))) 429ARRAY-INDEX-TEST 430 431(ARRAY-INDEX-TEST (MAKE-ARRAY (QUOTE (5 4 3 2 1))) 4 2 2 1 0) 432T 433 434(ARRAY-INDEX-TEST (MAKE-ARRAY (QUOTE (5 4 3 2 1))) 3 4 2 1 2) 435ERROR 436 437(FORMAT T "~%bitvectors~%") NIL 438 439(SETQ BVZERO (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) 440#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 441 442(SETQ BVONE (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 1)) 443#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 444 445(SETQ BV3 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) 446#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 447 448(SETQ BV2 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) 449#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 450 451(SETQ BV1 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) 452#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 453 454(FORMAT T "~%set bitvectors~%") NIL 455 456(DOTIMES (I 50 BV1) (SETF (SBIT BV1 (* I 2)) 1)) 457#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010 458 459(DOTIMES (I 50 BV2) (SETF (BIT BV2 (* I 2)) 1)) 460#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010 461 462(EQUALP BV1 BV2) T 463(DOTIMES (I 25 BV3) (SETF (SBIT BV3 (* I 4)) 1)) 464#*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000 465 466(BIT-AND BV1 BV3) 467#*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000 468 469(BIT-IOR BV1 BV3) 470#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010 471 472(BIT-XOR BV1 BV3) 473#*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010 474 475(BIT-EQV BV1 BV3) 476#*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101 477 478(BIT-NAND BV1 BV3) 479#*0111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111 480 481(BIT-ANDC1 BV1 BV3) 482#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 483 484(BIT-ANDC2 BV1 BV3) 485#*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010 486 487(BIT-ORC1 BV1 BV3) 488#*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101 489 490(BIT-ORC2 BV1 BV3) 491#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 492 493(BIT-NOT BV1) 494#*0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101 495 496(BIT-NOT BVZERO) 497#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 498 499(BIT-NOT BVONE) 500#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 501 502(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) 503 (s2 (make-array nil :initial-element 1 :element-type 'bit))) 504 (list (bit-xor s1 s2) s1 s2)) 505(#0A1 #0A0 #0A1) 506 507(let* ((a1 (make-array '(2 2) :element-type 'bit :initial-contents '((0 1) (0 1)))) 508 (a2 (make-array '(2 2) :element-type 'bit :initial-contents '((0 0) (1 1)))) 509 (result (bit-and a1 a2))) 510 (list a1 a2 result)) 511(#2A((0 1) (0 1)) #2A((0 0) (1 1)) #2A((0 0) (0 1))) 512 513(FORMAT T "~%test operations with fill-pointer~%") NIL 514 515(MAKE-ARRAY (QUOTE (3 4 5)) :FILL-POINTER T) ERROR 516 517(equalp (MAKE-ARRAY 5 :FILL-POINTER 5) 518 #+(or XCL CMU SBCL OpenMCL) '#(0 0 0 0 0) #-(or XCL CMU SBCL OpenMCL) '#(nil nil nil nil nil)) 519T 520 521(MAKE-ARRAY 5 :FILL-POINTER -5) ERROR 522 523(FORMAT T "~%general vector with fillpointer~%") NIL 524 525(PROGN (SETQ VMF (MAKE-ARRAY 5 :FILL-POINTER 0)) T) T 526 527(FILL-POINTER VMF) 0 528 529(VECTOR-PUSH (QUOTE A) VMF) 0 530 531(FILL-POINTER VMF) 1 532 533(VECTOR-PUSH (QUOTE B) VMF) 1 534 535(VECTOR-PUSH (QUOTE C) VMF) 2 536 537(VECTOR-PUSH (QUOTE D) VMF) 3 538 539(VECTOR-PUSH (QUOTE E) VMF) 4 540 541(VECTOR-PUSH (QUOTE VOLL) VMF) NIL 542 543(VECTOR-POP VMF) E 544 545(VECTOR-POP VMF) D 546 547(VECTOR-POP VMF) C 548 549(VECTOR-POP VMF) B 550 551(VECTOR-POP VMF) A 552 553(VECTOR-POP VMF) ERROR 554 555(format t "~%adjustable general vector with fillpointer~%") NIL 556 557(PROGN (SETQ VMFA (MAKE-ARRAY 5 :FILL-POINTER 0 :ADJUSTABLE T)) T) 558T 559 560(FILL-POINTER VMFA) 0 561 562(VECTOR-PUSH-EXTEND (QUOTE A) VMFA) 0 563 564(FILL-POINTER VMFA) 1 565 566(VECTOR-PUSH-EXTEND (QUOTE B) VMFA) 1 567 568(VECTOR-PUSH-EXTEND (QUOTE C) VMFA) 2 569 570(VECTOR-PUSH-EXTEND (QUOTE D) VMFA) 3 571 572(VECTOR-PUSH-EXTEND (QUOTE E) VMFA) 4 573 574(VECTOR-PUSH-EXTEND (QUOTE VOLL) VMFA) 5 575 576(VECTOR-POP VMFA) VOLL 577 578(VECTOR-POP VMFA) E 579 580(VECTOR-POP VMFA) D 581 582(VECTOR-POP VMFA) C 583 584(VECTOR-POP VMFA) B 585 586(VECTOR-POP VMFA) A 587 588(FORMAT T "~%Doppeltgen. Vector mit Fillpointer ~%") NIL 589 590(PROGN (SETQ VMFD (MAKE-ARRAY 5 :FILL-POINTER 0 :ELEMENT-TYPE 'DOUBLE-FLOAT)) 591 T) 592T 593 594(FILL-POINTER VMFD) 0 595 596(VECTOR-PUSH 0.0D0 VMFD) 0 597 598(FILL-POINTER VMFD) 1 599 600(VECTOR-PUSH 1.0D0 VMFD) 1 601 602(VECTOR-PUSH 2.0D0 VMFD) 2 603 604(VECTOR-PUSH 3.0D0 VMFD) 3 605 606(VECTOR-PUSH 4.0D0 VMFD) 4 607 608(VECTOR-PUSH 5.0D0 VMFD) NIL 609 610(VECTOR-POP VMFD) 4.0D0 611 612(VECTOR-POP VMFD) 3.0D0 613 614(VECTOR-POP VMFD) 2.0D0 615 616(VECTOR-POP VMFD) 1.0D0 617 618(VECTOR-POP VMFD) 0.0D0 619 620(VECTOR-POP VMFD) ERROR 621 622(PROGN (SETQ VMFAD (MAKE-ARRAY 5 :FILL-POINTER 0 :ELEMENT-TYPE 'DOUBLE-FLOAT 623 :ADJUSTABLE T)) 624 T) 625T 626 627(FILL-POINTER VMFAD) 0 628 629(VECTOR-PUSH-EXTEND 0.0D0 VMFAD) 0 630 631(FILL-POINTER VMFAD) 1 632 633(VECTOR-PUSH-EXTEND 1.0D0 VMFAD) 1 634 635(VECTOR-PUSH-EXTEND 2.0D0 VMFAD) 2 636 637(VECTOR-PUSH-EXTEND 3.0D0 VMFAD) 3 638 639(VECTOR-PUSH-EXTEND 4.0D0 VMFAD) 4 640 641(VECTOR-PUSH-EXTEND 5.0D0 VMFAD) 5 642 643(setf (fill-pointer vmfad) 3) 3 644 645(aref vmfad 5) 5.0D0 646 647(elt vmfad 5) error 648 649(setf (fill-pointer vmfad) 6) 6 650 651VMFAD #(0d0 1d0 2d0 3d0 4d0 5d0) 652 653(REVERSE VMFAD) #(5d0 4d0 3d0 2d0 1d0 0d0) 654 655(NREVERSE VMFAD) #(5d0 4d0 3d0 2d0 1d0 0d0) 656 657VMFAD #(5d0 4d0 3d0 2d0 1d0 0d0) 658 659(VECTOR-POP VMFAD) 0.0D0 660 661(VECTOR-POP VMFAD) 1.0D0 662 663(VECTOR-POP VMFAD) 2.0D0 664 665(VECTOR-POP VMFAD) 3.0D0 666 667(VECTOR-POP VMFAD) 4.0D0 668 669(VECTOR-POP VMFAD) 5.0D0 670 671(VECTOR-PUSH-EXTEND 5.0S0 VMFAD) 672#+(or XCL GCL ALLEGRO CMU SBCL OpenMCL) ERROR #+(or CLISP (and AKCL (not GCL)) ECL LISPWORKS) 0 673#-(or XCL CLISP AKCL ECL ALLEGRO CMU SBCL OpenMCL LISPWORKS) UNKNOWN 674 675;; (VECTOR NIL) 676(upgraded-array-element-type nil) 677nil 678 679(arrayp (setq nil-arr (make-array '(10 20) :element-type nil))) 680t 681 682(array-element-type 683 (setq nil-vec (make-array 4 :element-type nil 684 :displaced-to nil-arr 685 :displaced-index-offset 2))) 686nil 687 688(typep nil-vec 'sequence) 689t 690 691(aref nil-arr 2 2) 692error 693 694(setf (aref nil-vec 1) 0) 695error 696 697(fill nil-vec 1) 698error 699 700(replace nil-vec #(0 1 0 1)) 701error 702 703(replace #(0 1 0 1) nil-vec) 704error 705 706(progn (copy-seq nil-vec) #-CLISP nil) 707#+CLISP #A(NIL (4)) 708#-CLISP NIL 709 710(setq nil-vec nil nil-arr nil) 711nil 712 713;; <http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/fun_adjust-array.html> 714(adjustable-array-p 715 (setq ada (adjust-array 716 (make-array '(2 3) 717 :adjustable t 718 :initial-contents '((a b c) (1 2 3))) 719 '(4 6)))) 720T 721(array-dimensions ada) (4 6) 722(aref ada 1 1) 2 723(setq beta (make-array '(2 3) :adjustable t)) 724#+(or CMU SBCL OpenMCL) 725#2A((0 0 0) (0 0 0)) 726#-(or CMU SBCL OpenMCL) 727#2A((NIL NIL NIL) (NIL NIL NIL)) 728(adjust-array beta '(4 6) :displaced-to ada) 729#+(or CMU SBCL OpenMCL) 730#2A((A B C 0 0 0) 731 (1 2 3 0 0 0) 732 (0 0 0 0 0 0) 733 (0 0 0 0 0 0)) 734#-(or CMU SBCL OpenMCL) 735#2A((A B C NIL NIL NIL) 736 (1 2 3 NIL NIL NIL) 737 (NIL NIL NIL NIL NIL NIL) 738 (NIL NIL NIL NIL NIL NIL)) 739(array-dimensions beta) (4 6) 740(aref beta 1 1) 2 741 742(adjust-array 743 #2A(( alpha beta gamma delta ) 744 ( epsilon zeta eta theta ) 745 ( iota kappa lambda mu ) 746 ( nu xi omicron pi )) 747 '(3 5) :initial-element 'baz) 748#2A(( alpha beta gamma delta baz ) 749 ( epsilon zeta eta theta baz ) 750 ( iota kappa lambda mu baz )) 751 752 753(adjust-array #(1 2 3 4) '(6)) 754#+(or CMU SBCL OpenMCL) 755#(1 2 3 4 0 0) 756#-(or CMU SBCL OpenMCL) 757#(1 2 3 4 NIL NIL) 758 759(let* ((a1 (make-array 5 :initial-contents '(a b c d e) :fill-pointer 3)) 760 (a2 (adjust-array a1 8 :fill-pointer 5 :initial-element 'x))) 761 (assert (if (adjustable-array-p a1) (eq a1 a2) 762 (equal (array-dimensions a1) '(5)))) 763 (assert (not (array-displacement a2))) 764 (list (array-dimensions a2) (fill-pointer a2) a2 765 (aref a2 5) (aref a2 6) (aref a2 7))) 766((8) 5 #(A B C D E) X X X) 767 768(equal (make-string 0) (make-array 0 :element-type nil)) T 769(equalp (make-array '(1 2 0)) (make-array '(1 2 0) :element-type nil)) T 770 771(row-major-aref "abcd" 3) 772#\d 773(setf (row-major-aref "abcd" 3) 17) 774ERROR 775 776;; from pfd's ansi tests 777(LET* ((A1 (MAKE-ARRAY 5 :INITIAL-CONTENTS "abcde" :FILL-POINTER 3 778 :ADJUSTABLE T :ELEMENT-TYPE 'CHARACTER)) 779 (A2 (ADJUST-ARRAY A1 8 :FILL-POINTER 5 :INITIAL-ELEMENT #\x 780 :ELEMENT-TYPE 'CHARACTER))) 781 (ASSERT (OR (NOT (ADJUSTABLE-ARRAY-P A1)) (EQ A1 A2))) 782 (ASSERT (OR (ADJUSTABLE-ARRAY-P A1) (EQUAL (ARRAY-DIMENSIONS A1) '(5)))) 783 (ASSERT (EQUAL (ARRAY-DIMENSIONS A2) '(8))) 784 (ASSERT (NOT (ARRAY-DISPLACEMENT A2))) 785 (ASSERT (EQUAL (LIST (AREF A2 5) (AREF A2 6) (AREF A2 7)) '(#\x #\x #\x))) 786 (list (FILL-POINTER A2) A2)) 787(5 "abcde") 788