Artifact
e83cb646a8efec2802cacb5519deb2f5cd1e5328:
0000: 23 21 72 36 72 73 0a 3b 3b 20 43 6f 70 79 72 69 #!r6rs.;; Copyri
0010: 67 68 74 20 28 63 29 20 32 30 30 39 20 44 65 72 ght (c) 2009 Der
0020: 69 63 6b 20 45 64 64 69 6e 67 74 6f 6e 2e 20 20 ick Eddington.
0030: 41 6c 6c 20 72 69 67 68 74 73 20 72 65 73 65 72 All rights reser
0040: 76 65 64 2e 20 20 4c 69 63 65 6e 73 65 64 20 75 ved. Licensed u
0050: 6e 64 65 72 20 61 6e 0a 3b 3b 20 4d 49 54 2d 73 nder an.;; MIT-s
0060: 74 79 6c 65 20 6c 69 63 65 6e 73 65 2e 20 20 4d tyle license. M
0070: 79 20 6c 69 63 65 6e 73 65 20 69 73 20 69 6e 20 y license is in
0080: 74 68 65 20 66 69 6c 65 20 6e 61 6d 65 64 20 4c the file named L
0090: 49 43 45 4e 53 45 20 66 72 6f 6d 20 74 68 65 20 ICENSE from the
00a0: 6f 72 69 67 69 6e 61 6c 0a 3b 3b 20 63 6f 6c 6c original.;; coll
00b0: 65 63 74 69 6f 6e 20 74 68 69 73 20 66 69 6c 65 ection this file
00c0: 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 is distributed
00d0: 77 69 74 68 2e 20 20 49 66 20 74 68 69 73 20 66 with. If this f
00e0: 69 6c 65 20 69 73 20 72 65 64 69 73 74 72 69 62 ile is redistrib
00f0: 75 74 65 64 20 77 69 74 68 0a 3b 3b 20 73 6f 6d uted with.;; som
0100: 65 20 6f 74 68 65 72 20 63 6f 6c 6c 65 63 74 69 e other collecti
0110: 6f 6e 2c 20 6d 79 20 6c 69 63 65 6e 73 65 20 6d on, my license m
0120: 75 73 74 20 61 6c 73 6f 20 62 65 20 69 6e 63 6c ust also be incl
0130: 75 64 65 64 2e 0a 0a 28 69 6d 70 6f 72 74 0a 20 uded...(import.
0140: 20 28 72 6e 72 73 29 0a 20 20 28 73 75 72 66 61 (rnrs). (surfa
0150: 67 65 20 73 32 35 20 6d 75 6c 74 69 2d 64 69 6d ge s25 multi-dim
0160: 65 6e 73 69 6f 6e 61 6c 2d 61 72 72 61 79 73 29 ensional-arrays)
0170: 0a 20 20 28 73 75 72 66 61 67 65 20 73 37 38 20 . (surfage s78
0180: 6c 69 67 68 74 77 65 69 67 68 74 2d 74 65 73 74 lightweight-test
0190: 69 6e 67 29 0a 20 20 28 73 75 72 66 61 67 65 20 ing). (surfage
01a0: 70 72 69 76 61 74 65 20 69 6e 63 6c 75 64 65 29 private include)
01b0: 29 0a 0a 3b 3b 20 28 6c 65 74 2d 73 79 6e 74 61 )..;; (let-synta
01c0: 78 20 28 28 6f 72 0a 3b 3b 20 20 20 20 20 20 20 x ((or.;;
01d0: 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d (syntax-
01e0: 72 75 6c 65 73 20 28 65 72 72 6f 72 29 0a 3b 3b rules (error).;;
01f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0200: 20 28 28 5f 20 65 78 70 72 20 28 65 72 72 6f 72 ((_ expr (error
0210: 20 6d 73 67 29 29 0a 3b 3b 20 20 20 20 20 20 20 msg)).;;
0220: 20 20 20 20 20 20 20 20 20 20 20 28 63 68 65 63 (chec
0230: 6b 20 28 61 6e 64 20 65 78 70 72 20 23 54 29 20 k (and expr #T)
0240: 3d 3e 20 23 54 29 29 0a 3b 3b 20 20 20 20 20 20 => #T)).;;
0250: 20 20 20 20 20 20 20 20 20 20 20 28 28 5f 20 2e ((_ .
0260: 20 72 29 20 28 6f 72 20 2e 20 72 29 29 29 29 0a r) (or . r)))).
0270: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
0280: 28 70 61 73 74 0a 3b 3b 20 20 20 20 20 20 20 20 (past.;;
0290: 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d 72 (syntax-r
02a0: 75 6c 65 73 20 28 29 0a 3b 3b 20 20 20 20 20 20 ules ().;;
02b0: 20 20 20 20 20 20 20 20 20 20 20 28 28 5f 20 2e ((_ .
02c0: 20 72 29 20 28 76 61 6c 75 65 73 29 29 29 29 29 r) (values)))))
02d0: 0a 3b 3b 20 20 20 28 69 6e 63 6c 75 64 65 2f 72 .;; (include/r
02e0: 65 73 6f 6c 76 65 20 28 22 73 75 72 66 61 67 65 esolve ("surfage
02f0: 22 20 22 73 32 35 22 29 20 22 74 65 73 74 2e 73 " "s25") "test.s
0300: 63 6d 22 29 29 0a 0a 28 6c 65 74 2d 73 79 6e 74 cm"))..(let-synt
0310: 61 78 20 28 28 6f 72 0a 20 20 20 20 20 20 20 20 ax ((or.
0320: 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75 (syntax-ru
0330: 6c 65 73 20 28 65 72 72 6f 72 29 0a 20 20 20 20 les (error).
0340: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 5f 20 ((_
0350: 65 78 70 72 20 28 65 72 72 6f 72 20 6d 73 67 29 expr (error msg)
0360: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0370: 20 20 20 28 63 68 65 63 6b 20 28 61 6e 64 20 65 (check (and e
0380: 78 70 72 20 23 54 29 20 3d 3e 20 23 54 29 29 0a xpr #T) => #T)).
0390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
03a0: 28 28 5f 20 2e 20 72 29 20 28 6f 72 20 2e 20 72 ((_ . r) (or . r
03b0: 29 29 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 ))))..
03c0: 20 20 20 28 70 61 73 74 0a 20 20 20 20 20 20 20 (past.
03d0: 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d 72 (syntax-r
03e0: 75 6c 65 73 20 28 29 0a 20 20 20 20 20 20 20 20 ules ().
03f0: 20 20 20 20 20 20 20 20 28 28 5f 20 2e 20 72 29 ((_ . r)
0400: 20 28 76 61 6c 75 65 73 29 29 29 29 0a 0a 20 20 (values))))..
0410: 20 20 20 20 20 20 20 20 20 20 20 29 0a 0a 20 20 )..
0420: 3b 3b 20 28 69 6e 63 6c 75 64 65 2f 72 65 73 6f ;; (include/reso
0430: 6c 76 65 20 28 22 73 75 72 66 61 67 65 22 20 22 lve ("surfage" "
0440: 73 32 35 22 29 20 22 74 65 73 74 2e 73 63 6d 22 s25") "test.scm"
0450: 29 0a 0a 3b 3b 3b 20 61 72 72 61 79 20 74 65 73 )..;;; array tes
0460: 74 0a 3b 3b 3b 20 32 30 30 31 20 4a 75 73 73 69 t.;;; 2001 Jussi
0470: 20 50 69 69 74 75 6c 61 69 6e 65 6e 0a 0a 3b 3b Piitulainen..;;
0480: 20 28 64 65 66 69 6e 65 20 70 61 73 74 0a 3b 3b (define past.;;
0490: 20 20 20 28 6c 65 74 20 28 28 73 74 6f 6e 65 73 (let ((stones
04a0: 20 27 28 29 29 29 0a 3b 3b 20 20 20 20 20 28 6c '())).;; (l
04b0: 61 6d 62 64 61 20 73 74 6f 6e 65 0a 3b 3b 20 20 ambda stone.;;
04c0: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
04d0: 73 74 6f 6e 65 29 0a 3b 3b 20 20 20 20 20 20 20 stone).;;
04e0: 20 20 20 20 28 72 65 76 65 72 73 65 20 73 74 6f (reverse sto
04f0: 6e 65 73 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 nes).;;
0500: 20 20 28 73 65 74 21 20 73 74 6f 6e 65 73 20 28 (set! stones (
0510: 63 6f 6e 73 20 28 61 70 70 6c 79 20 28 6c 61 6d cons (apply (lam
0520: 62 64 61 20 28 73 74 6f 6e 65 29 20 73 74 6f 6e bda (stone) ston
0530: 65 29 20 73 74 6f 6e 65 29 20 73 74 6f 6e 65 73 e) stone) stones
0540: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
0550: 28 74 61 69 6c 20 6e 29 0a 20 20 28 69 66 20 28 (tail n). (if (
0560: 3c 20 6e 20 28 6c 65 6e 67 74 68 20 28 70 61 73 < n (length (pas
0570: 74 29 29 29 0a 20 20 20 20 20 20 28 6c 69 73 74 t))). (list
0580: 2d 74 61 69 6c 20 28 70 61 73 74 29 20 28 2d 20 -tail (past) (-
0590: 28 6c 65 6e 67 74 68 20 28 70 61 73 74 29 29 20 (length (past))
05a0: 6e 29 29 0a 20 20 20 20 20 20 28 70 61 73 74 29 n)). (past)
05b0: 29 29 0a 0a 3b 3b 3b 20 53 69 6d 70 6c 65 20 74 ))..;;; Simple t
05c0: 65 73 74 73 0a 0a 28 6f 72 20 28 61 6e 64 20 28 ests..(or (and (
05d0: 73 68 61 70 65 29 0a 20 20 20 20 20 20 20 20 20 shape).
05e0: 28 73 68 61 70 65 20 2d 31 20 2d 31 29 0a 20 20 (shape -1 -1).
05f0: 20 20 20 20 20 20 20 28 73 68 61 70 65 20 2d 31 (shape -1
0600: 20 30 29 0a 20 20 20 20 20 20 20 20 20 28 73 68 0). (sh
0610: 61 70 65 20 2d 31 20 31 29 0a 20 20 20 20 20 20 ape -1 1).
0620: 20 20 20 28 73 68 61 70 65 20 31 20 32 20 33 20 (shape 1 2 3
0630: 34 20 35 20 36 20 37 20 38 20 31 20 32 20 33 20 4 5 6 7 8 1 2 3
0640: 34 20 35 20 36 20 37 20 38 20 31 20 32 20 33 20 4 5 6 7 8 1 2 3
0650: 34 20 35 20 36 20 37 20 38 29 29 0a 20 20 20 20 4 5 6 7 8)).
0660: 28 65 72 72 6f 72 20 22 28 73 68 61 70 65 20 2e (error "(shape .
0670: 2e 2e 29 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 ..) failed"))..(
0680: 70 61 73 74 20 22 73 68 61 70 65 22 29 0a 0a 28 past "shape")..(
0690: 6f 72 20 28 61 6e 64 20 28 6d 61 6b 65 2d 61 72 or (and (make-ar
06a0: 72 61 79 20 28 73 68 61 70 65 29 29 0a 20 20 20 ray (shape)).
06b0: 20 20 20 20 20 20 28 6d 61 6b 65 2d 61 72 72 61 (make-arra
06c0: 79 20 28 73 68 61 70 65 29 20 2a 29 0a 20 20 20 y (shape) *).
06d0: 20 20 20 20 20 20 28 6d 61 6b 65 2d 61 72 72 61 (make-arra
06e0: 79 20 28 73 68 61 70 65 20 2d 31 20 2d 31 29 29 y (shape -1 -1))
06f0: 0a 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d . (make-
0700: 61 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 array (shape -1
0710: 2d 31 29 20 2a 29 0a 20 20 20 20 20 20 20 20 20 -1) *).
0720: 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 (make-array (sha
0730: 70 65 20 2d 31 20 31 29 29 0a 20 20 20 20 20 20 pe -1 1)).
0740: 20 20 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 (make-array (
0750: 73 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 shape 1 2 3 4 5
0760: 36 20 37 20 38 20 31 20 32 20 33 20 34 20 35 20 6 7 8 1 2 3 4 5
0770: 36 20 37 20 38 20 31 20 32 20 33 20 34 29 20 2a 6 7 8 1 2 3 4) *
0780: 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 28 )). (error "(
0790: 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 make-array (shap
07a0: 65 20 2e 2e 2e 29 20 5b 6f 5d 29 20 66 61 69 6c e ...) [o]) fail
07b0: 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 6d 61 ed"))..(past "ma
07c0: 6b 65 2d 61 72 72 61 79 22 29 0a 0a 28 6f 72 20 ke-array")..(or
07d0: 28 61 6e 64 20 28 61 72 72 61 79 20 28 73 68 61 (and (array (sha
07e0: 70 65 29 20 2a 29 0a 20 20 20 20 20 20 20 20 20 pe) *).
07f0: 28 61 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 (array (shape -1
0800: 20 2d 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 -1)). (
0810: 61 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 array (shape -1
0820: 31 29 20 2a 20 2a 29 0a 20 20 20 20 20 20 20 20 1) * *).
0830: 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 31 (array (shape 1
0840: 20 32 20 33 20 34 20 35 20 36 20 37 20 38 20 31 2 3 4 5 6 7 8 1
0850: 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 20 2 3 4 5 6 7 8)
0860: 2a 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 *)). (error "
0870: 28 61 72 72 61 79 20 28 73 68 61 70 65 20 2e 2e (array (shape ..
0880: 2e 29 20 2e 2e 2e 29 20 66 61 69 6c 65 64 22 29 .) ...) failed")
0890: 29 0a 0a 28 70 61 73 74 20 22 61 72 72 61 79 22 )..(past "array"
08a0: 29 0a 0a 28 6f 72 20 28 61 6e 64 20 28 3d 20 28 )..(or (and (= (
08b0: 61 72 72 61 79 2d 72 61 6e 6b 20 28 73 68 61 70 array-rank (shap
08c0: 65 29 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 e)) 2).
08d0: 28 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 28 (= (array-rank (
08e0: 73 68 61 70 65 20 2d 31 20 2d 31 29 29 20 32 29 shape -1 -1)) 2)
08f0: 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 . (= (ar
0900: 72 61 79 2d 72 61 6e 6b 20 28 73 68 61 70 65 20 ray-rank (shape
0910: 2d 31 20 31 29 29 20 32 29 0a 20 20 20 20 20 20 -1 1)) 2).
0920: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 61 6e (= (array-ran
0930: 6b 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 k (shape 1 2 3 4
0940: 20 35 20 36 20 37 20 38 29 29 20 32 29 29 0a 20 5 6 7 8)) 2)).
0950: 20 20 20 28 65 72 72 6f 72 20 22 28 61 72 72 61 (error "(arra
0960: 79 2d 72 61 6e 6b 20 28 73 68 61 70 65 20 2e 2e y-rank (shape ..
0970: 2e 29 29 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 .)) failed"))..(
0980: 70 61 73 74 20 22 61 72 72 61 79 2d 72 61 6e 6b past "array-rank
0990: 20 6f 66 20 73 68 61 70 65 22 29 0a 0a 28 6f 72 of shape")..(or
09a0: 20 28 61 6e 64 20 28 3d 20 28 61 72 72 61 79 2d (and (= (array-
09b0: 72 61 6e 6b 20 28 6d 61 6b 65 2d 61 72 72 61 79 rank (make-array
09c0: 20 28 73 68 61 70 65 29 29 29 20 30 29 0a 20 20 (shape))) 0).
09d0: 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 (= (array
09e0: 2d 72 61 6e 6b 20 28 6d 61 6b 65 2d 61 72 72 61 -rank (make-arra
09f0: 79 20 28 73 68 61 70 65 20 2d 31 20 2d 31 29 29 y (shape -1 -1))
0a00: 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 28 3d ) 1). (=
0a10: 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 28 6d 61 (array-rank (ma
0a20: 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 ke-array (shape
0a30: 2d 31 20 31 29 29 29 20 31 29 0a 20 20 20 20 20 -1 1))) 1).
0a40: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 61 (= (array-ra
0a50: 6e 6b 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 nk (make-array (
0a60: 73 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 shape 1 2 3 4 5
0a70: 36 20 37 20 38 29 29 29 20 34 29 29 0a 20 20 20 6 7 8))) 4)).
0a80: 20 28 65 72 72 6f 72 20 22 28 61 72 72 61 79 2d (error "(array-
0a90: 72 61 6e 6b 20 28 6d 61 6b 65 2d 61 72 72 61 79 rank (make-array
0aa0: 20 2e 2e 2e 29 29 20 66 61 69 6c 65 64 22 29 29 ...)) failed"))
0ab0: 0a 0a 28 70 61 73 74 20 22 61 72 72 61 79 2d 72 ..(past "array-r
0ac0: 61 6e 6b 20 6f 66 20 6d 61 6b 65 2d 61 72 72 61 ank of make-arra
0ad0: 79 22 29 0a 0a 28 6f 72 20 28 61 6e 64 20 28 3d y")..(or (and (=
0ae0: 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 28 61 72 (array-rank (ar
0af0: 72 61 79 20 28 73 68 61 70 65 29 20 2a 29 29 20 ray (shape) *))
0b00: 30 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 0). (= (
0b10: 61 72 72 61 79 2d 72 61 6e 6b 20 28 61 72 72 61 array-rank (arra
0b20: 79 20 28 73 68 61 70 65 20 2d 31 20 2d 31 29 29 y (shape -1 -1))
0b30: 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 28 3d ) 1). (=
0b40: 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 28 61 72 (array-rank (ar
0b50: 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 31 29 ray (shape -1 1)
0b60: 20 2a 20 2a 29 29 20 31 29 0a 20 20 20 20 20 20 * *)) 1).
0b70: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 61 6e (= (array-ran
0b80: 6b 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 k (array (shape
0b90: 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 1 2 3 4 5 6 7 8)
0ba0: 20 2a 29 29 20 34 29 29 0a 20 20 20 20 28 65 72 *)) 4)). (er
0bb0: 72 6f 72 20 22 28 61 72 72 61 79 2d 72 61 6e 6b ror "(array-rank
0bc0: 20 28 61 72 72 61 79 20 2e 2e 2e 29 29 20 66 61 (array ...)) fa
0bd0: 69 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 iled"))..(past "
0be0: 61 72 72 61 79 2d 72 61 6e 6b 20 6f 66 20 61 72 array-rank of ar
0bf0: 72 61 79 22 29 0a 0a 28 6f 72 20 28 61 6e 64 20 ray")..(or (and
0c00: 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 (= (array-start
0c10: 28 73 68 61 70 65 20 2d 31 20 2d 31 29 20 30 29 (shape -1 -1) 0)
0c20: 20 30 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 0). (=
0c30: 28 61 72 72 61 79 2d 73 74 61 72 74 20 28 73 68 (array-start (sh
0c40: 61 70 65 20 2d 31 20 2d 31 29 20 31 29 20 30 29 ape -1 -1) 1) 0)
0c50: 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 . (= (ar
0c60: 72 61 79 2d 73 74 61 72 74 20 28 73 68 61 70 65 ray-start (shape
0c70: 20 2d 31 20 31 29 20 30 29 20 30 29 0a 20 20 20 -1 1) 0) 0).
0c80: 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d (= (array-
0c90: 73 74 61 72 74 20 28 73 68 61 70 65 20 2d 31 20 start (shape -1
0ca0: 31 29 20 31 29 20 30 29 0a 20 20 20 20 20 20 20 1) 1) 0).
0cb0: 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 (= (array-star
0cc0: 74 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 t (shape 1 2 3 4
0cd0: 20 35 20 36 20 37 20 38 29 20 30 29 20 30 29 0a 5 6 7 8) 0) 0).
0ce0: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr
0cf0: 61 79 2d 73 74 61 72 74 20 28 73 68 61 70 65 20 ay-start (shape
0d00: 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 1 2 3 4 5 6 7 8)
0d10: 20 31 29 20 30 29 29 0a 20 20 20 20 28 65 72 72 1) 0)). (err
0d20: 6f 72 20 22 28 61 72 72 61 79 2d 73 74 61 72 74 or "(array-start
0d30: 20 28 73 68 61 70 65 20 2e 2e 2e 29 29 20 66 61 (shape ...)) fa
0d40: 69 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 iled"))..(past "
0d50: 61 72 72 61 79 2d 73 74 61 72 74 20 6f 66 20 73 array-start of s
0d60: 68 61 70 65 22 29 0a 0a 28 6f 72 20 28 61 6e 64 hape")..(or (and
0d70: 20 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 28 (= (array-end (
0d80: 73 68 61 70 65 20 2d 31 20 2d 31 29 20 30 29 20 shape -1 -1) 0)
0d90: 31 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 1). (= (
0da0: 61 72 72 61 79 2d 65 6e 64 20 28 73 68 61 70 65 array-end (shape
0db0: 20 2d 31 20 2d 31 29 20 31 29 20 32 29 0a 20 20 -1 -1) 1) 2).
0dc0: 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 (= (array
0dd0: 2d 65 6e 64 20 28 73 68 61 70 65 20 2d 31 20 31 -end (shape -1 1
0de0: 29 20 30 29 20 31 29 0a 20 20 20 20 20 20 20 20 ) 0) 1).
0df0: 20 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 28 (= (array-end (
0e00: 73 68 61 70 65 20 2d 31 20 31 29 20 31 29 20 32 shape -1 1) 1) 2
0e10: 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 ). (= (a
0e20: 72 72 61 79 2d 65 6e 64 20 28 73 68 61 70 65 20 rray-end (shape
0e30: 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 1 2 3 4 5 6 7 8)
0e40: 20 30 29 20 34 29 0a 20 20 20 20 20 20 20 20 20 0) 4).
0e50: 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 28 73 (= (array-end (s
0e60: 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 hape 1 2 3 4 5 6
0e70: 20 37 20 38 29 20 31 29 20 32 29 29 0a 20 20 20 7 8) 1) 2)).
0e80: 20 28 65 72 72 6f 72 20 22 28 61 72 72 61 79 2d (error "(array-
0e90: 65 6e 64 20 28 73 68 61 70 65 20 2e 2e 2e 29 29 end (shape ...))
0ea0: 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 73 failed"))..(pas
0eb0: 74 20 22 61 72 72 61 79 2d 65 6e 64 20 6f 66 20 t "array-end of
0ec0: 73 68 61 70 65 22 29 0a 0a 28 6f 72 20 28 61 6e shape")..(or (an
0ed0: 64 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 d (= (array-star
0ee0: 74 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 t (make-array (s
0ef0: 68 61 70 65 20 2d 31 20 2d 31 29 29 20 30 29 20 hape -1 -1)) 0)
0f00: 2d 31 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 -1). (=
0f10: 28 61 72 72 61 79 2d 73 74 61 72 74 20 28 6d 61 (array-start (ma
0f20: 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 ke-array (shape
0f30: 2d 31 20 31 29 29 20 30 29 20 2d 31 29 0a 20 20 -1 1)) 0) -1).
0f40: 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 (= (array
0f50: 2d 73 74 61 72 74 20 28 6d 61 6b 65 2d 61 72 72 -start (make-arr
0f60: 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 ay (shape 1 2 3
0f70: 34 20 35 20 36 20 37 20 38 29 29 20 30 29 20 31 4 5 6 7 8)) 0) 1
0f80: 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 ). (= (a
0f90: 72 72 61 79 2d 73 74 61 72 74 20 28 6d 61 6b 65 rray-start (make
0fa0: 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 31 20 -array (shape 1
0fb0: 32 20 33 20 34 20 35 20 36 20 37 20 38 29 29 20 2 3 4 5 6 7 8))
0fc0: 31 29 20 33 29 0a 20 20 20 20 20 20 20 20 20 28 1) 3). (
0fd0: 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 28 = (array-start (
0fe0: 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 make-array (shap
0ff0: 65 20 31 20 32 20 33 20 34 20 35 20 36 20 37 20 e 1 2 3 4 5 6 7
1000: 38 29 29 20 32 29 20 35 29 0a 20 20 20 20 20 20 8)) 2) 5).
1010: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 (= (array-sta
1020: 72 74 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 rt (make-array (
1030: 73 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 shape 1 2 3 4 5
1040: 36 20 37 20 38 29 29 20 33 29 20 37 29 29 0a 20 6 7 8)) 3) 7)).
1050: 20 20 20 28 65 72 72 6f 72 20 22 28 61 72 72 61 (error "(arra
1060: 79 2d 73 74 61 72 74 20 28 6d 61 6b 65 2d 61 72 y-start (make-ar
1070: 72 61 79 20 2e 2e 2e 29 29 20 66 61 69 6c 65 64 ray ...)) failed
1080: 22 29 29 0a 0a 28 70 61 73 74 20 22 61 72 72 61 "))..(past "arra
1090: 79 2d 73 74 61 72 74 20 6f 66 20 6d 61 6b 65 2d y-start of make-
10a0: 61 72 72 61 79 22 29 0a 0a 28 6f 72 20 28 61 6e array")..(or (an
10b0: 64 20 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 d (= (array-end
10c0: 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 (make-array (sha
10d0: 70 65 20 2d 31 20 2d 31 29 29 20 30 29 20 2d 31 pe -1 -1)) 0) -1
10e0: 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 ). (= (a
10f0: 72 72 61 79 2d 65 6e 64 20 28 6d 61 6b 65 2d 61 rray-end (make-a
1100: 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 31 rray (shape -1 1
1110: 29 29 20 30 29 20 31 29 0a 20 20 20 20 20 20 20 )) 0) 1).
1120: 20 20 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 (= (array-end
1130: 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 (make-array (sha
1140: 70 65 20 31 20 32 20 33 20 34 20 35 20 36 20 37 pe 1 2 3 4 5 6 7
1150: 20 38 29 29 20 30 29 20 32 29 0a 20 20 20 20 20 8)) 0) 2).
1160: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 6e (= (array-en
1170: 64 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 d (make-array (s
1180: 68 61 70 65 20 31 20 32 20 33 20 34 20 35 20 36 hape 1 2 3 4 5 6
1190: 20 37 20 38 29 29 20 31 29 20 34 29 0a 20 20 20 7 8)) 1) 4).
11a0: 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d (= (array-
11b0: 65 6e 64 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 end (make-array
11c0: 28 73 68 61 70 65 20 31 20 32 20 33 20 34 20 35 (shape 1 2 3 4 5
11d0: 20 36 20 37 20 38 29 29 20 32 29 20 36 29 0a 20 6 7 8)) 2) 6).
11e0: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra
11f0: 79 2d 65 6e 64 20 28 6d 61 6b 65 2d 61 72 72 61 y-end (make-arra
1200: 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 y (shape 1 2 3 4
1210: 20 35 20 36 20 37 20 38 29 29 20 33 29 20 38 29 5 6 7 8)) 3) 8)
1220: 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 28 61 ). (error "(a
1230: 72 72 61 79 2d 65 6e 64 20 28 6d 61 6b 65 2d 61 rray-end (make-a
1240: 72 72 61 79 20 2e 2e 2e 29 29 20 66 61 69 6c 65 rray ...)) faile
1250: 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 72 72 d"))..(past "arr
1260: 61 79 2d 65 6e 64 20 6f 66 20 6d 61 6b 65 2d 61 ay-end of make-a
1270: 72 72 61 79 22 29 0a 0a 28 6f 72 20 28 61 6e 64 rray")..(or (and
1280: 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 (= (array-start
1290: 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 2d (array (shape -
12a0: 31 20 2d 31 29 29 20 30 29 20 2d 31 29 0a 20 20 1 -1)) 0) -1).
12b0: 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 (= (array
12c0: 2d 73 74 61 72 74 20 28 61 72 72 61 79 20 28 73 -start (array (s
12d0: 68 61 70 65 20 2d 31 20 31 29 20 2a 20 2a 29 20 hape -1 1) * *)
12e0: 30 29 20 2d 31 29 0a 20 20 20 20 20 20 20 20 20 0) -1).
12f0: 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 (= (array-start
1300: 28 61 72 72 61 79 20 28 73 68 61 70 65 20 31 20 (array (shape 1
1310: 32 20 33 20 34 20 35 20 36 20 37 20 38 29 20 2a 2 3 4 5 6 7 8) *
1320: 29 20 30 29 20 31 29 0a 20 20 20 20 20 20 20 20 ) 0) 1).
1330: 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 (= (array-start
1340: 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 31 (array (shape 1
1350: 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 20 2 3 4 5 6 7 8)
1360: 2a 29 20 31 29 20 33 29 0a 20 20 20 20 20 20 20 *) 1) 3).
1370: 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 (= (array-star
1380: 74 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 t (array (shape
1390: 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 1 2 3 4 5 6 7 8)
13a0: 20 2a 29 20 32 29 20 35 29 0a 20 20 20 20 20 20 *) 2) 5).
13b0: 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 (= (array-sta
13c0: 72 74 20 28 61 72 72 61 79 20 28 73 68 61 70 65 rt (array (shape
13d0: 20 31 20 32 20 33 20 34 20 35 20 36 20 37 20 38 1 2 3 4 5 6 7 8
13e0: 29 20 2a 29 20 33 29 20 37 29 29 0a 20 20 20 20 ) *) 3) 7)).
13f0: 28 65 72 72 6f 72 20 22 28 61 72 72 61 79 2d 73 (error "(array-s
1400: 74 61 72 74 20 28 61 72 72 61 79 20 2e 2e 2e 29 tart (array ...)
1410: 29 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 ) failed"))..(pa
1420: 73 74 20 22 61 72 72 61 79 2d 73 74 61 72 74 20 st "array-start
1430: 6f 66 20 61 72 72 61 79 22 29 0a 0a 28 6f 72 20 of array")..(or
1440: 28 61 6e 64 20 28 3d 20 28 61 72 72 61 79 2d 65 (and (= (array-e
1450: 6e 64 20 28 61 72 72 61 79 20 28 73 68 61 70 65 nd (array (shape
1460: 20 2d 31 20 2d 31 29 29 20 30 29 20 2d 31 29 0a -1 -1)) 0) -1).
1470: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr
1480: 61 79 2d 65 6e 64 20 28 61 72 72 61 79 20 28 73 ay-end (array (s
1490: 68 61 70 65 20 2d 31 20 31 29 20 2a 20 2a 29 20 hape -1 1) * *)
14a0: 30 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 28 0) 1). (
14b0: 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 28 61 72 = (array-end (ar
14c0: 72 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 ray (shape 1 2 3
14d0: 20 34 20 35 20 36 20 37 20 38 29 20 2a 29 20 30 4 5 6 7 8) *) 0
14e0: 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 28 3d ) 2). (=
14f0: 20 28 61 72 72 61 79 2d 65 6e 64 20 28 61 72 72 (array-end (arr
1500: 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 ay (shape 1 2 3
1510: 34 20 35 20 36 20 37 20 38 29 20 2a 29 20 31 29 4 5 6 7 8) *) 1)
1520: 20 34 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 4). (=
1530: 28 61 72 72 61 79 2d 65 6e 64 20 28 61 72 72 61 (array-end (arra
1540: 79 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 y (shape 1 2 3 4
1550: 20 35 20 36 20 37 20 38 29 20 2a 29 20 32 29 20 5 6 7 8) *) 2)
1560: 36 29 0a 20 20 20 20 20 20 20 20 20 28 3d 20 28 6). (= (
1570: 61 72 72 61 79 2d 65 6e 64 20 28 61 72 72 61 79 array-end (array
1580: 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 20 (shape 1 2 3 4
1590: 35 20 36 20 37 20 38 29 20 2a 29 20 33 29 20 38 5 6 7 8) *) 3) 8
15a0: 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 28 )). (error "(
15b0: 61 72 72 61 79 2d 65 6e 64 20 28 61 72 72 61 79 array-end (array
15c0: 20 2e 2e 2e 29 29 20 66 61 69 6c 65 64 22 29 29 ...)) failed"))
15d0: 0a 0a 28 70 61 73 74 20 22 61 72 72 61 79 2d 65 ..(past "array-e
15e0: 6e 64 20 6f 66 20 61 72 72 61 79 22 29 0a 0a 28 nd of array")..(
15f0: 6f 72 20 28 61 6e 64 20 28 65 71 3f 20 28 61 72 or (and (eq? (ar
1600: 72 61 79 2d 72 65 66 20 28 6d 61 6b 65 2d 61 72 ray-ref (make-ar
1610: 72 61 79 20 28 73 68 61 70 65 29 20 27 61 29 29 ray (shape) 'a))
1620: 20 27 61 29 0a 20 20 20 20 20 20 20 20 20 28 65 'a). (e
1630: 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 28 6d q? (array-ref (m
1640: 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 ake-array (shape
1650: 20 2d 31 20 31 29 20 27 62 29 20 2d 31 29 20 27 -1 1) 'b) -1) '
1660: 62 29 0a 20 20 20 20 20 20 20 20 20 28 65 71 3f b). (eq?
1670: 20 28 61 72 72 61 79 2d 72 65 66 20 28 6d 61 6b (array-ref (mak
1680: 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 2d e-array (shape -
1690: 31 20 31 29 20 27 63 29 20 30 29 20 27 63 29 0a 1 1) 'c) 0) 'c).
16a0: 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 (eq? (a
16b0: 72 72 61 79 2d 72 65 66 20 28 6d 61 6b 65 2d 61 rray-ref (make-a
16c0: 72 72 61 79 20 28 73 68 61 70 65 20 31 20 32 20 rray (shape 1 2
16d0: 33 20 34 20 35 20 36 20 37 20 38 29 20 27 64 29 3 4 5 6 7 8) 'd)
16e0: 20 31 20 33 20 35 20 37 29 20 27 64 29 29 0a 20 1 3 5 7) 'd)).
16f0: 20 20 20 28 65 72 72 6f 72 20 22 61 72 72 61 79 (error "array
1700: 2d 72 65 66 20 6f 66 20 6d 61 6b 65 2d 61 72 72 -ref of make-arr
1710: 61 79 20 77 69 74 68 20 61 72 67 75 6d 65 6e 74 ay with argument
1720: 73 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 s failed"))..(pa
1730: 73 74 20 22 61 72 72 61 79 2d 72 65 66 20 6f 66 st "array-ref of
1740: 20 6d 61 6b 65 2d 61 72 72 61 79 20 77 69 74 68 make-array with
1750: 20 61 72 67 75 6d 65 6e 74 73 22 29 0a 0a 28 6f arguments")..(o
1760: 72 20 28 61 6e 64 20 28 65 71 3f 20 28 61 72 72 r (and (eq? (arr
1770: 61 79 2d 72 65 66 20 28 6d 61 6b 65 2d 61 72 72 ay-ref (make-arr
1780: 61 79 20 28 73 68 61 70 65 29 20 27 61 29 20 27 ay (shape) 'a) '
1790: 23 28 29 29 20 27 61 29 0a 20 20 20 20 20 20 20 #()) 'a).
17a0: 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 65 (eq? (array-re
17b0: 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 f (make-array (s
17c0: 68 61 70 65 20 2d 31 20 31 29 20 27 62 29 20 27 hape -1 1) 'b) '
17d0: 23 28 2d 31 29 29 20 27 62 29 0a 20 20 20 20 20 #(-1)) 'b).
17e0: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array-
17f0: 72 65 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 ref (make-array
1800: 28 73 68 61 70 65 20 2d 31 20 31 29 20 27 63 29 (shape -1 1) 'c)
1810: 20 27 23 28 30 29 29 20 27 63 29 0a 20 20 20 20 '#(0)) 'c).
1820: 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 (eq? (array
1830: 2d 72 65 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 -ref (make-array
1840: 20 28 73 68 61 70 65 20 31 20 32 20 33 20 34 20 (shape 1 2 3 4
1850: 35 20 36 20 37 20 38 29 20 27 64 29 0a 20 20 20 5 6 7 8) 'd).
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1870: 20 20 20 20 20 20 27 23 28 31 20 33 20 35 20 37 '#(1 3 5 7
1880: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1890: 20 27 64 29 29 0a 20 20 20 20 28 65 72 72 6f 72 'd)). (error
18a0: 20 22 61 72 72 61 79 2d 72 65 66 20 6f 66 20 6d "array-ref of m
18b0: 61 6b 65 2d 61 72 72 61 79 20 77 69 74 68 20 76 ake-array with v
18c0: 65 63 74 6f 72 20 66 61 69 6c 65 64 22 29 29 0a ector failed")).
18d0: 0a 28 70 61 73 74 20 22 61 72 72 61 79 2d 72 65 .(past "array-re
18e0: 66 20 6f 66 20 6d 61 6b 65 2d 61 72 72 61 79 20 f of make-array
18f0: 77 69 74 68 20 76 65 63 74 6f 72 22 29 0a 0a 28 with vector")..(
1900: 6f 72 20 28 61 6e 64 20 28 65 71 3f 20 28 61 72 or (and (eq? (ar
1910: 72 61 79 2d 72 65 66 20 28 6d 61 6b 65 2d 61 72 ray-ref (make-ar
1920: 72 61 79 20 28 73 68 61 70 65 29 20 27 61 29 0a ray (shape) 'a).
1930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1940: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 20 (array
1950: 28 73 68 61 70 65 20 30 20 30 29 29 29 0a 20 20 (shape 0 0))).
1960: 20 20 20 20 20 20 20 20 20 20 20 20 27 61 29 0a 'a).
1970: 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 (eq? (a
1980: 72 72 61 79 2d 72 65 66 20 28 6d 61 6b 65 2d 61 rray-ref (make-a
1990: 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 31 rray (shape -1 1
19a0: 29 20 27 62 29 0a 20 20 20 20 20 20 20 20 20 20 ) 'b).
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
19c0: 61 72 72 61 79 20 28 73 68 61 70 65 20 30 20 31 array (shape 0 1
19d0: 29 20 2d 31 29 29 0a 20 20 20 20 20 20 20 20 20 ) -1)).
19e0: 20 20 20 20 20 27 62 29 0a 20 20 20 20 20 20 20 'b).
19f0: 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 65 (eq? (array-re
1a00: 66 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 f (make-array (s
1a10: 68 61 70 65 20 2d 31 20 31 29 20 27 63 29 0a 20 hape -1 1) 'c).
1a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a30: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 20 28 (array (
1a40: 73 68 61 70 65 20 30 20 31 29 20 30 29 29 0a 20 shape 0 1) 0)).
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 27 63 29 'c)
1a60: 0a 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 . (eq? (
1a70: 61 72 72 61 79 2d 72 65 66 20 28 6d 61 6b 65 2d array-ref (make-
1a80: 61 72 72 61 79 20 28 73 68 61 70 65 20 31 20 32 array (shape 1 2
1a90: 20 33 20 34 20 35 20 36 20 37 20 38 29 20 27 64 3 4 5 6 7 8) 'd
1aa0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1ab0: 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 (arra
1ac0: 79 20 28 73 68 61 70 65 20 30 20 34 29 20 31 20 y (shape 0 4) 1
1ad0: 33 20 35 20 37 29 29 0a 20 20 20 20 20 20 20 20 3 5 7)).
1ae0: 20 20 20 20 20 20 27 64 29 29 0a 20 20 20 20 28 'd)). (
1af0: 65 72 72 6f 72 20 22 28 61 72 72 61 79 2d 72 65 error "(array-re
1b00: 66 20 6f 66 20 6d 61 6b 65 2d 61 72 72 61 79 20 f of make-array
1b10: 77 69 74 68 20 61 72 72 61 79 20 66 61 69 6c 65 with array faile
1b20: 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 72 72 d"))..(past "arr
1b30: 61 79 2d 72 65 66 20 6f 66 20 6d 61 6b 65 2d 61 ay-ref of make-a
1b40: 72 72 61 79 20 77 69 74 68 20 61 72 72 61 79 22 rray with array"
1b50: 29 0a 0a 28 6f 72 20 28 61 6e 64 20 28 6c 65 74 )..(or (and (let
1b60: 20 28 28 61 72 72 20 28 6d 61 6b 65 2d 61 72 72 ((arr (make-arr
1b70: 61 79 20 28 73 68 61 70 65 29 20 27 6f 29 29 29 ay (shape) 'o)))
1b80: 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72 . (arr
1b90: 61 79 2d 73 65 74 21 20 61 72 72 20 27 61 29 0a ay-set! arr 'a).
1ba0: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 (eq?
1bb0: 28 61 72 72 61 79 2d 72 65 66 20 61 72 72 29 20 (array-ref arr)
1bc0: 27 61 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c 'a)). (l
1bd0: 65 74 20 28 28 61 72 72 20 28 6d 61 6b 65 2d 61 et ((arr (make-a
1be0: 72 72 61 79 20 28 73 68 61 70 65 20 2d 31 20 31 rray (shape -1 1
1bf0: 29 20 27 6f 29 29 29 0a 20 20 20 20 20 20 20 20 ) 'o))).
1c00: 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 20 61 (array-set! a
1c10: 72 72 20 2d 31 20 27 62 29 0a 20 20 20 20 20 20 rr -1 'b).
1c20: 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 (array-set!
1c30: 20 61 72 72 20 30 20 27 63 29 0a 20 20 20 20 20 arr 0 'c).
1c40: 20 20 20 20 20 20 28 61 6e 64 20 28 65 71 3f 20 (and (eq?
1c50: 28 61 72 72 61 79 2d 72 65 66 20 61 72 72 20 2d (array-ref arr -
1c60: 31 29 20 27 62 29 0a 20 20 20 20 20 20 20 20 20 1) 'b).
1c70: 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 (eq? (arr
1c80: 61 79 2d 72 65 66 20 61 72 72 20 30 29 20 27 63 ay-ref arr 0) 'c
1c90: 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c 65 ))). (le
1ca0: 74 20 28 28 61 72 72 20 28 6d 61 6b 65 2d 61 72 t ((arr (make-ar
1cb0: 72 61 79 20 28 73 68 61 70 65 20 31 20 32 20 33 ray (shape 1 2 3
1cc0: 20 34 20 35 20 36 20 37 20 38 29 20 27 6f 29 29 4 5 6 7 8) 'o))
1cd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 72 ). (ar
1ce0: 72 61 79 2d 73 65 74 21 20 61 72 72 20 31 20 33 ray-set! arr 1 3
1cf0: 20 35 20 37 20 27 64 29 0a 20 20 20 20 20 20 20 5 7 'd).
1d00: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array-
1d10: 72 65 66 20 61 72 72 20 31 20 33 20 35 20 37 29 ref arr 1 3 5 7)
1d20: 20 27 64 29 29 29 0a 20 20 20 20 28 65 72 72 6f 'd))). (erro
1d30: 72 20 22 61 72 72 61 79 2d 73 65 74 21 20 77 69 r "array-set! wi
1d40: 74 68 20 61 72 67 75 6d 65 6e 74 73 20 66 61 69 th arguments fai
1d50: 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 61 led"))..(past "a
1d60: 72 72 61 79 2d 73 65 74 21 20 6f 66 20 6d 61 6b rray-set! of mak
1d70: 65 2d 61 72 72 61 79 20 77 69 74 68 20 61 72 67 e-array with arg
1d80: 75 6d 65 6e 74 73 22 29 0a 0a 28 6f 72 20 28 61 uments")..(or (a
1d90: 6e 64 20 28 6c 65 74 20 28 28 61 72 72 20 28 6d nd (let ((arr (m
1da0: 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 ake-array (shape
1db0: 29 20 27 6f 29 29 29 0a 20 20 20 20 20 20 20 20 ) 'o))).
1dc0: 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 20 61 (array-set! a
1dd0: 72 72 20 27 23 28 29 20 27 61 29 0a 20 20 20 20 rr '#() 'a).
1de0: 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 72 (eq? (arr
1df0: 61 79 2d 72 65 66 20 61 72 72 29 20 27 61 29 29 ay-ref arr) 'a))
1e00: 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 . (let (
1e10: 28 61 72 72 20 28 6d 61 6b 65 2d 61 72 72 61 79 (arr (make-array
1e20: 20 28 73 68 61 70 65 20 2d 31 20 31 29 20 27 6f (shape -1 1) 'o
1e30: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
1e40: 61 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 27 array-set! arr '
1e50: 23 28 2d 31 29 20 27 62 29 0a 20 20 20 20 20 20 #(-1) 'b).
1e60: 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 (array-set!
1e70: 20 61 72 72 20 27 23 28 30 29 20 27 63 29 0a 20 arr '#(0) 'c).
1e80: 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 (and (
1e90: 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 eq? (array-ref a
1ea0: 72 72 20 2d 31 29 20 27 62 29 0a 20 20 20 20 20 rr -1) 'b).
1eb0: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 (eq?
1ec0: 28 61 72 72 61 79 2d 72 65 66 20 61 72 72 20 30 (array-ref arr 0
1ed0: 29 20 27 63 29 29 29 0a 20 20 20 20 20 20 20 20 ) 'c))).
1ee0: 20 28 6c 65 74 20 28 28 61 72 72 20 28 6d 61 6b (let ((arr (mak
1ef0: 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 31 e-array (shape 1
1f00: 20 32 20 33 20 34 20 35 20 36 20 37 20 38 29 20 2 3 4 5 6 7 8)
1f10: 27 6f 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 'o))).
1f20: 20 28 61 72 72 61 79 2d 73 65 74 21 20 61 72 72 (array-set! arr
1f30: 20 27 23 28 31 20 33 20 35 20 37 29 20 27 64 29 '#(1 3 5 7) 'd)
1f40: 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 71 3f . (eq?
1f50: 20 28 61 72 72 61 79 2d 72 65 66 20 61 72 72 20 (array-ref arr
1f60: 31 20 33 20 35 20 37 29 20 27 64 29 29 29 0a 20 1 3 5 7) 'd))).
1f70: 20 20 20 28 65 72 72 6f 72 20 22 61 72 72 61 79 (error "array
1f80: 2d 73 65 74 21 20 77 69 74 68 20 76 65 63 74 6f -set! with vecto
1f90: 72 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 r failed"))..(pa
1fa0: 73 74 20 22 61 72 72 61 79 2d 73 65 74 21 20 6f st "array-set! o
1fb0: 66 20 6d 61 6b 65 2d 61 72 72 61 79 20 77 69 74 f make-array wit
1fc0: 68 20 76 65 63 74 6f 72 22 29 0a 0a 28 6f 72 20 h vector")..(or
1fd0: 28 61 6e 64 20 28 6c 65 74 20 28 28 61 72 72 20 (and (let ((arr
1fe0: 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 (make-array (sha
1ff0: 70 65 29 20 27 6f 29 29 29 0a 20 20 20 20 20 20 pe) 'o))).
2000: 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 (array-set!
2010: 20 61 72 72 20 27 61 29 0a 20 20 20 20 20 20 20 arr 'a).
2020: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array-
2030: 72 65 66 20 61 72 72 29 20 27 61 29 29 0a 20 20 ref arr) 'a)).
2040: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 72 (let ((ar
2050: 72 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 r (make-array (s
2060: 68 61 70 65 20 2d 31 20 31 29 20 27 6f 29 29 29 hape -1 1) 'o)))
2070: 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72 . (arr
2080: 61 79 2d 73 65 74 21 20 61 72 72 20 28 61 72 72 ay-set! arr (arr
2090: 61 79 20 28 73 68 61 70 65 20 30 20 31 29 20 2d ay (shape 0 1) -
20a0: 31 29 20 27 62 29 0a 20 20 20 20 20 20 20 20 20 1) 'b).
20b0: 20 20 28 61 72 72 61 79 2d 73 65 74 21 20 61 72 (array-set! ar
20c0: 72 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 r (array (shape
20d0: 30 20 31 29 20 30 29 20 27 63 29 0a 20 20 20 20 0 1) 0) 'c).
20e0: 20 20 20 20 20 20 20 28 61 6e 64 20 28 65 71 3f (and (eq?
20f0: 20 28 61 72 72 61 79 2d 72 65 66 20 61 72 72 20 (array-ref arr
2100: 2d 31 29 20 27 62 29 0a 20 20 20 20 20 20 20 20 -1) 'b).
2110: 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 (eq? (ar
2120: 72 61 79 2d 72 65 66 20 61 72 72 20 30 29 20 27 ray-ref arr 0) '
2130: 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c c))). (l
2140: 65 74 20 28 28 61 72 72 20 28 6d 61 6b 65 2d 61 et ((arr (make-a
2150: 72 72 61 79 20 28 73 68 61 70 65 20 31 20 32 20 rray (shape 1 2
2160: 33 20 34 20 35 20 36 20 37 20 38 29 20 27 6f 29 3 4 5 6 7 8) 'o)
2170: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 )). (a
2180: 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 28 61 rray-set! arr (a
2190: 72 72 61 79 20 28 73 68 61 70 65 20 30 20 34 29 rray (shape 0 4)
21a0: 20 31 20 33 20 35 20 37 29 20 27 64 29 0a 20 20 1 3 5 7) 'd).
21b0: 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 (eq? (a
21c0: 72 72 61 79 2d 72 65 66 20 61 72 72 20 31 20 33 rray-ref arr 1 3
21d0: 20 35 20 37 29 20 27 64 29 29 29 0a 20 20 20 20 5 7) 'd))).
21e0: 28 65 72 72 6f 72 20 22 61 72 72 61 79 2d 73 65 (error "array-se
21f0: 74 21 20 77 69 74 68 20 61 72 67 75 6d 65 6e 74 t! with argument
2200: 73 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 s failed"))..(pa
2210: 73 74 20 22 61 72 72 61 79 2d 73 65 74 21 20 6f st "array-set! o
2220: 66 20 6d 61 6b 65 2d 61 72 72 61 79 20 77 69 74 f make-array wit
2230: 68 20 61 72 72 61 79 22 29 0a 0a 3b 3b 3b 20 53 h array")..;;; S
2240: 68 61 72 65 20 61 6e 64 20 63 68 61 6e 67 65 3a hare and change:
2250: 0a 3b 3b 3b 0a 3b 3b 3b 20 20 6f 72 67 20 20 20 .;;;.;;; org
2260: 20 20 62 72 6b 20 20 20 20 20 73 77 70 20 20 20 brk swp
2270: 20 20 20 20 20 20 20 20 20 62 6f 78 0a 3b 3b 3b box.;;;
2280: 0a 3b 3b 3b 20 20 20 30 20 31 20 20 20 20 20 31 .;;; 0 1 1
2290: 20 32 20 20 20 20 20 35 20 36 0a 3b 3b 3b 20 36 2 5 6.;;; 6
22a0: 20 61 20 62 20 20 20 32 20 61 20 62 20 20 20 33 a b 2 a b 3
22b0: 20 64 20 63 20 20 20 30 20 32 20 34 20 36 20 38 d c 0 2 4 6 8
22c0: 3a 20 65 0a 3b 3b 3b 20 37 20 63 20 64 20 20 20 : e.;;; 7 c d
22d0: 33 20 65 20 66 20 20 20 34 20 66 20 65 0a 3b 3b 3 e f 4 f e.;;
22e0: 3b 20 38 20 65 20 66 0a 0a 28 6f 72 20 28 6c 65 ; 8 e f..(or (le
22f0: 74 2a 20 28 28 6f 72 67 20 28 61 72 72 61 79 20 t* ((org (array
2300: 28 73 68 61 70 65 20 36 20 39 20 30 20 32 29 20 (shape 6 9 0 2)
2310: 27 61 20 27 62 20 27 63 20 27 64 20 27 65 20 27 'a 'b 'c 'd 'e '
2320: 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 f)). (
2330: 62 72 6b 20 28 73 68 61 72 65 2d 61 72 72 61 79 brk (share-array
2340: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2350: 20 20 6f 72 67 0a 20 20 20 20 20 20 20 20 20 20 org.
2360: 20 20 20 20 20 20 20 28 73 68 61 70 65 20 32 20 (shape 2
2370: 34 20 31 20 33 29 0a 20 20 20 20 20 20 20 20 20 4 1 3).
2380: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
2390: 28 72 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 (r k).
23a0: 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 (values
23b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
23c0: 20 20 20 20 20 28 2b 20 36 20 28 2a 20 32 20 28 (+ 6 (* 2 (
23d0: 2d 20 72 20 32 29 29 29 0a 20 20 20 20 20 20 20 - r 2))).
23e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 (-
23f0: 6b 20 31 29 29 29 29 29 0a 20 20 20 20 20 20 20 k 1))))).
2400: 20 20 20 20 28 73 77 70 20 28 73 68 61 72 65 2d (swp (share-
2410: 61 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 array.
2420: 20 20 20 20 20 20 20 6f 72 67 0a 20 20 20 20 20 org.
2430: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 61 (sha
2440: 70 65 20 33 20 35 20 35 20 37 29 0a 20 20 20 20 pe 3 5 5 7).
2450: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
2460: 6d 62 64 61 20 28 72 20 6b 29 0a 20 20 20 20 20 mbda (r k).
2470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
2480: 61 6c 75 65 73 0a 20 20 20 20 20 20 20 20 20 20 alues.
2490: 20 20 20 20 20 20 20 20 20 20 28 2b 20 37 20 28 (+ 7 (
24a0: 2d 20 72 20 33 29 29 0a 20 20 20 20 20 20 20 20 - r 3)).
24b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 31 (- 1
24c0: 20 28 2d 20 6b 20 35 29 29 29 29 29 29 0a 20 20 (- k 5)))))).
24d0: 20 20 20 20 20 20 20 20 20 28 62 6f 78 20 28 73 (box (s
24e0: 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 20 hare-array.
24f0: 20 20 20 20 20 20 20 20 20 20 20 20 73 77 70 0a swp.
2500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2510: 20 28 73 68 61 70 65 20 30 20 31 20 32 20 33 20 (shape 0 1 2 3
2520: 34 20 35 20 36 20 37 20 38 20 39 29 0a 20 20 20 4 5 6 7 8 9).
2530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
2540: 61 6d 62 64 61 20 5f 20 28 76 61 6c 75 65 73 20 ambda _ (values
2550: 34 20 36 29 29 29 29 0a 20 20 20 20 20 20 20 20 4 6)))).
2560: 20 20 20 28 6f 72 67 2d 63 6f 6e 74 65 6e 74 73 (org-contents
2570: 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 (lambda ().
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2590: 20 20 20 20 20 20 20 28 6c 69 73 74 20 28 61 72 (list (ar
25a0: 72 61 79 2d 72 65 66 20 6f 72 67 20 36 20 30 29 ray-ref org 6 0)
25b0: 20 28 61 72 72 61 79 2d 72 65 66 20 6f 72 67 20 (array-ref org
25c0: 36 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 6 1).
25d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25e0: 20 20 20 20 20 20 28 61 72 72 61 79 2d 72 65 66 (array-ref
25f0: 20 6f 72 67 20 37 20 30 29 20 28 61 72 72 61 79 org 7 0) (array
2600: 2d 72 65 66 20 6f 72 67 20 37 20 31 29 0a 20 20 -ref org 7 1).
2610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2630: 61 72 72 61 79 2d 72 65 66 20 6f 72 67 20 38 20 array-ref org 8
2640: 30 29 20 28 61 72 72 61 79 2d 72 65 66 20 6f 72 0) (array-ref or
2650: 67 20 38 20 31 29 29 29 29 0a 20 20 20 20 20 20 g 8 1)))).
2660: 20 20 20 20 20 28 62 72 6b 2d 63 6f 6e 74 65 6e (brk-conten
2670: 74 73 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 ts (lambda ().
2680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2690: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 28 (list (
26a0: 61 72 72 61 79 2d 72 65 66 20 62 72 6b 20 32 20 array-ref brk 2
26b0: 31 29 20 28 61 72 72 61 79 2d 72 65 66 20 62 72 1) (array-ref br
26c0: 6b 20 32 20 32 29 0a 20 20 20 20 20 20 20 20 20 k 2 2).
26d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26e0: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 2d 72 (array-r
26f0: 65 66 20 62 72 6b 20 33 20 31 29 20 28 61 72 72 ef brk 3 1) (arr
2700: 61 79 2d 72 65 66 20 62 72 6b 20 33 20 32 29 29 ay-ref brk 3 2))
2710: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 73 )). (s
2720: 77 70 2d 63 6f 6e 74 65 6e 74 73 20 28 6c 61 6d wp-contents (lam
2730: 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 bda ().
2740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2750: 20 20 28 6c 69 73 74 20 28 61 72 72 61 79 2d 72 (list (array-r
2760: 65 66 20 73 77 70 20 33 20 35 29 20 28 61 72 72 ef swp 3 5) (arr
2770: 61 79 2d 72 65 66 20 73 77 70 20 33 20 36 29 0a ay-ref swp 3 6).
2780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27a0: 20 28 61 72 72 61 79 2d 72 65 66 20 73 77 70 20 (array-ref swp
27b0: 34 20 35 29 20 28 61 72 72 61 79 2d 72 65 66 20 4 5) (array-ref
27c0: 73 77 70 20 34 20 36 29 29 29 29 0a 20 20 20 20 swp 4 6)))).
27d0: 20 20 20 20 20 20 20 28 62 6f 78 2d 63 6f 6e 74 (box-cont
27e0: 65 6e 74 73 20 28 6c 61 6d 62 64 61 20 28 29 0a ents (lambda ().
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2800: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 (list
2810: 20 28 61 72 72 61 79 2d 72 65 66 20 62 6f 78 20 (array-ref box
2820: 30 20 32 20 34 20 36 20 38 29 29 29 29 29 0a 20 0 2 4 6 8))))).
2830: 20 20 20 20 20 28 61 6e 64 20 28 65 71 75 61 6c (and (equal
2840: 3f 20 28 6f 72 67 2d 63 6f 6e 74 65 6e 74 73 29 ? (org-contents)
2850: 20 27 28 61 20 62 20 63 20 64 20 65 20 66 29 29 '(a b c d e f))
2860: 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 . (equ
2870: 61 6c 3f 20 28 62 72 6b 2d 63 6f 6e 74 65 6e 74 al? (brk-content
2880: 73 29 20 27 28 61 20 62 20 65 20 66 29 29 0a 20 s) '(a b e f)).
2890: 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 6c (equal
28a0: 3f 20 28 73 77 70 2d 63 6f 6e 74 65 6e 74 73 29 ? (swp-contents)
28b0: 20 27 28 64 20 63 20 66 20 65 29 29 0a 20 20 20 '(d c f e)).
28c0: 20 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 (equal?
28d0: 28 62 6f 78 2d 63 6f 6e 74 65 6e 74 73 29 20 27 (box-contents) '
28e0: 28 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 (e)).
28f0: 28 62 65 67 69 6e 20 28 61 72 72 61 79 2d 73 65 (begin (array-se
2900: 74 21 20 6f 72 67 20 36 20 30 20 27 78 29 20 23 t! org 6 0 'x) #
2910: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 t). (e
2920: 71 75 61 6c 3f 20 28 6f 72 67 2d 63 6f 6e 74 65 qual? (org-conte
2930: 6e 74 73 29 20 27 28 78 20 62 20 63 20 64 20 65 nts) '(x b c d e
2940: 20 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f)).
2950: 28 65 71 75 61 6c 3f 20 28 62 72 6b 2d 63 6f 6e (equal? (brk-con
2960: 74 65 6e 74 73 29 20 27 28 78 20 62 20 65 20 66 tents) '(x b e f
2970: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 )). (e
2980: 71 75 61 6c 3f 20 28 73 77 70 2d 63 6f 6e 74 65 qual? (swp-conte
2990: 6e 74 73 29 20 27 28 64 20 63 20 66 20 65 29 29 nts) '(d c f e))
29a0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 . (equ
29b0: 61 6c 3f 20 28 62 6f 78 2d 63 6f 6e 74 65 6e 74 al? (box-content
29c0: 73 29 20 27 28 65 29 29 0a 20 20 20 20 20 20 20 s) '(e)).
29d0: 20 20 20 20 28 62 65 67 69 6e 20 28 61 72 72 61 (begin (arra
29e0: 79 2d 73 65 74 21 20 62 72 6b 20 33 20 31 20 27 y-set! brk 3 1 '
29f0: 79 29 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 y) #t).
2a00: 20 20 28 65 71 75 61 6c 3f 20 28 6f 72 67 2d 63 (equal? (org-c
2a10: 6f 6e 74 65 6e 74 73 29 20 27 28 78 20 62 20 63 ontents) '(x b c
2a20: 20 64 20 79 20 66 29 29 0a 20 20 20 20 20 20 20 d y f)).
2a30: 20 20 20 20 28 65 71 75 61 6c 3f 20 28 62 72 6b (equal? (brk
2a40: 2d 63 6f 6e 74 65 6e 74 73 29 20 27 28 78 20 62 -contents) '(x b
2a50: 20 79 20 66 29 29 0a 20 20 20 20 20 20 20 20 20 y f)).
2a60: 20 20 28 65 71 75 61 6c 3f 20 28 73 77 70 2d 63 (equal? (swp-c
2a70: 6f 6e 74 65 6e 74 73 29 20 27 28 64 20 63 20 66 ontents) '(d c f
2a80: 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 y)).
2a90: 28 65 71 75 61 6c 3f 20 28 62 6f 78 2d 63 6f 6e (equal? (box-con
2aa0: 74 65 6e 74 73 29 20 27 28 79 29 29 0a 20 20 20 tents) '(y)).
2ab0: 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 20 28 (begin (
2ac0: 61 72 72 61 79 2d 73 65 74 21 20 73 77 70 20 34 array-set! swp 4
2ad0: 20 35 20 27 7a 29 20 23 74 29 0a 20 20 20 20 20 5 'z) #t).
2ae0: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 6f (equal? (o
2af0: 72 67 2d 63 6f 6e 74 65 6e 74 73 29 20 27 28 78 rg-contents) '(x
2b00: 20 62 20 63 20 64 20 79 20 7a 29 29 0a 20 20 20 b c d y z)).
2b10: 20 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 (equal?
2b20: 28 62 72 6b 2d 63 6f 6e 74 65 6e 74 73 29 20 27 (brk-contents) '
2b30: 28 78 20 62 20 79 20 7a 29 29 0a 20 20 20 20 20 (x b y z)).
2b40: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 73 (equal? (s
2b50: 77 70 2d 63 6f 6e 74 65 6e 74 73 29 20 27 28 64 wp-contents) '(d
2b60: 20 63 20 7a 20 79 29 29 0a 20 20 20 20 20 20 20 c z y)).
2b70: 20 20 20 20 28 65 71 75 61 6c 3f 20 28 62 6f 78 (equal? (box
2b80: 2d 63 6f 6e 74 65 6e 74 73 29 20 27 28 79 29 29 -contents) '(y))
2b90: 0a 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 . (beg
2ba0: 69 6e 20 28 61 72 72 61 79 2d 73 65 74 21 20 62 in (array-set! b
2bb0: 6f 78 20 30 20 32 20 34 20 36 20 38 20 27 65 29 ox 0 2 4 6 8 'e)
2bc0: 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 #t).
2bd0: 28 65 71 75 61 6c 3f 20 28 6f 72 67 2d 63 6f 6e (equal? (org-con
2be0: 74 65 6e 74 73 29 20 27 28 78 20 62 20 63 20 64 tents) '(x b c d
2bf0: 20 65 20 7a 29 29 0a 20 20 20 20 20 20 20 20 20 e z)).
2c00: 20 20 28 65 71 75 61 6c 3f 20 28 62 72 6b 2d 63 (equal? (brk-c
2c10: 6f 6e 74 65 6e 74 73 29 20 27 28 78 20 62 20 65 ontents) '(x b e
2c20: 20 7a 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 z)).
2c30: 28 65 71 75 61 6c 3f 20 28 73 77 70 2d 63 6f 6e (equal? (swp-con
2c40: 74 65 6e 74 73 29 20 27 28 64 20 63 20 7a 20 65 tents) '(d c z e
2c50: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 )). (e
2c60: 71 75 61 6c 3f 20 28 62 6f 78 2d 63 6f 6e 74 65 qual? (box-conte
2c70: 6e 74 73 29 20 27 28 65 29 29 29 29 0a 20 20 20 nts) '(e)))).
2c80: 20 28 65 72 72 6f 72 20 22 73 68 61 72 65 64 20 (error "shared
2c90: 63 68 61 6e 67 65 20 66 61 69 6c 65 64 22 29 29 change failed"))
2ca0: 0a 0a 28 70 61 73 74 20 22 73 68 61 72 65 64 20 ..(past "shared
2cb0: 63 68 61 6e 67 65 22 29 0a 0a 3b 3b 3b 20 43 68 change")..;;; Ch
2cc0: 65 63 6b 20 74 68 61 74 20 61 72 72 61 79 73 20 eck that arrays
2cd0: 63 6f 70 79 20 74 68 65 20 73 68 61 70 65 20 73 copy the shape s
2ce0: 70 65 63 69 66 69 63 61 74 69 6f 6e 0a 0a 28 6f pecification..(o
2cf0: 72 20 28 6c 65 74 20 28 28 73 68 70 20 28 73 68 r (let ((shp (sh
2d00: 61 70 65 20 31 30 20 31 32 29 29 29 0a 20 20 20 ape 10 12))).
2d10: 20 20 20 28 6c 65 74 20 28 28 61 72 72 20 28 6d (let ((arr (m
2d20: 61 6b 65 2d 61 72 72 61 79 20 73 68 70 29 29 0a ake-array shp)).
2d30: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72 73 (ars
2d40: 20 28 61 72 72 61 79 20 73 68 70 20 2a 20 2a 29 (array shp * *)
2d50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 61 ). (a
2d60: 72 74 20 28 73 68 61 72 65 2d 61 72 72 61 79 20 rt (share-array
2d70: 28 6d 61 6b 65 2d 61 72 72 61 79 20 73 68 70 29 (make-array shp)
2d80: 20 73 68 70 20 28 6c 61 6d 62 64 61 20 28 6b 29 shp (lambda (k)
2d90: 20 6b 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 k)))). (
2da0: 61 72 72 61 79 2d 73 65 74 21 20 73 68 70 20 30 array-set! shp 0
2db0: 20 30 20 27 3f 29 0a 20 20 20 20 20 20 20 20 28 0 '?). (
2dc0: 61 72 72 61 79 2d 73 65 74 21 20 73 68 70 20 30 array-set! shp 0
2dd0: 20 31 20 27 21 29 0a 20 20 20 20 20 20 20 20 28 1 '!). (
2de0: 61 6e 64 20 28 3d 20 28 61 72 72 61 79 2d 72 61 and (= (array-ra
2df0: 6e 6b 20 73 68 70 29 20 32 29 0a 20 20 20 20 20 nk shp) 2).
2e00: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra
2e10: 79 2d 73 74 61 72 74 20 73 68 70 20 30 29 20 30 y-start shp 0) 0
2e20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
2e30: 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 73 68 70 = (array-end shp
2e40: 20 30 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 0) 1).
2e50: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 (= (array-st
2e60: 61 72 74 20 73 68 70 20 31 29 20 30 29 0a 20 20 art shp 1) 0).
2e70: 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 (= (a
2e80: 72 72 61 79 2d 65 6e 64 20 73 68 70 20 31 29 20 rray-end shp 1)
2e90: 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 2).
2ea0: 28 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 (eq? (array-ref
2eb0: 73 68 70 20 30 20 30 29 20 27 3f 29 0a 20 20 20 shp 0 0) '?).
2ec0: 20 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 (eq? (
2ed0: 61 72 72 61 79 2d 72 65 66 20 73 68 70 20 30 20 array-ref shp 0
2ee0: 31 29 20 27 21 29 0a 20 20 20 20 20 20 20 20 20 1) '!).
2ef0: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 61 (= (array-ra
2f00: 6e 6b 20 61 72 72 29 20 31 29 0a 20 20 20 20 20 nk arr) 1).
2f10: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra
2f20: 79 2d 73 74 61 72 74 20 61 72 72 20 30 29 20 31 y-start arr 0) 1
2f30: 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0).
2f40: 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 61 72 (= (array-end ar
2f50: 72 20 30 29 20 31 32 29 0a 20 20 20 20 20 20 20 r 0) 12).
2f60: 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d (= (array-
2f70: 72 61 6e 6b 20 61 72 73 29 20 31 29 0a 20 20 20 rank ars) 1).
2f80: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar
2f90: 72 61 79 2d 73 74 61 72 74 20 61 72 73 20 30 29 ray-start ars 0)
2fa0: 20 31 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 10).
2fb0: 20 20 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 (= (array-end
2fc0: 61 72 73 20 30 29 20 31 32 29 0a 20 20 20 20 20 ars 0) 12).
2fd0: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra
2fe0: 79 2d 72 61 6e 6b 20 61 72 74 29 20 31 29 0a 20 y-rank art) 1).
2ff0: 20 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 (= (
3000: 61 72 72 61 79 2d 73 74 61 72 74 20 61 72 74 20 array-start art
3010: 30 29 20 31 30 29 0a 20 20 20 20 20 20 20 20 20 0) 10).
3020: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 6e (= (array-en
3030: 64 20 61 72 74 20 30 29 20 31 32 29 29 29 29 0a d art 0) 12)))).
3040: 20 20 20 20 28 65 72 72 6f 72 20 22 61 72 72 61 (error "arra
3050: 79 2d 73 65 74 21 20 6f 66 20 73 68 61 70 65 20 y-set! of shape
3060: 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 73 74 failed"))..(past
3070: 20 22 61 72 72 61 79 2d 73 65 74 21 20 6f 66 20 "array-set! of
3080: 73 68 61 70 65 22 29 0a 0a 3b 3b 3b 20 43 68 65 shape")..;;; Che
3090: 63 6b 20 74 68 61 74 20 69 6e 64 65 78 20 61 72 ck that index ar
30a0: 72 61 79 73 20 77 6f 72 6b 20 65 76 65 6e 20 77 rays work even w
30b0: 68 65 6e 20 74 68 65 79 20 73 68 61 72 65 0a 3b hen they share.;
30c0: 3b 3b 0a 3b 3b 3b 20 61 72 72 20 20 20 20 20 20 ;;.;;; arr
30d0: 20 69 78 6e 0a 3b 3b 3b 20 20 20 35 20 20 36 20 ixn.;;; 5 6
30e0: 20 20 20 20 20 30 20 31 0a 3b 3b 3b 20 34 20 6e 0 1.;;; 4 n
30f0: 77 20 6e 65 20 20 20 30 20 34 20 36 0a 3b 3b 3b w ne 0 4 6.;;;
3100: 20 35 20 73 77 20 73 65 20 20 20 31 20 35 20 34 5 sw se 1 5 4
3110: 0a 0a 28 6f 72 20 28 6c 65 74 20 28 28 61 72 72 ..(or (let ((arr
3120: 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 34 (array (shape 4
3130: 20 36 20 35 20 37 29 20 27 6e 77 20 27 6e 65 20 6 5 7) 'nw 'ne
3140: 27 73 77 20 27 73 65 29 29 0a 20 20 20 20 20 20 'sw 'se)).
3150: 20 20 20 20 28 69 78 6e 20 28 61 72 72 61 79 20 (ixn (array
3160: 28 73 68 61 70 65 20 30 20 32 20 30 20 32 29 20 (shape 0 2 0 2)
3170: 34 20 36 20 35 20 34 29 29 29 0a 20 20 20 20 20 4 6 5 4))).
3180: 20 28 6c 65 74 20 28 28 63 6f 6c 30 20 28 73 68 (let ((col0 (sh
3190: 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 20 20 are-array.
31a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 78 6e ixn
31b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
31c0: 20 20 20 20 28 73 68 61 70 65 20 30 20 32 29 0a (shape 0 2).
31d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31e0: 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 29 0a 20 (lambda (k).
31f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3200: 20 20 20 20 28 76 61 6c 75 65 73 20 6b 20 30 29 (values k 0)
3210: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
3220: 28 72 6f 77 30 20 28 73 68 61 72 65 2d 61 72 72 (row0 (share-arr
3230: 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ay.
3240: 20 20 20 20 20 20 69 78 6e 0a 20 20 20 20 20 20 ixn.
3250: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 (sh
3260: 61 70 65 20 30 20 32 29 0a 20 20 20 20 20 20 20 ape 0 2).
3270: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
3280: 62 64 61 20 28 6b 29 0a 20 20 20 20 20 20 20 20 bda (k).
3290: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 61 (va
32a0: 6c 75 65 73 20 30 20 6b 29 29 29 29 0a 20 20 20 lues 0 k)))).
32b0: 20 20 20 20 20 20 20 20 20 28 77 6f 72 31 20 28 (wor1 (
32c0: 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 share-array.
32d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
32e0: 78 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 xn.
32f0: 20 20 20 20 20 20 28 73 68 61 70 65 20 30 20 32 (shape 0 2
3300: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3310: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 29 (lambda (k)
3320: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3330: 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 31 20 (values 1
3340: 28 2d 20 31 20 6b 29 29 29 29 29 0a 20 20 20 20 (- 1 k))))).
3350: 20 20 20 20 20 20 20 20 28 63 6f 64 20 28 73 68 (cod (sh
3360: 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 20 20 are-array.
3370: 20 20 20 20 20 20 20 20 20 20 20 20 69 78 6e 0a ixn.
3380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3390: 20 20 28 73 68 61 70 65 20 30 20 32 29 0a 20 20 (shape 0 2).
33a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33b0: 28 6c 61 6d 62 64 61 20 28 6b 29 0a 20 20 20 20 (lambda (k).
33c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33d0: 28 63 61 73 65 20 6b 0a 20 20 20 20 20 20 20 20 (case k.
33e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
33f0: 30 29 20 28 76 61 6c 75 65 73 20 31 20 30 29 29 0) (values 1 0))
3400: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3410: 20 20 20 20 20 20 20 28 28 31 29 20 28 76 61 6c ((1) (val
3420: 75 65 73 20 30 20 31 29 29 29 29 29 29 0a 20 20 ues 0 1)))))).
3430: 20 20 20 20 20 20 20 20 20 20 28 62 6f 78 20 28 (box (
3440: 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 share-array.
3450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 78 ix
3460: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
3470: 20 20 20 20 28 73 68 61 70 65 20 30 20 32 29 0a (shape 0 2).
3480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3490: 20 20 28 6c 61 6d 62 64 61 20 28 6b 29 0a 20 20 (lambda (k).
34a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34b0: 20 20 28 76 61 6c 75 65 73 20 31 20 30 29 29 29 (values 1 0)))
34c0: 29 29 0a 20 20 20 20 20 20 20 20 28 61 6e 64 20 )). (and
34d0: 28 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 (eq? (array-ref
34e0: 61 72 72 20 63 6f 6c 30 29 20 27 6e 77 29 0a 20 arr col0) 'nw).
34f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 71 3f (eq?
3500: 20 28 61 72 72 61 79 2d 72 65 66 20 61 72 72 20 (array-ref arr
3510: 72 6f 77 30 29 20 27 6e 65 29 0a 20 20 20 20 20 row0) 'ne).
3520: 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 72 (eq? (ar
3530: 72 61 79 2d 72 65 66 20 61 72 72 20 77 6f 72 31 ray-ref arr wor1
3540: 29 20 27 6e 77 29 0a 20 20 20 20 20 20 20 20 20 ) 'nw).
3550: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array-
3560: 72 65 66 20 61 72 72 20 63 6f 64 29 20 27 73 65 ref arr cod) 'se
3570: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
3580: 65 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 eq? (array-ref a
3590: 72 72 20 62 6f 78 29 20 27 73 77 29 0a 20 20 20 rr box) 'sw).
35a0: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
35b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
35c0: 28 61 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 (array-set! arr
35d0: 63 6f 6c 30 20 27 75 6c 29 0a 20 20 20 20 20 20 col0 'ul).
35e0: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 2d (array-
35f0: 73 65 74 21 20 61 72 72 20 72 6f 77 30 20 27 75 set! arr row0 'u
3600: 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r).
3610: 20 20 28 61 72 72 61 79 2d 73 65 74 21 20 61 72 (array-set! ar
3620: 72 20 63 6f 64 20 27 6c 72 29 0a 20 20 20 20 20 r cod 'lr).
3630: 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 (array
3640: 2d 73 65 74 21 20 61 72 72 20 62 6f 78 20 27 6c -set! arr box 'l
3650: 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 l).
3660: 20 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 #t).
3670: 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d 72 (eq? (array-r
3680: 65 66 20 61 72 72 20 34 20 35 29 20 27 75 6c 29 ef arr 4 5) 'ul)
3690: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 . (e
36a0: 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 72 q? (array-ref ar
36b0: 72 20 34 20 36 29 20 27 75 72 29 0a 20 20 20 20 r 4 6) 'ur).
36c0: 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 28 61 (eq? (a
36d0: 72 72 61 79 2d 72 65 66 20 61 72 72 20 35 20 35 rray-ref arr 5 5
36e0: 29 20 27 6c 6c 29 0a 20 20 20 20 20 20 20 20 20 ) 'll).
36f0: 20 20 20 20 28 65 71 3f 20 28 61 72 72 61 79 2d (eq? (array-
3700: 72 65 66 20 61 72 72 20 35 20 36 29 20 27 6c 72 ref arr 5 6) 'lr
3710: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
3720: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
3730: 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 (array-set!
3740: 20 61 72 72 20 77 6f 72 31 20 27 78 78 29 0a 20 arr wor1 'xx).
3750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
3760: 71 3f 20 28 61 72 72 61 79 2d 72 65 66 20 61 72 q? (array-ref ar
3770: 72 20 34 20 35 29 20 27 78 78 29 29 29 29 29 0a r 4 5) 'xx))))).
3780: 20 20 20 20 28 65 72 72 6f 72 20 22 61 72 72 61 (error "arra
3790: 79 20 61 63 63 65 73 73 20 77 69 74 68 20 73 68 y access with sh
37a0: 61 72 69 6e 67 20 69 6e 64 65 78 20 61 72 72 61 aring index arra
37b0: 79 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 61 y failed"))..(pa
37c0: 73 74 20 22 61 72 72 61 79 20 61 63 63 65 73 73 st "array access
37d0: 20 77 69 74 68 20 73 68 61 72 69 6e 67 20 69 6e with sharing in
37e0: 64 65 78 20 61 72 72 61 79 22 29 0a 0a 3b 3b 3b dex array")..;;;
37f0: 20 43 68 65 63 6b 20 74 68 61 74 20 73 68 61 70 Check that shap
3800: 65 20 61 72 72 61 79 73 20 77 6f 72 6b 20 65 76 e arrays work ev
3810: 65 6e 20 77 68 65 6e 20 74 68 65 79 20 73 68 61 en when they sha
3820: 72 65 0a 3b 3b 3b 0a 3b 3b 3b 20 61 72 72 20 20 re.;;;.;;; arr
3830: 20 20 20 20 20 20 20 20 20 20 20 73 68 70 20 20 shp
3840: 20 20 20 20 20 73 68 71 20 20 20 20 20 20 20 73 shq s
3850: 68 72 20 20 20 20 20 20 20 73 68 73 0a 3b 3b 3b hr shs.;;;
3860: 20 20 20 20 31 20 20 32 20 20 33 20 20 34 20 20 1 2 3 4
3870: 20 20 20 20 30 20 20 31 20 20 20 20 20 20 30 20 0 1 0
3880: 20 31 20 20 20 20 20 20 30 20 20 31 20 20 20 20 1 0 1
3890: 20 20 30 20 20 31 20 0a 3b 3b 3b 20 31 20 31 30 0 1 .;;; 1 10
38a0: 20 31 32 20 31 36 20 32 30 20 20 20 30 20 31 30 12 16 20 0 10
38b0: 20 31 32 20 20 20 30 20 31 32 20 32 30 20 20 20 12 0 12 20
38c0: 30 20 31 30 20 31 30 20 20 20 30 20 31 32 20 31 0 10 10 0 12 1
38d0: 32 0a 3b 3b 3b 20 32 20 31 30 20 31 31 20 31 32 2.;;; 2 10 11 12
38e0: 20 31 33 20 20 20 31 20 31 30 20 31 31 20 20 20 13 1 10 11
38f0: 31 20 31 31 20 31 33 20 20 20 31 20 31 31 20 31 1 11 13 1 11 1
3900: 32 20 20 20 31 20 31 32 20 31 32 0a 3b 3b 3b 20 2 1 12 12.;;;
3910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3930: 20 20 20 20 32 20 31 32 20 31 36 0a 3b 3b 3b 20 2 12 16.;;;
3940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3960: 20 20 20 20 33 20 31 33 20 32 30 0a 0a 28 6f 72 3 13 20..(or
3970: 20 28 6c 65 74 20 28 28 61 72 72 20 28 61 72 72 (let ((arr (arr
3980: 61 79 20 28 73 68 61 70 65 20 31 20 33 20 31 20 ay (shape 1 3 1
3990: 35 29 20 31 30 20 31 32 20 31 36 20 32 30 20 31 5) 10 12 16 20 1
39a0: 30 20 31 31 20 31 32 20 31 33 29 29 29 0a 20 20 0 11 12 13))).
39b0: 20 20 20 20 28 6c 65 74 20 28 28 73 68 70 20 28 (let ((shp (
39c0: 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 share-array.
39d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 72 ar
39e0: 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
39f0: 20 20 20 20 28 73 68 61 70 65 20 30 20 32 20 30 (shape 0 2 0
3a00: 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2).
3a10: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 (lambda (r
3a20: 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 k).
3a30: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 (values
3a40: 28 2b 20 72 20 31 29 20 28 2b 20 6b 20 31 29 29 (+ r 1) (+ k 1))
3a50: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
3a60: 28 73 68 71 20 28 73 68 61 72 65 2d 61 72 72 61 (shq (share-arra
3a70: 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y.
3a80: 20 20 20 20 61 72 72 0a 20 20 20 20 20 20 20 20 arr.
3a90: 20 20 20 20 20 20 20 20 20 20 28 73 68 61 70 65 (shape
3aa0: 20 30 20 32 20 30 20 32 29 0a 20 20 20 20 20 20 0 2 0 2).
3ab0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
3ac0: 62 64 61 20 28 72 20 6b 29 0a 20 20 20 20 20 20 bda (r k).
3ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
3ae0: 61 6c 75 65 73 20 28 2b 20 72 20 31 29 20 28 2a alues (+ r 1) (*
3af0: 20 32 20 28 2b 20 31 20 6b 29 29 29 29 29 29 0a 2 (+ 1 k)))))).
3b00: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 72 (shr
3b10: 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 (share-array.
3b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b30: 61 72 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 arr.
3b40: 20 20 20 20 20 20 28 73 68 61 70 65 20 30 20 34 (shape 0 4
3b50: 20 30 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 0 2).
3b60: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
3b70: 28 72 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 (r k).
3b80: 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 (value
3b90: 73 20 28 2d 20 32 20 6b 29 20 28 2b 20 72 20 31 s (- 2 k) (+ r 1
3ba0: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
3bb0: 20 20 28 73 68 73 20 28 73 68 61 72 65 2d 61 72 (shs (share-ar
3bc0: 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 ray.
3bd0: 20 20 20 20 20 20 61 72 72 0a 20 20 20 20 20 20 arr.
3be0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 61 (sha
3bf0: 70 65 20 30 20 32 20 30 20 32 29 0a 20 20 20 20 pe 0 2 0 2).
3c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
3c10: 61 6d 62 64 61 20 28 72 20 6b 29 0a 20 20 20 20 ambda (r k).
3c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c30: 28 76 61 6c 75 65 73 20 32 20 33 29 29 29 29 29 (values 2 3)))))
3c40: 0a 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 6c . (and (l
3c50: 65 74 20 28 28 61 72 72 2d 70 20 28 6d 61 6b 65 et ((arr-p (make
3c60: 2d 61 72 72 61 79 20 73 68 70 29 29 29 0a 20 20 -array shp))).
3c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
3c80: 64 20 28 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b d (= (array-rank
3c90: 20 61 72 72 2d 70 29 20 32 29 0a 20 20 20 20 20 arr-p) 2).
3ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3cb0: 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 61 = (array-start a
3cc0: 72 72 2d 70 20 30 29 20 31 30 29 0a 20 20 20 20 rr-p 0) 10).
3cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ce0: 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 61 72 (= (array-end ar
3cf0: 72 2d 70 20 30 29 20 31 32 29 0a 20 20 20 20 20 r-p 0) 12).
3d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3d10: 3d 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 61 = (array-start a
3d20: 72 72 2d 70 20 31 29 20 31 30 29 0a 20 20 20 20 rr-p 1) 10).
3d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d40: 28 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 61 72 (= (array-end ar
3d50: 72 2d 70 20 31 29 20 31 31 29 29 29 0a 20 20 20 r-p 1) 11))).
3d60: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
3d70: 28 61 72 72 2d 71 20 28 61 72 72 61 79 20 73 68 (arr-q (array sh
3d80: 71 20 2a 20 2a 20 2a 20 2a 20 20 2a 20 2a 20 2a q * * * * * * *
3d90: 20 2a 20 20 2a 20 2a 20 2a 20 2a 20 20 2a 20 2a * * * * * * *
3da0: 20 2a 20 2a 29 29 29 0a 20 20 20 20 20 20 20 20 * *))).
3db0: 20 20 20 20 20 20 20 28 61 6e 64 20 28 3d 20 28 (and (= (
3dc0: 61 72 72 61 79 2d 72 61 6e 6b 20 61 72 72 2d 71 array-rank arr-q
3dd0: 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) 2).
3de0: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr
3df0: 61 79 2d 73 74 61 72 74 20 61 72 72 2d 71 20 30 ay-start arr-q 0
3e00: 29 20 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 ) 12).
3e10: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar
3e20: 72 61 79 2d 65 6e 64 20 61 72 72 2d 71 20 30 29 ray-end arr-q 0)
3e30: 20 32 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20).
3e40: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr
3e50: 61 79 2d 73 74 61 72 74 20 61 72 72 2d 71 20 31 ay-start arr-q 1
3e60: 29 20 31 31 29 0a 20 20 20 20 20 20 20 20 20 20 ) 11).
3e70: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar
3e80: 72 61 79 2d 65 6e 64 20 61 72 72 2d 71 20 31 29 ray-end arr-q 1)
3e90: 20 31 33 29 29 29 0a 20 20 20 20 20 20 20 20 20 13))).
3ea0: 20 20 20 20 28 6c 65 74 20 28 28 61 72 72 2d 72 (let ((arr-r
3eb0: 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 (share-array.
3ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ed0: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 20 (array
3ee0: 28 73 68 61 70 65 29 20 2a 29 0a 20 20 20 20 20 (shape) *).
3ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f00: 20 20 20 20 20 20 73 68 72 0a 20 20 20 20 20 20 shr.
3f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f20: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 5f 20 28 (lambda _ (
3f30: 76 61 6c 75 65 73 29 29 29 29 29 0a 20 20 20 20 values))))).
3f40: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
3f50: 28 3d 20 28 61 72 72 61 79 2d 72 61 6e 6b 20 61 (= (array-rank a
3f60: 72 72 2d 72 29 20 34 29 0a 20 20 20 20 20 20 20 rr-r) 4).
3f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 (=
3f80: 28 61 72 72 61 79 2d 73 74 61 72 74 20 61 72 72 (array-start arr
3f90: 2d 72 20 30 29 20 31 30 29 0a 20 20 20 20 20 20 -r 0) 10).
3fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d (=
3fb0: 20 28 61 72 72 61 79 2d 65 6e 64 20 61 72 72 2d (array-end arr-
3fc0: 72 20 30 29 20 31 30 29 0a 20 20 20 20 20 20 20 r 0) 10).
3fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 (=
3fe0: 28 61 72 72 61 79 2d 73 74 61 72 74 20 61 72 72 (array-start arr
3ff0: 2d 72 20 31 29 20 31 31 29 0a 20 20 20 20 20 20 -r 1) 11).
4000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d (=
4010: 20 28 61 72 72 61 79 2d 65 6e 64 20 61 72 72 2d (array-end arr-
4020: 72 20 31 29 20 31 32 29 0a 20 20 20 20 20 20 20 r 1) 12).
4030: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 (=
4040: 28 61 72 72 61 79 2d 73 74 61 72 74 20 61 72 72 (array-start arr
4050: 2d 72 20 32 29 20 31 32 29 0a 20 20 20 20 20 20 -r 2) 12).
4060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d (=
4070: 20 28 61 72 72 61 79 2d 65 6e 64 20 61 72 72 2d (array-end arr-
4080: 72 20 32 29 20 31 36 29 0a 20 20 20 20 20 20 20 r 2) 16).
4090: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 (=
40a0: 28 61 72 72 61 79 2d 73 74 61 72 74 20 61 72 72 (array-start arr
40b0: 2d 72 20 33 29 20 31 33 29 0a 20 20 20 20 20 20 -r 3) 13).
40c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d (=
40d0: 20 28 61 72 72 61 79 2d 65 6e 64 20 61 72 72 2d (array-end arr-
40e0: 72 20 33 29 20 32 30 29 29 29 0a 20 20 20 20 20 r 3) 20))).
40f0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 (let ((a
4100: 72 72 2d 73 20 28 6d 61 6b 65 2d 61 72 72 61 79 rr-s (make-array
4110: 20 73 68 73 29 29 29 0a 20 20 20 20 20 20 20 20 shs))).
4120: 20 20 20 20 20 20 20 28 61 6e 64 20 28 3d 20 28 (and (= (
4130: 61 72 72 61 79 2d 72 61 6e 6b 20 61 72 72 2d 73 array-rank arr-s
4140: 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) 2).
4150: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr
4160: 61 79 2d 73 74 61 72 74 20 61 72 72 2d 73 20 30 ay-start arr-s 0
4170: 29 20 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 ) 12).
4180: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar
4190: 72 61 79 2d 65 6e 64 20 61 72 72 2d 73 20 30 29 ray-end arr-s 0)
41a0: 20 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 12).
41b0: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr
41c0: 61 79 2d 73 74 61 72 74 20 61 72 72 2d 73 20 31 ay-start arr-s 1
41d0: 29 20 31 32 29 0a 20 20 20 20 20 20 20 20 20 20 ) 12).
41e0: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar
41f0: 72 61 79 2d 65 6e 64 20 61 72 72 2d 73 20 31 29 ray-end arr-s 1)
4200: 20 31 32 29 29 29 29 29 29 0a 20 20 20 20 28 65 12)))))). (e
4210: 72 72 6f 72 20 22 73 68 61 72 69 6e 67 20 73 68 rror "sharing sh
4220: 61 70 65 20 61 72 72 61 79 20 66 61 69 6c 65 64 ape array failed
4230: 22 29 29 0a 0a 28 70 61 73 74 20 22 73 68 61 72 "))..(past "shar
4240: 69 6e 67 20 73 68 61 70 65 20 61 72 72 61 79 22 ing shape array"
4250: 29 0a 0a 28 6c 65 74 20 28 28 73 75 70 65 72 20 )..(let ((super
4260: 28 61 72 72 61 79 20 28 73 68 61 70 65 20 34 20 (array (shape 4
4270: 37 20 34 20 37 29 0a 20 20 20 20 20 20 20 20 20 7 4 7).
4280: 20 20 20 20 20 20 20 20 20 20 20 31 20 2a 20 2a 1 * *
4290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
42a0: 20 20 20 20 20 2a 20 32 20 2a 0a 20 20 20 20 20 * 2 *.
42b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2a *
42c0: 20 2a 20 33 29 29 0a 20 20 20 20 20 20 28 73 75 * 3)). (su
42d0: 62 73 68 61 70 65 20 28 73 68 61 72 65 2d 61 72 bshape (share-ar
42e0: 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 ray.
42f0: 20 20 20 20 20 28 61 72 72 61 79 20 28 73 68 61 (array (sha
4300: 70 65 20 30 20 32 20 30 20 33 29 0a 20 20 20 20 pe 0 2 0 3).
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4320: 20 20 20 20 2a 20 34 20 2a 0a 20 20 20 20 20 20 * 4 *.
4330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4340: 20 20 2a 20 37 20 2a 29 0a 20 20 20 20 20 20 20 * 7 *).
4350: 20 20 20 20 20 20 20 20 20 20 28 73 68 61 70 65 (shape
4360: 20 30 20 31 20 30 20 32 29 0a 20 20 20 20 20 20 0 1 0 2).
4370: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
4380: 64 61 20 28 72 20 6b 29 0a 20 20 20 20 20 20 20 da (r k).
4390: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c (val
43a0: 75 65 73 20 6b 20 31 29 29 29 29 29 0a 20 20 28 ues k 1))))). (
43b0: 6c 65 74 20 28 28 73 75 62 20 28 73 68 61 72 65 let ((sub (share
43c0: 2d 61 72 72 61 79 20 73 75 70 65 72 20 73 75 62 -array super sub
43d0: 73 68 61 70 65 20 28 6c 61 6d 62 64 61 20 28 6b shape (lambda (k
43e0: 29 20 28 76 61 6c 75 65 73 20 6b 20 6b 29 29 29 ) (values k k)))
43f0: 29 29 0a 20 20 20 20 3b 28 61 72 72 61 79 2d 65 )). ;(array-e
4400: 71 75 61 6c 3f 20 73 75 62 73 68 61 70 65 20 28 qual? subshape (
4410: 73 68 61 70 65 20 34 20 37 29 29 0a 20 20 20 20 shape 4 7)).
4420: 28 6f 72 20 28 61 6e 64 20 28 3d 20 28 61 72 72 (or (and (= (arr
4430: 61 79 2d 72 61 6e 6b 20 73 75 62 73 68 61 70 65 ay-rank subshape
4440: 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) 2).
4450: 20 20 28 3d 20 28 61 72 72 61 79 2d 73 74 61 72 (= (array-star
4460: 74 20 73 75 62 73 68 61 70 65 20 30 29 20 30 29 t subshape 0) 0)
4470: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d . (=
4480: 20 28 61 72 72 61 79 2d 65 6e 64 20 73 75 62 73 (array-end subs
4490: 68 61 70 65 20 30 29 20 31 29 0a 20 20 20 20 20 hape 0) 1).
44a0: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra
44b0: 79 2d 73 74 61 72 74 20 73 75 62 73 68 61 70 65 y-start subshape
44c0: 20 31 29 20 30 29 0a 20 20 20 20 20 20 20 20 20 1) 0).
44d0: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 65 6e (= (array-en
44e0: 64 20 73 75 62 73 68 61 70 65 20 31 29 20 32 29 d subshape 1) 2)
44f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d . (=
4500: 20 28 61 72 72 61 79 2d 72 65 66 20 73 75 62 73 (array-ref subs
4510: 68 61 70 65 20 30 20 30 29 20 34 29 0a 20 20 20 hape 0 0) 4).
4520: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 (= (ar
4530: 72 61 79 2d 72 65 66 20 73 75 62 73 68 61 70 65 ray-ref subshape
4540: 20 30 20 31 29 20 37 29 29 0a 20 20 20 20 20 20 0 1) 7)).
4550: 20 20 28 65 72 72 6f 72 20 22 73 68 61 72 69 6e (error "sharin
4560: 67 20 73 75 62 73 68 61 70 65 20 66 61 69 6c 65 g subshape faile
4570: 64 22 29 29 0a 20 20 20 20 3b 28 61 72 72 61 79 d")). ;(array
4580: 2d 65 71 75 61 6c 3f 20 73 75 62 20 28 61 72 72 -equal? sub (arr
4590: 61 79 20 28 73 68 61 70 65 20 34 20 37 29 20 31 ay (shape 4 7) 1
45a0: 20 32 20 33 29 29 0a 20 20 20 20 28 6f 72 20 28 2 3)). (or (
45b0: 61 6e 64 20 28 3d 20 28 61 72 72 61 79 2d 72 61 and (= (array-ra
45c0: 6e 6b 20 73 75 62 29 20 31 29 0a 20 20 20 20 20 nk sub) 1).
45d0: 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 61 (= (arra
45e0: 79 2d 73 74 61 72 74 20 73 75 62 20 30 29 20 34 y-start sub 0) 4
45f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
4600: 3d 20 28 61 72 72 61 79 2d 65 6e 64 20 73 75 62 = (array-end sub
4610: 20 30 29 20 37 29 0a 20 20 20 20 20 20 20 20 20 0) 7).
4620: 20 20 20 20 28 3d 20 28 61 72 72 61 79 2d 72 65 (= (array-re
4630: 66 20 73 75 62 20 34 29 20 31 29 0a 20 20 20 20 f sub 4) 1).
4640: 20 20 20 20 20 20 20 20 20 28 3d 20 28 61 72 72 (= (arr
4650: 61 79 2d 72 65 66 20 73 75 62 20 35 29 20 32 29 ay-ref sub 5) 2)
4660: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3d . (=
4670: 20 28 61 72 72 61 79 2d 72 65 66 20 73 75 62 20 (array-ref sub
4680: 36 29 20 33 29 29 0a 20 20 20 20 20 20 20 20 28 6) 3)). (
4690: 65 72 72 6f 72 20 22 73 68 61 72 69 6e 67 20 77 error "sharing w
46a0: 69 74 68 20 73 68 61 72 69 6e 67 20 73 75 62 73 ith sharing subs
46b0: 68 61 70 65 20 66 61 69 6c 65 64 22 29 29 29 29 hape failed"))))
46c0: 0a 0a 28 70 61 73 74 20 22 73 68 61 72 69 6e 67 ..(past "sharing
46d0: 20 77 69 74 68 20 73 68 61 72 69 6e 67 20 73 75 with sharing su
46e0: 62 73 68 61 70 65 22 29 0a 0a 29 0a 0a 28 63 68 bshape")..)..(ch
46f0: 65 63 6b 2d 72 65 70 6f 72 74 29 0a eck-report).