Artifact b101d550f6d9d4afc20f2226c49fff13373e3f28:
- File srfi/s25/test.scm — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 17028)
0000: 3b 3b 3b 20 61 72 72 61 79 20 74 65 73 74 0a 3b ;;; array test.; 0010: 3b 3b 20 32 30 30 31 20 4a 75 73 73 69 20 50 69 ;; 2001 Jussi Pi 0020: 69 74 75 6c 61 69 6e 65 6e 0a 0a 28 64 65 66 69 itulainen..(defi 0030: 6e 65 20 70 61 73 74 0a 20 20 28 6c 65 74 20 28 ne past. (let ( 0040: 28 73 74 6f 6e 65 73 20 27 28 29 29 29 0a 20 20 (stones '())). 0050: 20 20 28 6c 61 6d 62 64 61 20 73 74 6f 6e 65 0a (lambda stone. 0060: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null? 0070: 20 73 74 6f 6e 65 29 0a 20 20 20 20 20 20 20 20 stone). 0080: 20 20 28 72 65 76 65 72 73 65 20 73 74 6f 6e 65 (reverse stone 0090: 73 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 s). (se 00a0: 74 21 20 73 74 6f 6e 65 73 20 28 63 6f 6e 73 20 t! stones (cons 00b0: 28 61 70 70 6c 79 20 28 6c 61 6d 62 64 61 20 28 (apply (lambda ( 00c0: 73 74 6f 6e 65 29 20 73 74 6f 6e 65 29 20 73 74 stone) stone) st 00d0: 6f 6e 65 29 20 73 74 6f 6e 65 73 29 29 29 29 29 one) stones))))) 00e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 69 6c )..(define (tail 00f0: 20 6e 29 0a 20 20 28 69 66 20 28 3c 20 6e 20 28 n). (if (< n ( 0100: 6c 65 6e 67 74 68 20 28 70 61 73 74 29 29 29 0a length (past))). 0110: 20 20 20 20 20 20 28 6c 69 73 74 2d 74 61 69 6c (list-tail 0120: 20 28 70 61 73 74 29 20 28 2d 20 28 6c 65 6e 67 (past) (- (leng 0130: 74 68 20 28 70 61 73 74 29 29 20 6e 29 29 0a 20 th (past)) n)). 0140: 20 20 20 20 20 28 70 61 73 74 29 29 29 0a 0a 3b (past)))..; 0150: 3b 3b 20 53 69 6d 70 6c 65 20 74 65 73 74 73 0a ;; Simple tests. 0160: 0a 28 6f 72 20 28 61 6e 64 20 28 73 68 61 70 65 .(or (and (shape 0170: 29 0a 20 20 20 20 20 20 20 20 20 28 73 68 61 70 ). (shap 0180: 65 20 2d 31 20 2d 31 29 0a 20 20 20 20 20 20 20 e -1 -1). 0190: 20 20 28 73 68 61 70 65 20 2d 31 20 30 29 0a 20 (shape -1 0). 01a0: 20 20 20 20 20 20 20 20 28 73 68 61 70 65 20 2d (shape - 01b0: 31 20 31 29 0a 20 20 20 20 20 20 20 20 20 28 73 1 1). (s 01c0: 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 hape 1 2 3 4 5 6 01d0: 20 37 20 38 20 31 20 32 20 33 20 34 20 35 20 36 7 8 1 2 3 4 5 6 01e0: 20 37 20 38 20 31 20 32 20 33 20 34 20 35 20 36 7 8 1 2 3 4 5 6 01f0: 20 37 20 38 29 29 0a 20 20 20 20 28 65 72 72 6f 7 8)). (erro 0200: 72 20 22 28 73 68 61 70 65 20 2e 2e 2e 29 20 66 r "(shape ...) f 0210: 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 ailed"))..(past 0220: 22 73 68 61 70 65 22 29 0a 0a 28 6f 72 20 28 61 "shape")..(or (a 0230: 6e 64 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 nd (make-array ( 0240: 73 68 61 70 65 29 29 0a 20 20 20 20 20 20 20 20 shape)). 0250: 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 (make-array (sh 0260: 61 70 65 29 20 2a 29 0a 20 20 20 20 20 20 20 20 ape) *). 0270: 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 (make-array (sh 0280: 61 70 65 20 2d 31 20 2d 31 29 29 0a 20 20 20 20 ape -1 -1)). 0290: 20 20 20 20 20 28 6d 61 6b 65 2d 61 72 72 61 79 (make-array 02a0: 20 28 73 68 61 70 65 20 2d 31 20 2d 31 29 20 2a (shape -1 -1) * 02b0: 29 0a 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 ). (make 02c0: 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 -array (shape -1 02d0: 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 6d 1)). (m 02e0: 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 ake-array (shape 02f0: 20 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 1 2 3 4 5 6 7 8 0300: 20 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 1 2 3 4 5 6 7 8 0310: 20 31 20 32 20 33 20 34 29 20 2a 29 29 0a 20 20 1 2 3 4) *)). 0320: 20 20 28 65 72 72 6f 72 20 22 28 6d 61 6b 65 2d (error "(make- 0330: 61 72 72 61 79 20 28 73 68 61 70 65 20 2e 2e 2e array (shape ... 0340: 29 20 5b 6f 5d 29 20 66 61 69 6c 65 64 22 29 29 ) [o]) failed")) 0350: 0a 0a 28 70 61 73 74 20 22 6d 61 6b 65 2d 61 72 ..(past "make-ar 0360: 72 61 79 22 29 0a 0a 28 6f 72 20 28 61 6e 64 20 ray")..(or (and 0370: 28 61 72 72 61 79 20 28 73 68 61 70 65 29 20 2a (array (shape) * 0380: 29 0a 20 20 20 20 20 20 20 20 20 28 61 72 72 61 ). (arra 0390: 79 20 28 73 68 61 70 65 20 2d 31 20 2d 31 29 29 y (shape -1 -1)) 03a0: 0a 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 . (array 03b0: 20 28 73 68 61 70 65 20 2d 31 20 31 29 20 2a 20 (shape -1 1) * 03c0: 2a 29 0a 20 20 20 20 20 20 20 20 20 28 61 72 72 *). (arr 03d0: 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 ay (shape 1 2 3 03e0: 34 20 35 20 36 20 37 20 38 20 31 20 32 20 33 20 4 5 6 7 8 1 2 3 03f0: 34 20 35 20 36 20 37 20 38 29 20 2a 29 29 0a 20 4 5 6 7 8) *)). 0400: 20 20 20 28 65 72 72 6f 72 20 22 28 61 72 72 61 (error "(arra 0410: 79 20 28 73 68 61 70 65 20 2e 2e 2e 29 20 2e 2e y (shape ...) .. 0420: 2e 29 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 .) failed"))..(p 0430: 61 73 74 20 22 61 72 72 61 79 22 29 0a 0a 28 6f ast "array")..(o 0440: 72 20 28 61 6e 64 20 28 3d 20 28 61 72 72 61 79 r (and (= (array 0450: 2d 72 61 6e 6b 20 28 73 68 61 70 65 29 29 20 32 -rank (shape)) 2 0460: 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 ). (= (a 0470: 72 72 61 79 2d 72 61 6e 6b 20 28 73 68 61 70 65 rray-rank (shape 0480: 20 2d 31 20 2d 31 29 29 20 32 29 0a 20 20 20 20 -1 -1)) 2). 0490: 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 (= (array-r 04a0: 61 6e 6b 20 28 73 68 61 70 65 20 2d 31 20 31 29 ank (shape -1 1) 04b0: 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 28 3d ) 2). (= 04c0: 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 28 73 68 (array-rank (sh 04d0: 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 20 ape 1 2 3 4 5 6 04e0: 37 20 38 29 29 20 32 29 29 0a 20 20 20 20 28 65 7 8)) 2)). (e 04f0: 72 72 6f 72 20 22 28 61 72 72 61 79 2d 72 61 6e rror "(array-ran 0500: 6b 20 28 73 68 61 70 65 20 2e 2e 2e 29 29 20 66 k (shape ...)) f 0510: 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 ailed"))..(past 0520: 22 61 72 72 61 79 2d 72 61 6e 6b 20 6f 66 20 73 "array-rank of s 0530: 68 61 70 65 22 29 0a 0a 28 6f 72 20 28 61 6e 64 hape")..(or (and 0540: 20 28 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 (= (array-rank 0550: 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 (make-array (sha 0560: 70 65 29 29 29 20 30 29 0a 20 20 20 20 20 20 20 pe))) 0). 0570: 20 20 28 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b (= (array-rank 0580: 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 (make-array (sh 0590: 61 70 65 20 2d 31 20 2d 31 29 29 29 20 31 29 0a ape -1 -1))) 1). 05a0: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 05b0: 61 79 2d 72 61 6e 6b 20 28 6d 61 6b 65 2d 61 72 ay-rank (make-ar 05c0: 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 31 29 ray (shape -1 1) 05d0: 29 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 28 )) 1). ( 05e0: 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 28 6d = (array-rank (m 05f0: 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 ake-array (shape 0600: 20 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 1 2 3 4 5 6 7 8 0610: 29 29 29 20 34 29 29 0a 20 20 20 20 28 65 72 72 ))) 4)). (err 0620: 6f 72 20 22 28 61 72 72 61 79 2d 72 61 6e 6b 20 or "(array-rank 0630: 28 6d 61 6b 65 2d 61 72 72 61 79 20 2e 2e 2e 29 (make-array ...) 0640: 29 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 ) failed"))..(pa 0650: 73 74 20 22 61 72 72 61 79 2d 72 61 6e 6b 20 6f st "array-rank o 0660: 66 20 6d 61 6b 65 2d 61 72 72 61 79 22 29 0a 0a f make-array").. 0670: 28 6f 72 20 28 61 6e 64 20 28 3d 20 28 61 72 72 (or (and (= (arr 0680: 61 79 2d 72 61 6e 6b 20 28 61 72 72 61 79 20 28 ay-rank (array ( 0690: 73 68 61 70 65 29 20 2a 29 29 20 30 29 0a 20 20 shape) *)) 0). 06a0: 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 (= (array 06b0: 2d 72 61 6e 6b 20 28 61 72 72 61 79 20 28 73 68 -rank (array (sh 06c0: 61 70 65 20 2d 31 20 2d 31 29 29 29 20 31 29 0a ape -1 -1))) 1). 06d0: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 06e0: 61 79 2d 72 61 6e 6b 20 28 61 72 72 61 79 20 28 ay-rank (array ( 06f0: 73 68 61 70 65 20 2d 31 20 31 29 20 2a 20 2a 29 shape -1 1) * *) 0700: 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 28 3d ) 1). (= 0710: 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 28 61 72 (array-rank (ar 0720: 72 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 ray (shape 1 2 3 0730: 20 34 20 35 20 36 20 37 20 38 29 20 2a 29 29 20 4 5 6 7 8) *)) 0740: 34 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 4)). (error " 0750: 28 61 72 72 61 79 2d 72 61 6e 6b 20 28 61 72 72 (array-rank (arr 0760: 61 79 20 2e 2e 2e 29 29 20 66 61 69 6c 65 64 22 ay ...)) failed" 0770: 29 29 0a 0a 28 70 61 73 74 20 22 61 72 72 61 79 ))..(past "array 0780: 2d 72 61 6e 6b 20 6f 66 20 61 72 72 61 79 22 29 -rank of array") 0790: 0a 0a 28 6f 72 20 28 61 6e 64 20 28 3d 20 28 61 ..(or (and (= (a 07a0: 72 72 61 79 2d 73 74 61 72 74 20 28 73 68 61 70 rray-start (shap 07b0: 65 20 2d 31 20 2d 31 29 20 30 29 20 30 29 0a 20 e -1 -1) 0) 0). 07c0: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra 07d0: 79 2d 73 74 61 72 74 20 28 73 68 61 70 65 20 2d y-start (shape - 07e0: 31 20 2d 31 29 20 31 29 20 30 29 0a 20 20 20 20 1 -1) 1) 0). 07f0: 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 (= (array-s 0800: 74 61 72 74 20 28 73 68 61 70 65 20 2d 31 20 31 tart (shape -1 1 0810: 29 20 30 29 20 30 29 0a 20 20 20 20 20 20 20 20 ) 0) 0). 0820: 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 (= (array-start 0830: 20 28 73 68 61 70 65 20 2d 31 20 31 29 20 31 29 (shape -1 1) 1) 0840: 20 30 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 0). (= 0850: 28 61 72 72 61 79 2d 73 74 61 72 74 20 28 73 68 (array-start (sh 0860: 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 20 ape 1 2 3 4 5 6 0870: 37 20 38 29 20 30 29 20 30 29 0a 20 20 20 20 20 7 8) 0) 0). 0880: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 (= (array-st 0890: 61 72 74 20 28 73 68 61 70 65 20 31 20 32 20 33 art (shape 1 2 3 08a0: 20 34 20 35 20 36 20 37 20 38 29 20 31 29 20 30 4 5 6 7 8) 1) 0 08b0: 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 28 )). (error "( 08c0: 61 72 72 61 79 2d 73 74 61 72 74 20 28 73 68 61 array-start (sha 08d0: 70 65 20 2e 2e 2e 29 29 20 66 61 69 6c 65 64 22 pe ...)) failed" 08e0: 29 29 0a 0a 28 70 61 73 74 20 22 61 72 72 61 79 ))..(past "array 08f0: 2d 73 74 61 72 74 20 6f 66 20 73 68 61 70 65 22 -start of shape" 0900: 29 0a 0a 28 6f 72 20 28 61 6e 64 20 28 3d 20 28 )..(or (and (= ( 0910: 61 72 72 61 79 2d 65 6e 64 20 28 73 68 61 70 65 array-end (shape 0920: 20 2d 31 20 2d 31 29 20 30 29 20 31 29 0a 20 20 -1 -1) 0) 1). 0930: 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 (= (array 0940: 2d 65 6e 64 20 28 73 68 61 70 65 20 2d 31 20 2d -end (shape -1 - 0950: 31 29 20 31 29 20 32 29 0a 20 20 20 20 20 20 20 1) 1) 2). 0960: 20 20 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 (= (array-end 0970: 28 73 68 61 70 65 20 2d 31 20 31 29 20 30 29 20 (shape -1 1) 0) 0980: 31 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 1). (= ( 0990: 61 72 72 61 79 2d 65 6e 64 20 28 73 68 61 70 65 array-end (shape 09a0: 20 2d 31 20 31 29 20 31 29 20 32 29 0a 20 20 20 -1 1) 1) 2). 09b0: 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d (= (array- 09c0: 65 6e 64 20 28 73 68 61 70 65 20 31 20 32 20 33 end (shape 1 2 3 09d0: 20 34 20 35 20 36 20 37 20 38 29 20 30 29 20 34 4 5 6 7 8) 0) 4 09e0: 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 ). (= (a 09f0: 72 72 61 79 2d 65 6e 64 20 28 73 68 61 70 65 20 rray-end (shape 0a00: 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 1 2 3 4 5 6 7 8) 0a10: 20 31 29 20 32 29 29 0a 20 20 20 20 28 65 72 72 1) 2)). (err 0a20: 6f 72 20 22 28 61 72 72 61 79 2d 65 6e 64 20 28 or "(array-end ( 0a30: 73 68 61 70 65 20 2e 2e 2e 29 29 20 66 61 69 6c shape ...)) fail 0a40: 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 72 ed"))..(past "ar 0a50: 72 61 79 2d 65 6e 64 20 6f 66 20 73 68 61 70 65 ray-end of shape 0a60: 22 29 0a 0a 28 6f 72 20 28 61 6e 64 20 28 3d 20 ")..(or (and (= 0a70: 28 61 72 72 61 79 2d 73 74 61 72 74 20 28 6d 61 (array-start (ma 0a80: 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 ke-array (shape 0a90: 2d 31 20 2d 31 29 29 20 30 29 20 2d 31 29 0a 20 -1 -1)) 0) -1). 0aa0: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra 0ab0: 79 2d 73 74 61 72 74 20 28 6d 61 6b 65 2d 61 72 y-start (make-ar 0ac0: 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 31 29 ray (shape -1 1) 0ad0: 29 20 30 29 20 2d 31 29 0a 20 20 20 20 20 20 20 ) 0) -1). 0ae0: 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 (= (array-star 0af0: 74 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 t (make-array (s 0b00: 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 hape 1 2 3 4 5 6 0b10: 20 37 20 38 29 29 20 30 29 20 31 29 0a 20 20 20 7 8)) 0) 1). 0b20: 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d (= (array- 0b30: 73 74 61 72 74 20 28 6d 61 6b 65 2d 61 72 72 61 start (make-arra 0b40: 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 y (shape 1 2 3 4 0b50: 20 35 20 36 20 37 20 38 29 29 20 31 29 20 33 29 5 6 7 8)) 1) 3) 0b60: 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 . (= (ar 0b70: 72 61 79 2d 73 74 61 72 74 20 28 6d 61 6b 65 2d ray-start (make- 0b80: 61 72 72 61 79 20 28 73 68 61 70 65 20 31 20 32 array (shape 1 2 0b90: 20 33 20 34 20 35 20 36 20 37 20 38 29 29 20 32 3 4 5 6 7 8)) 2 0ba0: 29 20 35 29 0a 20 20 20 20 20 20 20 20 20 28 3d ) 5). (= 0bb0: 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 28 6d (array-start (m 0bc0: 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 ake-array (shape 0bd0: 20 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 1 2 3 4 5 6 7 8 0be0: 29 29 20 33 29 20 37 29 29 0a 20 20 20 20 28 65 )) 3) 7)). (e 0bf0: 72 72 6f 72 20 22 28 61 72 72 61 79 2d 73 74 61 rror "(array-sta 0c00: 72 74 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 2e rt (make-array . 0c10: 2e 2e 29 29 20 66 61 69 6c 65 64 22 29 29 0a 0a ..)) failed")).. 0c20: 28 70 61 73 74 20 22 61 72 72 61 79 2d 73 74 61 (past "array-sta 0c30: 72 74 20 6f 66 20 6d 61 6b 65 2d 61 72 72 61 79 rt of make-array 0c40: 22 29 0a 0a 28 6f 72 20 28 61 6e 64 20 28 3d 20 ")..(or (and (= 0c50: 28 61 72 72 61 79 2d 65 6e 64 20 28 6d 61 6b 65 (array-end (make 0c60: 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 -array (shape -1 0c70: 20 2d 31 29 29 20 30 29 20 2d 31 29 0a 20 20 20 -1)) 0) -1). 0c80: 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d (= (array- 0c90: 65 6e 64 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 end (make-array 0ca0: 28 73 68 61 70 65 20 2d 31 20 31 29 29 20 30 29 (shape -1 1)) 0) 0cb0: 20 31 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 1). (= 0cc0: 28 61 72 72 61 79 2d 65 6e 64 20 28 6d 61 6b 65 (array-end (make 0cd0: 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 31 20 -array (shape 1 0ce0: 32 20 33 20 34 20 35 20 36 20 37 20 38 29 29 20 2 3 4 5 6 7 8)) 0cf0: 30 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 28 0) 2). ( 0d00: 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 28 6d 61 = (array-end (ma 0d10: 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 ke-array (shape 0d20: 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 1 2 3 4 5 6 7 8) 0d30: 29 20 31 29 20 34 29 0a 20 20 20 20 20 20 20 20 ) 1) 4). 0d40: 20 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 28 (= (array-end ( 0d50: 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 make-array (shap 0d60: 65 20 31 20 32 20 33 20 34 20 35 20 36 20 37 20 e 1 2 3 4 5 6 7 0d70: 38 29 29 20 32 29 20 36 29 0a 20 20 20 20 20 20 8)) 2) 6). 0d80: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 (= (array-end 0d90: 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 (make-array (sh 0da0: 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 20 ape 1 2 3 4 5 6 0db0: 37 20 38 29 29 20 33 29 20 38 29 29 0a 20 20 20 7 8)) 3) 8)). 0dc0: 20 28 65 72 72 6f 72 20 22 28 61 72 72 61 79 2d (error "(array- 0dd0: 65 6e 64 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 end (make-array 0de0: 2e 2e 2e 29 29 20 66 61 69 6c 65 64 22 29 29 0a ...)) failed")). 0df0: 0a 28 70 61 73 74 20 22 61 72 72 61 79 2d 65 6e .(past "array-en 0e00: 64 20 6f 66 20 6d 61 6b 65 2d 61 72 72 61 79 22 d of make-array" 0e10: 29 0a 0a 28 6f 72 20 28 61 6e 64 20 28 3d 20 28 )..(or (and (= ( 0e20: 61 72 72 61 79 2d 73 74 61 72 74 20 28 61 72 72 array-start (arr 0e30: 61 79 20 28 73 68 61 70 65 20 2d 31 20 2d 31 29 ay (shape -1 -1) 0e40: 29 20 30 29 20 2d 31 29 0a 20 20 20 20 20 20 20 ) 0) -1). 0e50: 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 (= (array-star 0e60: 74 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 t (array (shape 0e70: 2d 31 20 31 29 20 2a 20 2a 29 20 30 29 20 2d 31 -1 1) * *) 0) -1 0e80: 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 ). (= (a 0e90: 72 72 61 79 2d 73 74 61 72 74 20 28 61 72 72 61 rray-start (arra 0ea0: 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 y (shape 1 2 3 4 0eb0: 20 35 20 36 20 37 20 38 29 20 2a 29 20 30 29 20 5 6 7 8) *) 0) 0ec0: 31 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 1). (= ( 0ed0: 61 72 72 61 79 2d 73 74 61 72 74 20 28 61 72 72 array-start (arr 0ee0: 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 ay (shape 1 2 3 0ef0: 34 20 35 20 36 20 37 20 38 29 20 2a 29 20 31 29 4 5 6 7 8) *) 1) 0f00: 20 33 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 3). (= 0f10: 28 61 72 72 61 79 2d 73 74 61 72 74 20 28 61 72 (array-start (ar 0f20: 72 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 ray (shape 1 2 3 0f30: 20 34 20 35 20 36 20 37 20 38 29 20 2a 29 20 32 4 5 6 7 8) *) 2 0f40: 29 20 35 29 0a 20 20 20 20 20 20 20 20 20 28 3d ) 5). (= 0f50: 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 28 61 (array-start (a 0f60: 72 72 61 79 20 28 73 68 61 70 65 20 31 20 32 20 rray (shape 1 2 0f70: 33 20 34 20 35 20 36 20 37 20 38 29 20 2a 29 20 3 4 5 6 7 8) *) 0f80: 33 29 20 37 29 29 0a 20 20 20 20 28 65 72 72 6f 3) 7)). (erro 0f90: 72 20 22 28 61 72 72 61 79 2d 73 74 61 72 74 20 r "(array-start 0fa0: 28 61 72 72 61 79 20 2e 2e 2e 29 29 20 66 61 69 (array ...)) fai 0fb0: 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 led"))..(past "a 0fc0: 72 72 61 79 2d 73 74 61 72 74 20 6f 66 20 61 72 rray-start of ar 0fd0: 72 61 79 22 29 0a 0a 28 6f 72 20 28 61 6e 64 20 ray")..(or (and 0fe0: 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 28 61 (= (array-end (a 0ff0: 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 2d rray (shape -1 - 1000: 31 29 29 20 30 29 20 2d 31 29 0a 20 20 20 20 20 1)) 0) -1). 1010: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 6e (= (array-en 1020: 64 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 d (array (shape 1030: 2d 31 20 31 29 20 2a 20 2a 29 20 30 29 20 31 29 -1 1) * *) 0) 1) 1040: 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 . (= (ar 1050: 72 61 79 2d 65 6e 64 20 28 61 72 72 61 79 20 28 ray-end (array ( 1060: 73 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 shape 1 2 3 4 5 1070: 36 20 37 20 38 29 20 2a 29 20 30 29 20 32 29 0a 6 7 8) *) 0) 2). 1080: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 1090: 61 79 2d 65 6e 64 20 28 61 72 72 61 79 20 28 73 ay-end (array (s 10a0: 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 hape 1 2 3 4 5 6 10b0: 20 37 20 38 29 20 2a 29 20 31 29 20 34 29 0a 20 7 8) *) 1) 4). 10c0: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra 10d0: 79 2d 65 6e 64 20 28 61 72 72 61 79 20 28 73 68 y-end (array (sh 10e0: 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 20 ape 1 2 3 4 5 6 10f0: 37 20 38 29 20 2a 29 20 32 29 20 36 29 0a 20 20 7 8) *) 2) 6). 1100: 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 (= (array 1110: 2d 65 6e 64 20 28 61 72 72 61 79 20 28 73 68 61 -end (array (sha 1120: 70 65 20 31 20 32 20 33 20 34 20 35 20 36 20 37 pe 1 2 3 4 5 6 7 1130: 20 38 29 20 2a 29 20 33 29 20 38 29 29 0a 20 20 8) *) 3) 8)). 1140: 20 20 28 65 72 72 6f 72 20 22 28 61 72 72 61 79 (error "(array 1150: 2d 65 6e 64 20 28 61 72 72 61 79 20 2e 2e 2e 29 -end (array ...) 1160: 29 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 ) failed"))..(pa 1170: 73 74 20 22 61 72 72 61 79 2d 65 6e 64 20 6f 66 st "array-end of 1180: 20 61 72 72 61 79 22 29 0a 0a 28 6f 72 20 28 61 array")..(or (a 1190: 6e 64 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 nd (eq? (array-r 11a0: 65 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 ef (make-array ( 11b0: 73 68 61 70 65 29 20 27 61 29 29 20 27 61 29 0a shape) 'a)) 'a). 11c0: 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 (eq? (a 11d0: 72 72 61 79 2d 72 65 66 20 28 6d 61 6b 65 2d 61 rray-ref (make-a 11e0: 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 31 rray (shape -1 1 11f0: 29 20 27 62 29 20 2d 31 29 20 27 62 29 0a 20 20 ) 'b) -1) 'b). 1200: 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 (eq? (arr 1210: 61 79 2d 72 65 66 20 28 6d 61 6b 65 2d 61 72 72 ay-ref (make-arr 1220: 61 79 20 28 73 68 61 70 65 20 2d 31 20 31 29 20 ay (shape -1 1) 1230: 27 63 29 20 30 29 20 27 63 29 0a 20 20 20 20 20 'c) 0) 'c). 1240: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array- 1250: 72 65 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 ref (make-array 1260: 28 73 68 61 70 65 20 31 20 32 20 33 20 34 20 35 (shape 1 2 3 4 5 1270: 20 36 20 37 20 38 29 20 27 64 29 20 31 20 33 20 6 7 8) 'd) 1 3 1280: 35 20 37 29 20 27 64 29 29 0a 20 20 20 20 28 65 5 7) 'd)). (e 1290: 72 72 6f 72 20 22 61 72 72 61 79 2d 72 65 66 20 rror "array-ref 12a0: 6f 66 20 6d 61 6b 65 2d 61 72 72 61 79 20 77 69 of make-array wi 12b0: 74 68 20 61 72 67 75 6d 65 6e 74 73 20 66 61 69 th arguments fai 12c0: 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 led"))..(past "a 12d0: 72 72 61 79 2d 72 65 66 20 6f 66 20 6d 61 6b 65 rray-ref of make 12e0: 2d 61 72 72 61 79 20 77 69 74 68 20 61 72 67 75 -array with argu 12f0: 6d 65 6e 74 73 22 29 0a 0a 28 6f 72 20 28 61 6e ments")..(or (an 1300: 64 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 65 d (eq? (array-re 1310: 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 f (make-array (s 1320: 68 61 70 65 29 20 27 61 29 20 27 23 28 29 29 20 hape) 'a) '#()) 1330: 27 61 29 0a 20 20 20 20 20 20 20 20 20 28 65 71 'a). (eq 1340: 3f 20 28 61 72 72 61 79 2d 72 65 66 20 28 6d 61 ? (array-ref (ma 1350: 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 ke-array (shape 1360: 2d 31 20 31 29 20 27 62 29 20 27 23 28 2d 31 29 -1 1) 'b) '#(-1) 1370: 29 20 27 62 29 0a 20 20 20 20 20 20 20 20 20 28 ) 'b). ( 1380: 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 28 eq? (array-ref ( 1390: 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 make-array (shap 13a0: 65 20 2d 31 20 31 29 20 27 63 29 20 27 23 28 30 e -1 1) 'c) '#(0 13b0: 29 29 20 27 63 29 0a 20 20 20 20 20 20 20 20 20 )) 'c). 13c0: 28 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 (eq? (array-ref 13d0: 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 (make-array (sha 13e0: 70 65 20 31 20 32 20 33 20 34 20 35 20 36 20 37 pe 1 2 3 4 5 6 7 13f0: 20 38 29 20 27 64 29 0a 20 20 20 20 20 20 20 20 8) 'd). 1400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1410: 20 27 23 28 31 20 33 20 35 20 37 29 29 0a 20 20 '#(1 3 5 7)). 1420: 20 20 20 20 20 20 20 20 20 20 20 20 27 64 29 29 'd)) 1430: 0a 20 20 20 20 28 65 72 72 6f 72 20 22 61 72 72 . (error "arr 1440: 61 79 2d 72 65 66 20 6f 66 20 6d 61 6b 65 2d 61 ay-ref of make-a 1450: 72 72 61 79 20 77 69 74 68 20 76 65 63 74 6f 72 rray with vector 1460: 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 73 failed"))..(pas 1470: 74 20 22 61 72 72 61 79 2d 72 65 66 20 6f 66 20 t "array-ref of 1480: 6d 61 6b 65 2d 61 72 72 61 79 20 77 69 74 68 20 make-array with 1490: 76 65 63 74 6f 72 22 29 0a 0a 28 6f 72 20 28 61 vector")..(or (a 14a0: 6e 64 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 nd (eq? (array-r 14b0: 65 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 ef (make-array ( 14c0: 73 68 61 70 65 29 20 27 61 29 0a 20 20 20 20 20 shape) 'a). 14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 14e0: 20 20 20 20 28 61 72 72 61 79 20 28 73 68 61 70 (array (shap 14f0: 65 20 30 20 30 29 29 29 0a 20 20 20 20 20 20 20 e 0 0))). 1500: 20 20 20 20 20 20 20 27 61 29 0a 20 20 20 20 20 'a). 1510: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array- 1520: 72 65 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 ref (make-array 1530: 28 73 68 61 70 65 20 2d 31 20 31 29 20 27 62 29 (shape -1 1) 'b) 1540: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 1550: 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 (array 1560: 20 28 73 68 61 70 65 20 30 20 31 29 20 2d 31 29 (shape 0 1) -1) 1570: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 1580: 27 62 29 0a 20 20 20 20 20 20 20 20 20 28 65 71 'b). (eq 1590: 3f 20 28 61 72 72 61 79 2d 72 65 66 20 28 6d 61 ? (array-ref (ma 15a0: 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 ke-array (shape 15b0: 2d 31 20 31 29 20 27 63 29 0a 20 20 20 20 20 20 -1 1) 'c). 15c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 15d0: 20 20 20 28 61 72 72 61 79 20 28 73 68 61 70 65 (array (shape 15e0: 20 30 20 31 29 20 30 29 29 0a 20 20 20 20 20 20 0 1) 0)). 15f0: 20 20 20 20 20 20 20 20 27 63 29 0a 20 20 20 20 'c). 1600: 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 (eq? (array 1610: 2d 72 65 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 -ref (make-array 1620: 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 20 (shape 1 2 3 4 1630: 35 20 36 20 37 20 38 29 20 27 64 29 0a 20 20 20 5 6 7 8) 'd). 1640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1650: 20 20 20 20 20 20 28 61 72 72 61 79 20 28 73 68 (array (sh 1660: 61 70 65 20 30 20 34 29 20 31 20 33 20 35 20 37 ape 0 4) 1 3 5 7 1670: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )). 1680: 20 27 64 29 29 0a 20 20 20 20 28 65 72 72 6f 72 'd)). (error 1690: 20 22 28 61 72 72 61 79 2d 72 65 66 20 6f 66 20 "(array-ref of 16a0: 6d 61 6b 65 2d 61 72 72 61 79 20 77 69 74 68 20 make-array with 16b0: 61 72 72 61 79 20 66 61 69 6c 65 64 22 29 29 0a array failed")). 16c0: 0a 28 70 61 73 74 20 22 61 72 72 61 79 2d 72 65 .(past "array-re 16d0: 66 20 6f 66 20 6d 61 6b 65 2d 61 72 72 61 79 20 f of make-array 16e0: 77 69 74 68 20 61 72 72 61 79 22 29 0a 0a 28 6f with array")..(o 16f0: 72 20 28 61 6e 64 20 28 6c 65 74 20 28 28 61 72 r (and (let ((ar 1700: 72 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 r (make-array (s 1710: 68 61 70 65 29 20 27 6f 29 29 29 0a 20 20 20 20 hape) 'o))). 1720: 20 20 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 (array-se 1730: 74 21 20 61 72 72 20 27 61 29 0a 20 20 20 20 20 t! arr 'a). 1740: 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 (eq? (arra 1750: 79 2d 72 65 66 20 61 72 72 29 20 27 61 29 29 0a y-ref arr) 'a)). 1760: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let (( 1770: 61 72 72 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 arr (make-array 1780: 28 73 68 61 70 65 20 2d 31 20 31 29 20 27 6f 29 (shape -1 1) 'o) 1790: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 )). (a 17a0: 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 2d 31 rray-set! arr -1 17b0: 20 27 62 29 0a 20 20 20 20 20 20 20 20 20 20 20 'b). 17c0: 28 61 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 (array-set! arr 17d0: 30 20 27 63 29 0a 20 20 20 20 20 20 20 20 20 20 0 'c). 17e0: 20 28 61 6e 64 20 28 65 71 3f 20 28 61 72 72 61 (and (eq? (arra 17f0: 79 2d 72 65 66 20 61 72 72 20 2d 31 29 20 27 62 y-ref arr -1) 'b 1800: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 1810: 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 65 (eq? (array-re 1820: 66 20 61 72 72 20 30 29 20 27 63 29 29 29 0a 20 f arr 0) 'c))). 1830: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 (let ((a 1840: 72 72 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 rr (make-array ( 1850: 73 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 shape 1 2 3 4 5 1860: 36 20 37 20 38 29 20 27 6f 29 29 29 0a 20 20 20 6 7 8) 'o))). 1870: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 2d 73 (array-s 1880: 65 74 21 20 61 72 72 20 31 20 33 20 35 20 37 20 et! arr 1 3 5 7 1890: 27 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 'd). ( 18a0: 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 eq? (array-ref a 18b0: 72 72 20 31 20 33 20 35 20 37 29 20 27 64 29 29 rr 1 3 5 7) 'd)) 18c0: 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 61 72 ). (error "ar 18d0: 72 61 79 2d 73 65 74 21 20 77 69 74 68 20 61 72 ray-set! with ar 18e0: 67 75 6d 65 6e 74 73 20 66 61 69 6c 65 64 22 29 guments failed") 18f0: 29 0a 0a 28 70 61 73 74 20 22 61 72 72 61 79 2d )..(past "array- 1900: 73 65 74 21 20 6f 66 20 6d 61 6b 65 2d 61 72 72 set! of make-arr 1910: 61 79 20 77 69 74 68 20 61 72 67 75 6d 65 6e 74 ay with argument 1920: 73 22 29 0a 0a 28 6f 72 20 28 61 6e 64 20 28 6c s")..(or (and (l 1930: 65 74 20 28 28 61 72 72 20 28 6d 61 6b 65 2d 61 et ((arr (make-a 1940: 72 72 61 79 20 28 73 68 61 70 65 29 20 27 6f 29 rray (shape) 'o) 1950: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 )). (a 1960: 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 27 23 rray-set! arr '# 1970: 28 29 20 27 61 29 0a 20 20 20 20 20 20 20 20 20 () 'a). 1980: 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 65 (eq? (array-re 1990: 66 20 61 72 72 29 20 27 61 29 29 0a 20 20 20 20 f arr) 'a)). 19a0: 20 20 20 20 20 28 6c 65 74 20 28 28 61 72 72 20 (let ((arr 19b0: 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 (make-array (sha 19c0: 70 65 20 2d 31 20 31 29 20 27 6f 29 29 29 0a 20 pe -1 1) 'o))). 19d0: 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 (array 19e0: 2d 73 65 74 21 20 61 72 72 20 27 23 28 2d 31 29 -set! arr '#(-1) 19f0: 20 27 62 29 0a 20 20 20 20 20 20 20 20 20 20 20 'b). 1a00: 28 61 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 (array-set! arr 1a10: 27 23 28 30 29 20 27 63 29 0a 20 20 20 20 20 20 '#(0) 'c). 1a20: 20 20 20 20 20 28 61 6e 64 20 28 65 71 3f 20 28 (and (eq? ( 1a30: 61 72 72 61 79 2d 72 65 66 20 61 72 72 20 2d 31 array-ref arr -1 1a40: 29 20 27 62 29 0a 20 20 20 20 20 20 20 20 20 20 ) 'b). 1a50: 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 (eq? (arra 1a60: 79 2d 72 65 66 20 61 72 72 20 30 29 20 27 63 29 y-ref arr 0) 'c) 1a70: 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 )). (let 1a80: 20 28 28 61 72 72 20 28 6d 61 6b 65 2d 61 72 72 ((arr (make-arr 1a90: 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 ay (shape 1 2 3 1aa0: 34 20 35 20 36 20 37 20 38 29 20 27 6f 29 29 29 4 5 6 7 8) 'o))) 1ab0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72 . (arr 1ac0: 61 79 2d 73 65 74 21 20 61 72 72 20 27 23 28 31 ay-set! arr '#(1 1ad0: 20 33 20 35 20 37 29 20 27 64 29 0a 20 20 20 20 3 5 7) 'd). 1ae0: 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 (eq? (arr 1af0: 61 79 2d 72 65 66 20 61 72 72 20 31 20 33 20 35 ay-ref arr 1 3 5 1b00: 20 37 29 20 27 64 29 29 29 0a 20 20 20 20 28 65 7) 'd))). (e 1b10: 72 72 6f 72 20 22 61 72 72 61 79 2d 73 65 74 21 rror "array-set! 1b20: 20 77 69 74 68 20 76 65 63 74 6f 72 20 66 61 69 with vector fai 1b30: 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 led"))..(past "a 1b40: 72 72 61 79 2d 73 65 74 21 20 6f 66 20 6d 61 6b rray-set! of mak 1b50: 65 2d 61 72 72 61 79 20 77 69 74 68 20 76 65 63 e-array with vec 1b60: 74 6f 72 22 29 0a 0a 28 6f 72 20 28 61 6e 64 20 tor")..(or (and 1b70: 28 6c 65 74 20 28 28 61 72 72 20 28 6d 61 6b 65 (let ((arr (make 1b80: 2d 61 72 72 61 79 20 28 73 68 61 70 65 29 20 27 -array (shape) ' 1b90: 6f 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 o))). 1ba0: 28 61 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 (array-set! arr 1bb0: 27 61 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 'a). ( 1bc0: 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 eq? (array-ref a 1bd0: 72 72 29 20 27 61 29 29 0a 20 20 20 20 20 20 20 rr) 'a)). 1be0: 20 20 28 6c 65 74 20 28 28 61 72 72 20 28 6d 61 (let ((arr (ma 1bf0: 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 ke-array (shape 1c00: 2d 31 20 31 29 20 27 6f 29 29 29 0a 20 20 20 20 -1 1) 'o))). 1c10: 20 20 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 (array-se 1c20: 74 21 20 61 72 72 20 28 61 72 72 61 79 20 28 73 t! arr (array (s 1c30: 68 61 70 65 20 30 20 31 29 20 2d 31 29 20 27 62 hape 0 1) -1) 'b 1c40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 72 ). (ar 1c50: 72 61 79 2d 73 65 74 21 20 61 72 72 20 28 61 72 ray-set! arr (ar 1c60: 72 61 79 20 28 73 68 61 70 65 20 30 20 31 29 20 ray (shape 0 1) 1c70: 30 29 20 27 63 29 0a 20 20 20 20 20 20 20 20 20 0) 'c). 1c80: 20 20 28 61 6e 64 20 28 65 71 3f 20 28 61 72 72 (and (eq? (arr 1c90: 61 79 2d 72 65 66 20 61 72 72 20 2d 31 29 20 27 ay-ref arr -1) ' 1ca0: 62 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 b). 1cb0: 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 (eq? (array-r 1cc0: 65 66 20 61 72 72 20 30 29 20 27 63 29 29 29 0a ef arr 0) 'c))). 1cd0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let (( 1ce0: 61 72 72 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 arr (make-array 1cf0: 28 73 68 61 70 65 20 31 20 32 20 33 20 34 20 35 (shape 1 2 3 4 5 1d00: 20 36 20 37 20 38 29 20 27 6f 29 29 29 0a 20 20 6 7 8) 'o))). 1d10: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 2d (array- 1d20: 73 65 74 21 20 61 72 72 20 28 61 72 72 61 79 20 set! arr (array 1d30: 28 73 68 61 70 65 20 30 20 34 29 20 31 20 33 20 (shape 0 4) 1 3 1d40: 35 20 37 29 20 27 64 29 0a 20 20 20 20 20 20 20 5 7) 'd). 1d50: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array- 1d60: 72 65 66 20 61 72 72 20 31 20 33 20 35 20 37 29 ref arr 1 3 5 7) 1d70: 20 27 64 29 29 29 0a 20 20 20 20 28 65 72 72 6f 'd))). (erro 1d80: 72 20 22 61 72 72 61 79 2d 73 65 74 21 20 77 69 r "array-set! wi 1d90: 74 68 20 61 72 67 75 6d 65 6e 74 73 20 66 61 69 th arguments fai 1da0: 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 led"))..(past "a 1db0: 72 72 61 79 2d 73 65 74 21 20 6f 66 20 6d 61 6b rray-set! of mak 1dc0: 65 2d 61 72 72 61 79 20 77 69 74 68 20 61 72 72 e-array with arr 1dd0: 61 79 22 29 0a 0a 3b 3b 3b 20 53 68 61 72 65 20 ay")..;;; Share 1de0: 61 6e 64 20 63 68 61 6e 67 65 3a 0a 3b 3b 3b 0a and change:.;;;. 1df0: 3b 3b 3b 20 20 6f 72 67 20 20 20 20 20 62 72 6b ;;; org brk 1e00: 20 20 20 20 20 73 77 70 20 20 20 20 20 20 20 20 swp 1e10: 20 20 20 20 62 6f 78 0a 3b 3b 3b 0a 3b 3b 3b 20 box.;;;.;;; 1e20: 20 20 30 20 31 20 20 20 20 20 31 20 32 20 20 20 0 1 1 2 1e30: 20 20 35 20 36 0a 3b 3b 3b 20 36 20 61 20 62 20 5 6.;;; 6 a b 1e40: 20 20 32 20 61 20 62 20 20 20 33 20 64 20 63 20 2 a b 3 d c 1e50: 20 20 30 20 32 20 34 20 36 20 38 3a 20 65 0a 3b 0 2 4 6 8: e.; 1e60: 3b 3b 20 37 20 63 20 64 20 20 20 33 20 65 20 66 ;; 7 c d 3 e f 1e70: 20 20 20 34 20 66 20 65 0a 3b 3b 3b 20 38 20 65 4 f e.;;; 8 e 1e80: 20 66 0a 0a 28 6f 72 20 28 6c 65 74 2a 20 28 28 f..(or (let* (( 1e90: 6f 72 67 20 28 61 72 72 61 79 20 28 73 68 61 70 org (array (shap 1ea0: 65 20 36 20 39 20 30 20 32 29 20 27 61 20 27 62 e 6 9 0 2) 'a 'b 1eb0: 20 27 63 20 27 64 20 27 65 20 27 66 29 29 0a 20 'c 'd 'e 'f)). 1ec0: 20 20 20 20 20 20 20 20 20 20 28 62 72 6b 20 28 (brk ( 1ed0: 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 share-array. 1ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6f 72 67 org 1ef0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 1f00: 20 20 28 73 68 61 70 65 20 32 20 34 20 31 20 33 (shape 2 4 1 3 1f10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 1f20: 20 20 20 28 6c 61 6d 62 64 61 20 28 72 20 6b 29 (lambda (r k) 1f30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 1f40: 20 20 20 20 28 76 61 6c 75 65 73 0a 20 20 20 20 (values. 1f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1f60: 28 2b 20 36 20 28 2a 20 32 20 28 2d 20 72 20 32 (+ 6 (* 2 (- r 2 1f70: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))). 1f80: 20 20 20 20 20 20 20 20 28 2d 20 6b 20 31 29 29 (- k 1)) 1f90: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). ( 1fa0: 73 77 70 20 28 73 68 61 72 65 2d 61 72 72 61 79 swp (share-array 1fb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 1fc0: 20 20 6f 72 67 0a 20 20 20 20 20 20 20 20 20 20 org. 1fd0: 20 20 20 20 20 20 20 28 73 68 61 70 65 20 33 20 (shape 3 1fe0: 35 20 35 20 37 29 0a 20 20 20 20 20 20 20 20 20 5 5 7). 1ff0: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda 2000: 28 72 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 (r k). 2010: 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 (values 2020: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 2030: 20 20 20 20 20 28 2b 20 37 20 28 2d 20 72 20 33 (+ 7 (- r 3 2040: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )). 2050: 20 20 20 20 20 20 20 28 2d 20 31 20 28 2d 20 6b (- 1 (- k 2060: 20 35 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 5)))))). 2070: 20 20 20 20 28 62 6f 78 20 28 73 68 61 72 65 2d (box (share- 2080: 61 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 array. 2090: 20 20 20 20 20 20 20 73 77 70 0a 20 20 20 20 20 swp. 20a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 61 (sha 20b0: 70 65 20 30 20 31 20 32 20 33 20 34 20 35 20 36 pe 0 1 2 3 4 5 6 20c0: 20 37 20 38 20 39 29 0a 20 20 20 20 20 20 20 20 7 8 9). 20d0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda 20e0: 20 5f 20 28 76 61 6c 75 65 73 20 34 20 36 29 29 _ (values 4 6)) 20f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6f )). (o 2100: 72 67 2d 63 6f 6e 74 65 6e 74 73 20 28 6c 61 6d rg-contents (lam 2110: 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 bda (). 2120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2130: 20 20 28 6c 69 73 74 20 28 61 72 72 61 79 2d 72 (list (array-r 2140: 65 66 20 6f 72 67 20 36 20 30 29 20 28 61 72 72 ef org 6 0) (arr 2150: 61 79 2d 72 65 66 20 6f 72 67 20 36 20 31 29 0a ay-ref org 6 1). 2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2180: 20 28 61 72 72 61 79 2d 72 65 66 20 6f 72 67 20 (array-ref org 2190: 37 20 30 29 20 28 61 72 72 61 79 2d 72 65 66 20 7 0) (array-ref 21a0: 6f 72 67 20 37 20 31 29 0a 20 20 20 20 20 20 20 org 7 1). 21b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 21c0: 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 (array 21d0: 2d 72 65 66 20 6f 72 67 20 38 20 30 29 20 28 61 -ref org 8 0) (a 21e0: 72 72 61 79 2d 72 65 66 20 6f 72 67 20 38 20 31 rray-ref org 8 1 21f0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))). 2200: 28 62 72 6b 2d 63 6f 6e 74 65 6e 74 73 20 28 6c (brk-contents (l 2210: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda (). 2220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2230: 20 20 20 20 28 6c 69 73 74 20 28 61 72 72 61 79 (list (array 2240: 2d 72 65 66 20 62 72 6b 20 32 20 31 29 20 28 61 -ref brk 2 1) (a 2250: 72 72 61 79 2d 72 65 66 20 62 72 6b 20 32 20 32 rray-ref brk 2 2 2260: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 2270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2280: 20 20 20 28 61 72 72 61 79 2d 72 65 66 20 62 72 (array-ref br 2290: 6b 20 33 20 31 29 20 28 61 72 72 61 79 2d 72 65 k 3 1) (array-re 22a0: 66 20 62 72 6b 20 33 20 32 29 29 29 29 0a 20 20 f brk 3 2)))). 22b0: 20 20 20 20 20 20 20 20 20 28 73 77 70 2d 63 6f (swp-co 22c0: 6e 74 65 6e 74 73 20 28 6c 61 6d 62 64 61 20 28 ntents (lambda ( 22d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 22e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 (li 22f0: 73 74 20 28 61 72 72 61 79 2d 72 65 66 20 73 77 st (array-ref sw 2300: 70 20 33 20 35 29 20 28 61 72 72 61 79 2d 72 65 p 3 5) (array-re 2310: 66 20 73 77 70 20 33 20 36 29 0a 20 20 20 20 20 f swp 3 6). 2320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2330: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72 (arr 2340: 61 79 2d 72 65 66 20 73 77 70 20 34 20 35 29 20 ay-ref swp 4 5) 2350: 28 61 72 72 61 79 2d 72 65 66 20 73 77 70 20 34 (array-ref swp 4 2360: 20 36 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 6)))). 2370: 20 20 28 62 6f 78 2d 63 6f 6e 74 65 6e 74 73 20 (box-contents 2380: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 (lambda (). 2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23a0: 20 20 20 20 20 20 28 6c 69 73 74 20 28 61 72 72 (list (arr 23b0: 61 79 2d 72 65 66 20 62 6f 78 20 30 20 32 20 34 ay-ref box 0 2 4 23c0: 20 36 20 38 29 29 29 29 29 0a 20 20 20 20 20 20 6 8))))). 23d0: 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 28 6f 72 (and (equal? (or 23e0: 67 2d 63 6f 6e 74 65 6e 74 73 29 20 27 28 61 20 g-contents) '(a 23f0: 62 20 63 20 64 20 65 20 66 29 29 0a 20 20 20 20 b c d e f)). 2400: 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 (equal? ( 2410: 62 72 6b 2d 63 6f 6e 74 65 6e 74 73 29 20 27 28 brk-contents) '( 2420: 61 20 62 20 65 20 66 29 29 0a 20 20 20 20 20 20 a b e f)). 2430: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 73 77 (equal? (sw 2440: 70 2d 63 6f 6e 74 65 6e 74 73 29 20 27 28 64 20 p-contents) '(d 2450: 63 20 66 20 65 29 29 0a 20 20 20 20 20 20 20 20 c f e)). 2460: 20 20 20 28 65 71 75 61 6c 3f 20 28 62 6f 78 2d (equal? (box- 2470: 63 6f 6e 74 65 6e 74 73 29 20 27 28 65 29 29 0a contents) '(e)). 2480: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi 2490: 6e 20 28 61 72 72 61 79 2d 73 65 74 21 20 6f 72 n (array-set! or 24a0: 67 20 36 20 30 20 27 78 29 20 23 74 29 0a 20 20 g 6 0 'x) #t). 24b0: 20 20 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f (equal? 24c0: 20 28 6f 72 67 2d 63 6f 6e 74 65 6e 74 73 29 20 (org-contents) 24d0: 27 28 78 20 62 20 63 20 64 20 65 20 66 29 29 0a '(x b c d e f)). 24e0: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 (equa 24f0: 6c 3f 20 28 62 72 6b 2d 63 6f 6e 74 65 6e 74 73 l? (brk-contents 2500: 29 20 27 28 78 20 62 20 65 20 66 29 29 0a 20 20 ) '(x b e f)). 2510: 20 20 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f (equal? 2520: 20 28 73 77 70 2d 63 6f 6e 74 65 6e 74 73 29 20 (swp-contents) 2530: 27 28 64 20 63 20 66 20 65 29 29 0a 20 20 20 20 '(d c f e)). 2540: 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 (equal? ( 2550: 62 6f 78 2d 63 6f 6e 74 65 6e 74 73 29 20 27 28 box-contents) '( 2560: 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 e)). ( 2570: 62 65 67 69 6e 20 28 61 72 72 61 79 2d 73 65 74 begin (array-set 2580: 21 20 62 72 6b 20 33 20 31 20 27 79 29 20 23 74 ! brk 3 1 'y) #t 2590: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 71 ). (eq 25a0: 75 61 6c 3f 20 28 6f 72 67 2d 63 6f 6e 74 65 6e ual? (org-conten 25b0: 74 73 29 20 27 28 78 20 62 20 63 20 64 20 79 20 ts) '(x b c d y 25c0: 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 f)). ( 25d0: 65 71 75 61 6c 3f 20 28 62 72 6b 2d 63 6f 6e 74 equal? (brk-cont 25e0: 65 6e 74 73 29 20 27 28 78 20 62 20 79 20 66 29 ents) '(x b y f) 25f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 71 ). (eq 2600: 75 61 6c 3f 20 28 73 77 70 2d 63 6f 6e 74 65 6e ual? (swp-conten 2610: 74 73 29 20 27 28 64 20 63 20 66 20 79 29 29 0a ts) '(d c f y)). 2620: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 (equa 2630: 6c 3f 20 28 62 6f 78 2d 63 6f 6e 74 65 6e 74 73 l? (box-contents 2640: 29 20 27 28 79 29 29 0a 20 20 20 20 20 20 20 20 ) '(y)). 2650: 20 20 20 28 62 65 67 69 6e 20 28 61 72 72 61 79 (begin (array 2660: 2d 73 65 74 21 20 73 77 70 20 34 20 35 20 27 7a -set! swp 4 5 'z 2670: 29 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 ) #t). 2680: 20 28 65 71 75 61 6c 3f 20 28 6f 72 67 2d 63 6f (equal? (org-co 2690: 6e 74 65 6e 74 73 29 20 27 28 78 20 62 20 63 20 ntents) '(x b c 26a0: 64 20 79 20 7a 29 29 0a 20 20 20 20 20 20 20 20 d y z)). 26b0: 20 20 20 28 65 71 75 61 6c 3f 20 28 62 72 6b 2d (equal? (brk- 26c0: 63 6f 6e 74 65 6e 74 73 29 20 27 28 78 20 62 20 contents) '(x b 26d0: 79 20 7a 29 29 0a 20 20 20 20 20 20 20 20 20 20 y z)). 26e0: 20 28 65 71 75 61 6c 3f 20 28 73 77 70 2d 63 6f (equal? (swp-co 26f0: 6e 74 65 6e 74 73 29 20 27 28 64 20 63 20 7a 20 ntents) '(d c z 2700: 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 y)). ( 2710: 65 71 75 61 6c 3f 20 28 62 6f 78 2d 63 6f 6e 74 equal? (box-cont 2720: 65 6e 74 73 29 20 27 28 79 29 29 0a 20 20 20 20 ents) '(y)). 2730: 20 20 20 20 20 20 20 28 62 65 67 69 6e 20 28 61 (begin (a 2740: 72 72 61 79 2d 73 65 74 21 20 62 6f 78 20 30 20 rray-set! box 0 2750: 32 20 34 20 36 20 38 20 27 65 29 20 23 74 29 0a 2 4 6 8 'e) #t). 2760: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 (equa 2770: 6c 3f 20 28 6f 72 67 2d 63 6f 6e 74 65 6e 74 73 l? (org-contents 2780: 29 20 27 28 78 20 62 20 63 20 64 20 65 20 7a 29 ) '(x b c d e z) 2790: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 71 ). (eq 27a0: 75 61 6c 3f 20 28 62 72 6b 2d 63 6f 6e 74 65 6e ual? (brk-conten 27b0: 74 73 29 20 27 28 78 20 62 20 65 20 7a 29 29 0a ts) '(x b e z)). 27c0: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 (equa 27d0: 6c 3f 20 28 73 77 70 2d 63 6f 6e 74 65 6e 74 73 l? (swp-contents 27e0: 29 20 27 28 64 20 63 20 7a 20 65 29 29 0a 20 20 ) '(d c z e)). 27f0: 20 20 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f (equal? 2800: 20 28 62 6f 78 2d 63 6f 6e 74 65 6e 74 73 29 20 (box-contents) 2810: 27 28 65 29 29 29 29 0a 20 20 20 20 28 65 72 72 '(e)))). (err 2820: 6f 72 20 22 73 68 61 72 65 64 20 63 68 61 6e 67 or "shared chang 2830: 65 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 e failed"))..(pa 2840: 73 74 20 22 73 68 61 72 65 64 20 63 68 61 6e 67 st "shared chang 2850: 65 22 29 0a 0a 3b 3b 3b 20 43 68 65 63 6b 20 74 e")..;;; Check t 2860: 68 61 74 20 61 72 72 61 79 73 20 63 6f 70 79 20 hat arrays copy 2870: 74 68 65 20 73 68 61 70 65 20 73 70 65 63 69 66 the shape specif 2880: 69 63 61 74 69 6f 6e 0a 0a 28 6f 72 20 28 6c 65 ication..(or (le 2890: 74 20 28 28 73 68 70 20 28 73 68 61 70 65 20 31 t ((shp (shape 1 28a0: 30 20 31 32 29 29 29 0a 20 20 20 20 20 20 28 6c 0 12))). (l 28b0: 65 74 20 28 28 61 72 72 20 28 6d 61 6b 65 2d 61 et ((arr (make-a 28c0: 72 72 61 79 20 73 68 70 29 29 0a 20 20 20 20 20 rray shp)). 28d0: 20 20 20 20 20 20 20 28 61 72 73 20 28 61 72 72 (ars (arr 28e0: 61 79 20 73 68 70 20 2a 20 2a 29 29 0a 20 20 20 ay shp * *)). 28f0: 20 20 20 20 20 20 20 20 20 28 61 72 74 20 28 73 (art (s 2900: 68 61 72 65 2d 61 72 72 61 79 20 28 6d 61 6b 65 hare-array (make 2910: 2d 61 72 72 61 79 20 73 68 70 29 20 73 68 70 20 -array shp) shp 2920: 28 6c 61 6d 62 64 61 20 28 6b 29 20 6b 29 29 29 (lambda (k) k))) 2930: 29 0a 20 20 20 20 20 20 20 20 28 61 72 72 61 79 ). (array 2940: 2d 73 65 74 21 20 73 68 70 20 30 20 30 20 27 3f -set! shp 0 0 '? 2950: 29 0a 20 20 20 20 20 20 20 20 28 61 72 72 61 79 ). (array 2960: 2d 73 65 74 21 20 73 68 70 20 30 20 31 20 27 21 -set! shp 0 1 '! 2970: 29 0a 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 ). (and ( 2980: 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 73 68 = (array-rank sh 2990: 70 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 p) 2). 29a0: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 (= (array-sta 29b0: 72 74 20 73 68 70 20 30 29 20 30 29 0a 20 20 20 rt shp 0) 0). 29c0: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar 29d0: 72 61 79 2d 65 6e 64 20 73 68 70 20 30 29 20 31 ray-end shp 0) 1 29e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). ( 29f0: 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 73 = (array-start s 2a00: 68 70 20 31 29 20 30 29 0a 20 20 20 20 20 20 20 hp 1) 0). 2a10: 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d (= (array- 2a20: 65 6e 64 20 73 68 70 20 31 29 20 32 29 0a 20 20 end shp 1) 2). 2a30: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 (eq? 2a40: 28 61 72 72 61 79 2d 72 65 66 20 73 68 70 20 30 (array-ref shp 0 2a50: 20 30 29 20 27 3f 29 0a 20 20 20 20 20 20 20 20 0) '?). 2a60: 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 (eq? (array 2a70: 2d 72 65 66 20 73 68 70 20 30 20 31 29 20 27 21 -ref shp 0 1) '! 2a80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). ( 2a90: 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 61 72 = (array-rank ar 2aa0: 72 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 r) 1). 2ab0: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 (= (array-sta 2ac0: 72 74 20 61 72 72 20 30 29 20 31 30 29 0a 20 20 rt arr 0) 10). 2ad0: 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 (= (a 2ae0: 72 72 61 79 2d 65 6e 64 20 61 72 72 20 30 29 20 rray-end arr 0) 2af0: 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 12). 2b00: 20 28 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 (= (array-rank 2b10: 61 72 73 29 20 31 29 0a 20 20 20 20 20 20 20 20 ars) 1). 2b20: 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 (= (array-s 2b30: 74 61 72 74 20 61 72 73 20 30 29 20 31 30 29 0a tart ars 0) 10). 2b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 (= 2b50: 28 61 72 72 61 79 2d 65 6e 64 20 61 72 73 20 30 (array-end ars 0 2b60: 29 20 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 ) 12). 2b70: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 61 6e (= (array-ran 2b80: 6b 20 61 72 74 29 20 31 29 0a 20 20 20 20 20 20 k art) 1). 2b90: 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 (= (array 2ba0: 2d 73 74 61 72 74 20 61 72 74 20 30 29 20 31 30 -start art 0) 10 2bb0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). ( 2bc0: 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 61 72 74 = (array-end art 2bd0: 20 30 29 20 31 32 29 29 29 29 0a 20 20 20 20 28 0) 12)))). ( 2be0: 65 72 72 6f 72 20 22 61 72 72 61 79 2d 73 65 74 error "array-set 2bf0: 21 20 6f 66 20 73 68 61 70 65 20 66 61 69 6c 65 ! of shape faile 2c00: 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 72 72 d"))..(past "arr 2c10: 61 79 2d 73 65 74 21 20 6f 66 20 73 68 61 70 65 ay-set! of shape 2c20: 22 29 0a 0a 3b 3b 3b 20 43 68 65 63 6b 20 74 68 ")..;;; Check th 2c30: 61 74 20 69 6e 64 65 78 20 61 72 72 61 79 73 20 at index arrays 2c40: 77 6f 72 6b 20 65 76 65 6e 20 77 68 65 6e 20 74 work even when t 2c50: 68 65 79 20 73 68 61 72 65 0a 3b 3b 3b 0a 3b 3b hey share.;;;.;; 2c60: 3b 20 61 72 72 20 20 20 20 20 20 20 69 78 6e 0a ; arr ixn. 2c70: 3b 3b 3b 20 20 20 35 20 20 36 20 20 20 20 20 20 ;;; 5 6 2c80: 30 20 31 0a 3b 3b 3b 20 34 20 6e 77 20 6e 65 20 0 1.;;; 4 nw ne 2c90: 20 20 30 20 34 20 36 0a 3b 3b 3b 20 35 20 73 77 0 4 6.;;; 5 sw 2ca0: 20 73 65 20 20 20 31 20 35 20 34 0a 0a 28 6f 72 se 1 5 4..(or 2cb0: 20 28 6c 65 74 20 28 28 61 72 72 20 28 61 72 72 (let ((arr (arr 2cc0: 61 79 20 28 73 68 61 70 65 20 34 20 36 20 35 20 ay (shape 4 6 5 2cd0: 37 29 20 27 6e 77 20 27 6e 65 20 27 73 77 20 27 7) 'nw 'ne 'sw ' 2ce0: 73 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 se)). ( 2cf0: 69 78 6e 20 28 61 72 72 61 79 20 28 73 68 61 70 ixn (array (shap 2d00: 65 20 30 20 32 20 30 20 32 29 20 34 20 36 20 35 e 0 2 0 2) 4 6 5 2d10: 20 34 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 4))). (let 2d20: 20 28 28 63 6f 6c 30 20 28 73 68 61 72 65 2d 61 ((col0 (share-a 2d30: 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 rray. 2d40: 20 20 20 20 20 20 20 20 69 78 6e 0a 20 20 20 20 ixn. 2d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 2d60: 73 68 61 70 65 20 30 20 32 29 0a 20 20 20 20 20 shape 0 2). 2d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l 2d80: 61 6d 62 64 61 20 28 6b 29 0a 20 20 20 20 20 20 ambda (k). 2d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 2da0: 76 61 6c 75 65 73 20 6b 20 30 29 29 29 29 0a 20 values k 0)))). 2db0: 20 20 20 20 20 20 20 20 20 20 20 28 72 6f 77 30 (row0 2dc0: 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 (share-array. 2dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2de0: 20 69 78 6e 0a 20 20 20 20 20 20 20 20 20 20 20 ixn. 2df0: 20 20 20 20 20 20 20 20 28 73 68 61 70 65 20 30 (shape 0 2e00: 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2). 2e10: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda ( 2e20: 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 k). 2e30: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 (values 2e40: 30 20 6b 29 29 29 29 0a 20 20 20 20 20 20 20 20 0 k)))). 2e50: 20 20 20 20 28 77 6f 72 31 20 28 73 68 61 72 65 (wor1 (share 2e60: 2d 61 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 -array. 2e70: 20 20 20 20 20 20 20 20 20 20 69 78 6e 0a 20 20 ixn. 2e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2e90: 20 28 73 68 61 70 65 20 30 20 32 29 0a 20 20 20 (shape 0 2). 2ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2eb0: 28 6c 61 6d 62 64 61 20 28 6b 29 0a 20 20 20 20 (lambda (k). 2ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2ed0: 20 28 76 61 6c 75 65 73 20 31 20 28 2d 20 31 20 (values 1 (- 1 2ee0: 6b 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 k))))). 2ef0: 20 20 20 28 63 6f 64 20 28 73 68 61 72 65 2d 61 (cod (share-a 2f00: 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 rray. 2f10: 20 20 20 20 20 20 20 69 78 6e 0a 20 20 20 20 20 ixn. 2f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 (sh 2f30: 61 70 65 20 30 20 32 29 0a 20 20 20 20 20 20 20 ape 0 2). 2f40: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb 2f50: 64 61 20 28 6b 29 0a 20 20 20 20 20 20 20 20 20 da (k). 2f60: 20 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 (case 2f70: 20 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 k. 2f80: 20 20 20 20 20 20 20 20 20 28 28 30 29 20 28 76 ((0) (v 2f90: 61 6c 75 65 73 20 31 20 30 29 29 0a 20 20 20 20 alues 1 0)). 2fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2fb0: 20 20 28 28 31 29 20 28 76 61 6c 75 65 73 20 30 ((1) (values 0 2fc0: 20 31 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 1)))))). 2fd0: 20 20 20 20 20 28 62 6f 78 20 28 73 68 61 72 65 (box (share 2fe0: 2d 61 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 -array. 2ff0: 20 20 20 20 20 20 20 20 20 69 78 6e 0a 20 20 20 ixn. 3000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 3010: 73 68 61 70 65 20 30 20 32 29 0a 20 20 20 20 20 shape 0 2). 3020: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la 3030: 6d 62 64 61 20 28 6b 29 0a 20 20 20 20 20 20 20 mbda (k). 3040: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 61 (va 3050: 6c 75 65 73 20 31 20 30 29 29 29 29 29 0a 20 20 lues 1 0))))). 3060: 20 20 20 20 20 20 28 61 6e 64 20 28 65 71 3f 20 (and (eq? 3070: 28 61 72 72 61 79 2d 72 65 66 20 61 72 72 20 63 (array-ref arr c 3080: 6f 6c 30 29 20 27 6e 77 29 0a 20 20 20 20 20 20 ol0) 'nw). 3090: 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 (eq? (arr 30a0: 61 79 2d 72 65 66 20 61 72 72 20 72 6f 77 30 29 ay-ref arr row0) 30b0: 20 27 6e 65 29 0a 20 20 20 20 20 20 20 20 20 20 'ne). 30c0: 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 (eq? (array-r 30d0: 65 66 20 61 72 72 20 77 6f 72 31 29 20 27 6e 77 ef arr wor1) 'nw 30e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). ( 30f0: 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 eq? (array-ref a 3100: 72 72 20 63 6f 64 29 20 27 73 65 29 0a 20 20 20 rr cod) 'se). 3110: 20 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 (eq? ( 3120: 61 72 72 61 79 2d 72 65 66 20 61 72 72 20 62 6f array-ref arr bo 3130: 78 29 20 27 73 77 29 0a 20 20 20 20 20 20 20 20 x) 'sw). 3140: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin. 3150: 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 (arra 3160: 79 2d 73 65 74 21 20 61 72 72 20 63 6f 6c 30 20 y-set! arr col0 3170: 27 75 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 'ul). 3180: 20 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 20 (array-set! 3190: 61 72 72 20 72 6f 77 30 20 27 75 72 29 0a 20 20 arr row0 'ur). 31a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72 (ar 31b0: 72 61 79 2d 73 65 74 21 20 61 72 72 20 63 6f 64 ray-set! arr cod 31c0: 20 27 6c 72 29 0a 20 20 20 20 20 20 20 20 20 20 'lr). 31d0: 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 (array-set! 31e0: 20 61 72 72 20 62 6f 78 20 27 6c 6c 29 0a 20 20 arr box 'll). 31f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 74 29 #t) 3200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 . (e 3210: 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 72 q? (array-ref ar 3220: 72 20 34 20 35 29 20 27 75 6c 29 0a 20 20 20 20 r 4 5) 'ul). 3230: 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 (eq? (a 3240: 72 72 61 79 2d 72 65 66 20 61 72 72 20 34 20 36 rray-ref arr 4 6 3250: 29 20 27 75 72 29 0a 20 20 20 20 20 20 20 20 20 ) 'ur). 3260: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array- 3270: 72 65 66 20 61 72 72 20 35 20 35 29 20 27 6c 6c ref arr 5 5) 'll 3280: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). ( 3290: 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 eq? (array-ref a 32a0: 72 72 20 35 20 36 29 20 27 6c 72 29 0a 20 20 20 rr 5 6) 'lr). 32b0: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin 32c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 32d0: 28 61 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 (array-set! arr 32e0: 77 6f 72 31 20 27 78 78 29 0a 20 20 20 20 20 20 wor1 'xx). 32f0: 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 (eq? (a 3300: 72 72 61 79 2d 72 65 66 20 61 72 72 20 34 20 35 rray-ref arr 4 5 3310: 29 20 27 78 78 29 29 29 29 29 0a 20 20 20 20 28 ) 'xx))))). ( 3320: 65 72 72 6f 72 20 22 61 72 72 61 79 20 61 63 63 error "array acc 3330: 65 73 73 20 77 69 74 68 20 73 68 61 72 69 6e 67 ess with sharing 3340: 20 69 6e 64 65 78 20 61 72 72 61 79 20 66 61 69 index array fai 3350: 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 led"))..(past "a 3360: 72 72 61 79 20 61 63 63 65 73 73 20 77 69 74 68 rray access with 3370: 20 73 68 61 72 69 6e 67 20 69 6e 64 65 78 20 61 sharing index a 3380: 72 72 61 79 22 29 0a 0a 3b 3b 3b 20 43 68 65 63 rray")..;;; Chec 3390: 6b 20 74 68 61 74 20 73 68 61 70 65 20 61 72 72 k that shape arr 33a0: 61 79 73 20 77 6f 72 6b 20 65 76 65 6e 20 77 68 ays work even wh 33b0: 65 6e 20 74 68 65 79 20 73 68 61 72 65 0a 3b 3b en they share.;; 33c0: 3b 0a 3b 3b 3b 20 61 72 72 20 20 20 20 20 20 20 ;.;;; arr 33d0: 20 20 20 20 20 20 73 68 70 20 20 20 20 20 20 20 shp 33e0: 73 68 71 20 20 20 20 20 20 20 73 68 72 20 20 20 shq shr 33f0: 20 20 20 20 73 68 73 0a 3b 3b 3b 20 20 20 20 31 shs.;;; 1 3400: 20 20 32 20 20 33 20 20 34 20 20 20 20 20 20 30 2 3 4 0 3410: 20 20 31 20 20 20 20 20 20 30 20 20 31 20 20 20 1 0 1 3420: 20 20 20 30 20 20 31 20 20 20 20 20 20 30 20 20 0 1 0 3430: 31 20 0a 3b 3b 3b 20 31 20 31 30 20 31 32 20 31 1 .;;; 1 10 12 1 3440: 36 20 32 30 20 20 20 30 20 31 30 20 31 32 20 20 6 20 0 10 12 3450: 20 30 20 31 32 20 32 30 20 20 20 30 20 31 30 20 0 12 20 0 10 3460: 31 30 20 20 20 30 20 31 32 20 31 32 0a 3b 3b 3b 10 0 12 12.;;; 3470: 20 32 20 31 30 20 31 31 20 31 32 20 31 33 20 20 2 10 11 12 13 3480: 20 31 20 31 30 20 31 31 20 20 20 31 20 31 31 20 1 10 11 1 11 3490: 31 33 20 20 20 31 20 31 31 20 31 32 20 20 20 31 13 1 11 12 1 34a0: 20 31 32 20 31 32 0a 3b 3b 3b 20 20 20 20 20 20 12 12.;;; 34b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 34c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 32 2 34d0: 20 31 32 20 31 36 0a 3b 3b 3b 20 20 20 20 20 20 12 16.;;; 34e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 34f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 33 3 3500: 20 31 33 20 32 30 0a 0a 28 6f 72 20 28 6c 65 74 13 20..(or (let 3510: 20 28 28 61 72 72 20 28 61 72 72 61 79 20 28 73 ((arr (array (s 3520: 68 61 70 65 20 31 20 33 20 31 20 35 29 20 31 30 hape 1 3 1 5) 10 3530: 20 31 32 20 31 36 20 32 30 20 31 30 20 31 31 20 12 16 20 10 11 3540: 31 32 20 31 33 29 29 29 0a 20 20 20 20 20 20 28 12 13))). ( 3550: 6c 65 74 20 28 28 73 68 70 20 28 73 68 61 72 65 let ((shp (share 3560: 2d 61 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 -array. 3570: 20 20 20 20 20 20 20 20 20 61 72 72 0a 20 20 20 arr. 3580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 3590: 73 68 61 70 65 20 30 20 32 20 30 20 32 29 0a 20 shape 0 2 0 2). 35a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 35b0: 20 28 6c 61 6d 62 64 61 20 28 72 20 6b 29 0a 20 (lambda (r k). 35c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 35d0: 20 20 20 28 76 61 6c 75 65 73 20 28 2b 20 72 20 (values (+ r 35e0: 31 29 20 28 2b 20 6b 20 31 29 29 29 29 29 0a 20 1) (+ k 1))))). 35f0: 20 20 20 20 20 20 20 20 20 20 20 28 73 68 71 20 (shq 3600: 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 (share-array. 3610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a 3620: 72 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 rr. 3630: 20 20 20 20 20 28 73 68 61 70 65 20 30 20 32 20 (shape 0 2 3640: 30 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 0 2). 3650: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda ( 3660: 72 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 r k). 3670: 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 (values 3680: 20 28 2b 20 72 20 31 29 20 28 2a 20 32 20 28 2b (+ r 1) (* 2 (+ 3690: 20 31 20 6b 29 29 29 29 29 29 0a 20 20 20 20 20 1 k)))))). 36a0: 20 20 20 20 20 20 20 28 73 68 72 20 28 73 68 61 (shr (sha 36b0: 72 65 2d 61 72 72 61 79 0a 20 20 20 20 20 20 20 re-array. 36c0: 20 20 20 20 20 20 20 20 20 20 20 61 72 72 0a 20 arr. 36d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 36e0: 20 28 73 68 61 70 65 20 30 20 34 20 30 20 32 29 (shape 0 4 0 2) 36f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 3700: 20 20 20 28 6c 61 6d 62 64 61 20 28 72 20 6b 29 (lambda (r k) 3710: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 3720: 20 20 20 20 20 28 76 61 6c 75 65 73 20 28 2d 20 (values (- 3730: 32 20 6b 29 20 28 2b 20 72 20 31 29 29 29 29 29 2 k) (+ r 1))))) 3740: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 . (sh 3750: 73 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 s (share-array. 3760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3770: 20 61 72 72 0a 20 20 20 20 20 20 20 20 20 20 20 arr. 3780: 20 20 20 20 20 20 20 28 73 68 61 70 65 20 30 20 (shape 0 3790: 32 20 30 20 32 29 0a 20 20 20 20 20 20 20 20 20 2 0 2). 37a0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda 37b0: 20 28 72 20 6b 29 0a 20 20 20 20 20 20 20 20 20 (r k). 37c0: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu 37d0: 65 73 20 32 20 33 29 29 29 29 29 0a 20 20 20 20 es 2 3))))). 37e0: 20 20 20 20 28 61 6e 64 20 28 6c 65 74 20 28 28 (and (let (( 37f0: 61 72 72 2d 70 20 28 6d 61 6b 65 2d 61 72 72 61 arr-p (make-arra 3800: 79 20 73 68 70 29 29 29 0a 20 20 20 20 20 20 20 y shp))). 3810: 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 3d 20 (and (= 3820: 28 61 72 72 61 79 2d 72 61 6e 6b 20 61 72 72 2d (array-rank arr- 3830: 70 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 p) 2). 3840: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar 3850: 72 61 79 2d 73 74 61 72 74 20 61 72 72 2d 70 20 ray-start arr-p 3860: 30 29 20 31 30 29 0a 20 20 20 20 20 20 20 20 20 0) 10). 3870: 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 (= (a 3880: 72 72 61 79 2d 65 6e 64 20 61 72 72 2d 70 20 30 rray-end arr-p 0 3890: 29 20 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 ) 12). 38a0: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar 38b0: 72 61 79 2d 73 74 61 72 74 20 61 72 72 2d 70 20 ray-start arr-p 38c0: 31 29 20 31 30 29 0a 20 20 20 20 20 20 20 20 20 1) 10). 38d0: 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 (= (a 38e0: 72 72 61 79 2d 65 6e 64 20 61 72 72 2d 70 20 31 rray-end arr-p 1 38f0: 29 20 31 31 29 29 29 0a 20 20 20 20 20 20 20 20 ) 11))). 3900: 20 20 20 20 20 28 6c 65 74 20 28 28 61 72 72 2d (let ((arr- 3910: 71 20 28 61 72 72 61 79 20 73 68 71 20 2a 20 2a q (array shq * * 3920: 20 2a 20 2a 20 20 2a 20 2a 20 2a 20 2a 20 20 2a * * * * * * * 3930: 20 2a 20 2a 20 2a 20 20 2a 20 2a 20 2a 20 2a 29 * * * * * * *) 3940: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )). 3950: 20 20 28 61 6e 64 20 28 3d 20 28 61 72 72 61 79 (and (= (array 3960: 2d 72 61 6e 6b 20 61 72 72 2d 71 29 20 32 29 0a -rank arr-q) 2). 3970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3980: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 (= (array-st 3990: 61 72 74 20 61 72 72 2d 71 20 30 29 20 31 32 29 art arr-q 0) 12) 39a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 39b0: 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 (= (array-e 39c0: 6e 64 20 61 72 72 2d 71 20 30 29 20 32 30 29 0a nd arr-q 0) 20). 39d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 39e0: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 (= (array-st 39f0: 61 72 74 20 61 72 72 2d 71 20 31 29 20 31 31 29 art arr-q 1) 11) 3a00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 3a10: 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 (= (array-e 3a20: 6e 64 20 61 72 72 2d 71 20 31 29 20 31 33 29 29 nd arr-q 1) 13)) 3a30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). ( 3a40: 6c 65 74 20 28 28 61 72 72 2d 72 20 28 73 68 61 let ((arr-r (sha 3a50: 72 65 2d 61 72 72 61 79 0a 20 20 20 20 20 20 20 re-array. 3a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a70: 20 20 20 20 28 61 72 72 61 79 20 28 73 68 61 70 (array (shap 3a80: 65 29 20 2a 29 0a 20 20 20 20 20 20 20 20 20 20 e) *). 3a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3aa0: 20 73 68 72 0a 20 20 20 20 20 20 20 20 20 20 20 shr. 3ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3ac0: 28 6c 61 6d 62 64 61 20 5f 20 28 76 61 6c 75 65 (lambda _ (value 3ad0: 73 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 s))))). 3ae0: 20 20 20 20 20 20 28 61 6e 64 20 28 3d 20 28 61 (and (= (a 3af0: 72 72 61 79 2d 72 61 6e 6b 20 61 72 72 2d 72 29 rray-rank arr-r) 3b00: 20 34 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 4). 3b10: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra 3b20: 79 2d 73 74 61 72 74 20 61 72 72 2d 72 20 30 29 y-start arr-r 0) 3b30: 20 31 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 10). 3b40: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 3b50: 61 79 2d 65 6e 64 20 61 72 72 2d 72 20 30 29 20 ay-end arr-r 0) 3b60: 31 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 10). 3b70: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra 3b80: 79 2d 73 74 61 72 74 20 61 72 72 2d 72 20 31 29 y-start arr-r 1) 3b90: 20 31 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 11). 3ba0: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 3bb0: 61 79 2d 65 6e 64 20 61 72 72 2d 72 20 31 29 20 ay-end arr-r 1) 3bc0: 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 12). 3bd0: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra 3be0: 79 2d 73 74 61 72 74 20 61 72 72 2d 72 20 32 29 y-start arr-r 2) 3bf0: 20 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 12). 3c00: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 3c10: 61 79 2d 65 6e 64 20 61 72 72 2d 72 20 32 29 20 ay-end arr-r 2) 3c20: 31 36 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 16). 3c30: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra 3c40: 79 2d 73 74 61 72 74 20 61 72 72 2d 72 20 33 29 y-start arr-r 3) 3c50: 20 31 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 13). 3c60: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 3c70: 61 79 2d 65 6e 64 20 61 72 72 2d 72 20 33 29 20 ay-end arr-r 3) 3c80: 32 30 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20))). 3c90: 20 20 20 28 6c 65 74 20 28 28 61 72 72 2d 73 20 (let ((arr-s 3ca0: 28 6d 61 6b 65 2d 61 72 72 61 79 20 73 68 73 29 (make-array shs) 3cb0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )). 3cc0: 20 20 28 61 6e 64 20 28 3d 20 28 61 72 72 61 79 (and (= (array 3cd0: 2d 72 61 6e 6b 20 61 72 72 2d 73 29 20 32 29 0a -rank arr-s) 2). 3ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3cf0: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 (= (array-st 3d00: 61 72 74 20 61 72 72 2d 73 20 30 29 20 31 32 29 art arr-s 0) 12) 3d10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 3d20: 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 (= (array-e 3d30: 6e 64 20 61 72 72 2d 73 20 30 29 20 31 32 29 0a nd arr-s 0) 12). 3d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d50: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 (= (array-st 3d60: 61 72 74 20 61 72 72 2d 73 20 31 29 20 31 32 29 art arr-s 1) 12) 3d70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 3d80: 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 (= (array-e 3d90: 6e 64 20 61 72 72 2d 73 20 31 29 20 31 32 29 29 nd arr-s 1) 12)) 3da0: 29 29 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 )))). (error 3db0: 22 73 68 61 72 69 6e 67 20 73 68 61 70 65 20 61 "sharing shape a 3dc0: 72 72 61 79 20 66 61 69 6c 65 64 22 29 29 0a 0a rray failed")).. 3dd0: 28 70 61 73 74 20 22 73 68 61 72 69 6e 67 20 73 (past "sharing s 3de0: 68 61 70 65 20 61 72 72 61 79 22 29 0a 0a 28 6c hape array")..(l 3df0: 65 74 20 28 28 73 75 70 65 72 20 28 61 72 72 61 et ((super (arra 3e00: 79 20 28 73 68 61 70 65 20 34 20 37 20 34 20 37 y (shape 4 7 4 7 3e10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 3e20: 20 20 20 20 20 20 31 20 2a 20 2a 0a 20 20 20 20 1 * *. 3e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3e40: 2a 20 32 20 2a 0a 20 20 20 20 20 20 20 20 20 20 * 2 *. 3e50: 20 20 20 20 20 20 20 20 20 20 2a 20 2a 20 33 29 * * 3) 3e60: 29 0a 20 20 20 20 20 20 28 73 75 62 73 68 61 70 ). (subshap 3e70: 65 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 e (share-array. 3e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3e90: 28 61 72 72 61 79 20 28 73 68 61 70 65 20 30 20 (array (shape 0 3ea0: 32 20 30 20 33 29 0a 20 20 20 20 20 20 20 20 20 2 0 3). 3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2a * 3ec0: 20 34 20 2a 0a 20 20 20 20 20 20 20 20 20 20 20 4 *. 3ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 2a 20 37 * 7 3ee0: 20 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 *). 3ef0: 20 20 20 20 20 28 73 68 61 70 65 20 30 20 31 20 (shape 0 1 3f00: 30 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 0 2). 3f10: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 (lambda (r 3f20: 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 k). 3f30: 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 6b (values k 3f40: 20 31 29 29 29 29 29 0a 20 20 28 6c 65 74 20 28 1))))). (let ( 3f50: 28 73 75 62 20 28 73 68 61 72 65 2d 61 72 72 61 (sub (share-arra 3f60: 79 20 73 75 70 65 72 20 73 75 62 73 68 61 70 65 y super subshape 3f70: 20 28 6c 61 6d 62 64 61 20 28 6b 29 20 28 76 61 (lambda (k) (va 3f80: 6c 75 65 73 20 6b 20 6b 29 29 29 29 29 0a 20 20 lues k k))))). 3f90: 20 20 3b 28 61 72 72 61 79 2d 65 71 75 61 6c 3f ;(array-equal? 3fa0: 20 73 75 62 73 68 61 70 65 20 28 73 68 61 70 65 subshape (shape 3fb0: 20 34 20 37 29 29 0a 20 20 20 20 28 6f 72 20 28 4 7)). (or ( 3fc0: 61 6e 64 20 28 3d 20 28 61 72 72 61 79 2d 72 61 and (= (array-ra 3fd0: 6e 6b 20 73 75 62 73 68 61 70 65 29 20 32 29 0a nk subshape) 2). 3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 (= 3ff0: 28 61 72 72 61 79 2d 73 74 61 72 74 20 73 75 62 (array-start sub 4000: 73 68 61 70 65 20 30 29 20 30 29 0a 20 20 20 20 shape 0) 0). 4010: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 4020: 61 79 2d 65 6e 64 20 73 75 62 73 68 61 70 65 20 ay-end subshape 4030: 30 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 0) 1). 4040: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 (= (array-sta 4050: 72 74 20 73 75 62 73 68 61 70 65 20 31 29 20 30 rt subshape 1) 0 4060: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). ( 4070: 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 73 75 62 = (array-end sub 4080: 73 68 61 70 65 20 31 29 20 32 29 0a 20 20 20 20 shape 1) 2). 4090: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 40a0: 61 79 2d 72 65 66 20 73 75 62 73 68 61 70 65 20 ay-ref subshape 40b0: 30 20 30 29 20 34 29 0a 20 20 20 20 20 20 20 20 0 0) 4). 40c0: 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 (= (array-r 40d0: 65 66 20 73 75 62 73 68 61 70 65 20 30 20 31 29 ef subshape 0 1) 40e0: 20 37 29 29 0a 20 20 20 20 20 20 20 20 28 65 72 7)). (er 40f0: 72 6f 72 20 22 73 68 61 72 69 6e 67 20 73 75 62 ror "sharing sub 4100: 73 68 61 70 65 20 66 61 69 6c 65 64 22 29 29 0a shape failed")). 4110: 20 20 20 20 3b 28 61 72 72 61 79 2d 65 71 75 61 ;(array-equa 4120: 6c 3f 20 73 75 62 20 28 61 72 72 61 79 20 28 73 l? sub (array (s 4130: 68 61 70 65 20 34 20 37 29 20 31 20 32 20 33 29 hape 4 7) 1 2 3) 4140: 29 0a 20 20 20 20 28 6f 72 20 28 61 6e 64 20 28 ). (or (and ( 4150: 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 73 75 = (array-rank su 4160: 62 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 b) 1). 4170: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 (= (array-sta 4180: 72 74 20 73 75 62 20 30 29 20 34 29 0a 20 20 20 rt sub 0) 4). 4190: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar 41a0: 72 61 79 2d 65 6e 64 20 73 75 62 20 30 29 20 37 ray-end sub 0) 7 41b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). ( 41c0: 3d 20 28 61 72 72 61 79 2d 72 65 66 20 73 75 62 = (array-ref sub 41d0: 20 34 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 4) 1). 41e0: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 65 (= (array-re 41f0: 66 20 73 75 62 20 35 29 20 32 29 0a 20 20 20 20 f sub 5) 2). 4200: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr 4210: 61 79 2d 72 65 66 20 73 75 62 20 36 29 20 33 29 ay-ref sub 6) 3) 4220: 29 0a 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 ). (error 4230: 20 22 73 68 61 72 69 6e 67 20 77 69 74 68 20 73 "sharing with s 4240: 68 61 72 69 6e 67 20 73 75 62 73 68 61 70 65 20 haring subshape 4250: 66 61 69 6c 65 64 22 29 29 29 29 0a 0a 28 70 61 failed"))))..(pa 4260: 73 74 20 22 73 68 61 72 69 6e 67 20 77 69 74 68 st "sharing with 4270: 20 73 68 61 72 69 6e 67 20 73 75 62 73 68 61 70 sharing subshap 4280: 65 22 29 0a e").