Artifact
daa3f9105dda54e05bf8ca7805521df8138b081c:
- File
srfi/s25/list.scm
— part of check-in
[80c8c83034]
at
2016-07-07 18:11:39
on branch trunk
— initial import
(user:
ovenpasta@pizzahack.eu
size: 26086)
0000: 3b 3b 3b 20 41 6e 20 69 64 65 6e 74 69 74 79 20 ;;; An identity
0010: 6d 61 74 72 69 78 2e 0a 0a 28 64 65 66 69 6e 65 matrix...(define
0020: 20 69 5f 34 0a 20 20 28 6c 65 74 2a 20 28 28 69 i_4. (let* ((i
0030: 20 28 6d 61 6b 65 2d 61 72 72 61 79 0a 20 20 20 (make-array.
0040: 20 20 20 20 20 20 20 20 20 20 28 73 68 61 70 65 (shape
0050: 20 30 20 34 20 30 20 34 29 0a 20 20 20 20 20 20 0 4 0 4).
0060: 20 20 20 20 20 20 20 30 29 29 0a 20 20 20 20 20 0)).
0070: 20 20 20 20 28 64 20 28 73 68 61 72 65 2d 61 72 (d (share-ar
0080: 72 61 79 20 69 0a 20 20 20 20 20 20 20 20 20 20 ray i.
0090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
00a0: 73 68 61 70 65 20 30 20 34 29 0a 20 20 20 20 20 shape 0 4).
00b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
00c0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 29 0a (lambda (k).
00d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
00e0: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu
00f0: 65 73 20 6b 20 6b 29 29 29 29 29 0a 20 20 20 20 es k k))))).
0100: 28 64 6f 20 20 20 28 28 6b 20 30 20 28 2b 20 6b (do ((k 0 (+ k
0110: 20 31 29 29 29 20 28 28 3d 20 6b 20 34 29 29 0a 1))) ((= k 4)).
0120: 20 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 74 (array-set
0130: 21 20 64 20 6b 20 31 29 29 0a 20 20 20 20 69 29 ! d k 1)). i)
0140: 29 0a 0a 28 70 61 73 74 20 22 69 5f 34 22 29 0a )..(past "i_4").
0150: 0a 28 6f 72 20 28 61 72 72 61 79 2d 65 71 75 61 .(or (array-equa
0160: 6c 3f 20 69 5f 34 0a 20 20 20 20 20 20 20 20 20 l? i_4.
0170: 20 20 20 20 20 20 20 20 20 28 74 61 62 75 6c 61 (tabula
0180: 74 65 2d 61 72 72 61 79 0a 20 20 20 20 20 20 20 te-array.
0190: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 61 (sha
01a0: 70 65 20 30 20 34 20 30 20 34 29 0a 20 20 20 20 pe 0 4 0 4).
01b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
01c0: 6c 61 6d 62 64 61 20 28 6a 20 6b 29 0a 20 20 20 lambda (j k).
01d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
01e0: 20 20 28 69 66 20 28 3d 20 6a 20 6b 29 20 31 20 (if (= j k) 1
01f0: 30 29 29 29 29 0a 20 20 20 20 28 65 72 72 6f 72 0)))). (error
0200: 20 22 66 61 69 6c 65 64 20 74 6f 20 62 75 69 6c "failed to buil
0210: 64 20 69 5f 34 22 29 29 0a 0a 28 70 61 73 74 20 d i_4"))..(past
0220: 22 69 5f 34 20 76 73 20 74 61 62 75 6c 61 74 65 "i_4 vs tabulate
0230: 2d 61 72 72 61 79 22 29 0a 0a 28 6f 72 20 28 61 -array")..(or (a
0240: 72 72 61 79 2d 65 71 75 61 6c 3f 20 69 5f 34 0a rray-equal? i_4.
0250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0260: 20 20 28 61 72 72 61 79 0a 20 20 20 20 20 20 20 (array.
0270: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 61 (sha
0280: 70 65 20 30 20 34 20 30 20 34 29 0a 20 20 20 20 pe 0 4 0 4).
0290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 31 1
02a0: 20 30 20 30 20 30 0a 20 20 20 20 20 20 20 20 20 0 0 0.
02b0: 20 20 20 20 20 20 20 20 20 20 30 20 31 20 30 20 0 1 0
02c0: 30 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0 .
02d0: 20 20 20 20 20 20 30 20 30 20 31 20 30 0a 20 20 0 0 1 0.
02e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
02f0: 20 30 20 30 20 30 20 31 29 29 0a 20 20 20 20 28 0 0 0 1)). (
0300: 65 72 72 6f 72 20 22 66 61 69 6c 65 64 20 74 6f error "failed to
0310: 20 61 72 72 61 79 20 69 5f 34 22 29 29 0a 0a 28 array i_4"))..(
0320: 70 61 73 74 20 22 69 5f 34 20 76 73 20 61 72 72 past "i_4 vs arr
0330: 61 79 22 29 0a 0a 28 6f 72 20 28 61 72 72 61 79 ay")..(or (array
0340: 2d 65 71 75 61 6c 3f 20 28 73 68 61 72 65 2d 61 -equal? (share-a
0350: 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 rray.
0360: 20 20 20 20 20 20 20 20 69 5f 34 0a 20 20 20 20 i_4.
0370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
0380: 73 68 61 70 65 20 30 20 34 29 0a 20 20 20 20 20 shape 0 4).
0390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
03a0: 61 6d 62 64 61 20 28 6b 29 0a 20 20 20 20 20 20 ambda (k).
03b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
03c0: 76 61 6c 75 65 73 20 6b 20 6b 29 29 29 0a 20 20 values k k))).
03d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
03e0: 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 (share-array.
03f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0400: 28 61 72 72 61 79 20 28 73 68 61 70 65 29 20 31 (array (shape) 1
0410: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0420: 20 20 20 20 20 28 73 68 61 70 65 20 30 20 34 29 (shape 0 4)
0430: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0440: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 29 0a (lambda (k).
0450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0460: 20 20 20 20 20 28 76 61 6c 75 65 73 29 29 29 29 (values))))
0470: 0a 20 20 20 20 28 65 72 72 6f 72 20 22 66 61 69 . (error "fai
0480: 6c 65 64 20 74 6f 20 73 68 61 72 65 20 64 69 61 led to share dia
0490: 67 6f 6e 61 6c 20 6f 66 20 69 5f 34 20 6f 72 20 gonal of i_4 or
04a0: 63 65 6c 6c 20 6f 66 20 31 22 29 29 0a 0a 28 70 cell of 1"))..(p
04b0: 61 73 74 20 22 69 5f 34 20 64 69 61 67 6f 6e 61 ast "i_4 diagona
04c0: 6c 22 29 0a 0a 28 6f 72 20 28 61 72 72 61 79 2d l")..(or (array-
04d0: 65 71 75 61 6c 3f 20 28 73 68 61 72 65 2d 61 72 equal? (share-ar
04e0: 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 ray.
04f0: 20 20 20 20 20 20 20 69 5f 34 0a 20 20 20 20 20 i_4.
0500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
0510: 68 61 70 65 20 30 20 34 29 0a 20 20 20 20 20 20 hape 0 4).
0520: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
0530: 6d 62 64 61 20 28 6b 29 0a 20 20 20 20 20 20 20 mbda (k).
0540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
0550: 61 6c 75 65 73 20 28 2d 20 33 20 6b 29 20 6b 29 alues (- 3 k) k)
0560: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0570: 20 20 20 20 20 28 73 68 61 72 65 2d 61 72 72 61 (share-arra
0580: 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y.
0590: 20 20 20 20 20 28 61 72 72 61 79 20 28 73 68 61 (array (sha
05a0: 70 65 29 20 30 29 0a 20 20 20 20 20 20 20 20 20 pe) 0).
05b0: 20 20 20 20 20 20 20 20 20 20 28 73 68 61 70 65 (shape
05c0: 20 30 20 34 29 0a 20 20 20 20 20 20 20 20 20 20 0 4).
05d0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
05e0: 20 28 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 (k).
05f0: 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 (value
0600: 73 29 29 29 29 0a 20 20 20 20 28 65 72 72 6f 72 s)))). (error
0610: 20 22 66 61 69 6c 65 64 20 74 6f 20 73 68 61 72 "failed to shar
0620: 65 20 63 6f 64 69 61 67 6f 6e 61 6c 20 6f 66 20 e codiagonal of
0630: 69 5f 34 20 6f 72 20 63 65 6c 6c 20 6f 66 20 30 i_4 or cell of 0
0640: 22 29 29 0a 0a 28 70 61 73 74 20 22 69 5f 34 20 "))..(past "i_4
0650: 63 6f 64 69 61 67 6f 6e 61 6c 22 29 0a 0a 28 6f codiagonal")..(o
0660: 72 20 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 r (array-equal?
0670: 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 (share-array.
0680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0690: 69 5f 34 0a 20 20 20 20 20 20 20 20 20 20 20 20 i_4.
06a0: 20 20 20 20 20 20 20 28 73 68 61 70 65 20 30 20 (shape 0
06b0: 32 20 30 20 32 29 0a 20 20 20 20 20 20 20 20 20 2 0 2).
06c0: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
06d0: 61 20 28 6a 20 6b 29 0a 20 20 20 20 20 20 20 20 a (j k).
06e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 61 (va
06f0: 6c 75 65 73 20 28 2a 20 33 20 6a 29 20 28 2a 20 lues (* 3 j) (*
0700: 33 20 6b 29 29 29 29 0a 20 20 20 20 20 20 20 20 3 k)))).
0710: 20 20 20 20 20 20 20 20 20 20 28 73 68 61 72 65 (share
0720: 2d 61 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 -array.
0730: 20 20 20 20 20 20 20 20 20 20 69 5f 34 0a 20 20 i_4.
0740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0750: 20 28 73 68 61 70 65 20 30 20 32 20 30 20 32 29 (shape 0 2 0 2)
0760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0770: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6a 20 6b (lambda (j k
0780: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0790: 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 28 (values (
07a0: 2b 20 6a 20 31 29 20 28 2b 20 6b 20 31 29 29 29 + j 1) (+ k 1)))
07b0: 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 66 )). (error "f
07c0: 61 69 6c 65 64 20 74 6f 20 73 68 61 72 65 20 63 ailed to share c
07d0: 6f 72 6e 65 72 73 20 6f 72 20 63 65 6e 74 65 72 orners or center
07e0: 20 6f 66 20 69 5f 34 22 29 29 0a 0a 28 70 61 73 of i_4"))..(pas
07f0: 74 20 22 69 5f 34 20 63 6f 72 6e 65 72 73 20 61 t "i_4 corners a
0800: 6e 64 20 63 65 6e 74 65 72 22 29 0a 0a 28 6f 72 nd center")..(or
0810: 20 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 69 (array-equal? i
0820: 5f 34 20 28 74 72 61 6e 73 70 6f 73 65 20 69 5f _4 (transpose i_
0830: 34 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 4)). (error "
0840: 66 61 69 6c 65 64 20 74 6f 20 74 72 61 6e 73 70 failed to transp
0850: 6f 73 65 20 69 5f 34 22 29 29 0a 0a 28 70 61 73 ose i_4"))..(pas
0860: 74 20 22 69 5f 34 20 74 72 61 6e 73 70 6f 73 65 t "i_4 transpose
0870: 22 29 0a 0a 3b 3b 3b 20 54 72 79 20 61 20 74 68 ")..;;; Try a th
0880: 72 65 65 20 64 69 6d 65 6e 73 69 6f 6e 61 6c 20 ree dimensional
0890: 74 72 61 6e 73 70 6f 73 65 2e 20 54 68 69 73 20 transpose. This
08a0: 77 69 6c 6c 20 61 6c 73 6f 20 65 78 65 72 63 69 will also exerci
08b0: 73 65 20 6d 61 74 72 69 78 0a 3b 3b 3b 20 6d 75 se matrix.;;; mu
08c0: 6c 74 69 70 6c 69 63 61 74 69 6f 6e 2e 0a 0a 28 ltiplication...(
08d0: 64 65 66 69 6e 65 20 74 68 72 65 65 64 31 32 33 define threed123
08e0: 0a 20 20 28 61 72 72 61 79 20 28 73 68 61 70 65 . (array (shape
08f0: 20 30 20 31 20 30 20 32 20 30 20 33 29 0a 20 20 0 1 0 2 0 3).
0900: 20 20 20 20 20 20 20 27 61 20 27 62 20 27 63 0a 'a 'b 'c.
0910: 20 20 20 20 20 20 20 20 20 27 64 20 27 65 20 27 'd 'e '
0920: 66 29 29 0a 0a 28 70 61 73 74 20 22 74 68 72 65 f))..(past "thre
0930: 65 64 31 32 33 22 29 0a 0a 28 64 65 66 69 6e 65 ed123")..(define
0940: 20 74 68 72 65 65 64 33 31 32 0a 20 20 28 61 72 threed312. (ar
0950: 72 61 79 20 28 73 68 61 70 65 20 30 20 33 20 30 ray (shape 0 3 0
0960: 20 31 20 30 20 32 29 0a 20 20 20 20 20 20 20 20 1 0 2).
0970: 20 27 61 20 27 64 0a 20 20 20 20 20 20 20 20 20 'a 'd.
0980: 27 62 20 27 65 0a 20 20 20 20 20 20 20 20 20 27 'b 'e. '
0990: 63 20 27 66 29 29 0a 0a 28 70 61 73 74 20 22 74 c 'f))..(past "t
09a0: 68 72 65 65 64 33 31 32 22 29 0a 0a 28 64 65 66 hreed312")..(def
09b0: 69 6e 65 20 72 6f 74 32 33 31 20 28 6c 69 73 74 ine rot231 (list
09c0: 20 31 20 32 20 30 29 29 0a 20 20 3b 3b 20 30 20 1 2 0)). ;; 0
09d0: 31 20 30 0a 20 20 3b 3b 20 30 20 30 20 31 0a 20 1 0. ;; 0 0 1.
09e0: 20 3b 3b 20 31 20 30 20 30 0a 0a 28 6f 72 20 28 ;; 1 0 0..(or (
09f0: 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 74 68 72 array-equal? thr
0a00: 65 65 64 31 32 33 0a 20 20 20 20 20 20 20 20 20 eed123.
0a10: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
0a20: 74 72 61 6e 73 70 6f 73 65 20 74 68 72 65 65 64 transpose threed
0a30: 33 31 32 20 72 6f 74 32 33 31 29 29 0a 20 20 20 312 rot231)).
0a40: 20 28 65 72 72 6f 72 20 22 66 61 69 6c 65 64 20 (error "failed
0a50: 74 6f 20 74 72 61 6e 73 70 6f 73 65 20 74 68 72 to transpose thr
0a60: 65 65 20 64 69 6d 65 6e 73 69 6f 6e 73 22 29 29 ee dimensions"))
0a70: 0a 0a 28 70 61 73 74 20 22 74 68 72 65 65 64 31 ..(past "threed1
0a80: 32 33 20 74 72 61 6e 73 70 6f 73 65 22 29 0a 0a 23 transpose")..
0a90: 3b 3b 3b 20 54 68 65 20 66 72 69 76 6f 6c 6f 75 ;;; The frivolou
0aa0: 73 20 62 6f 61 72 64 20 67 61 6d 65 20 65 78 65 s board game exe
0ab0: 72 63 69 73 65 73 20 73 68 61 72 65 20 6f 66 20 rcises share of
0ac0: 73 68 61 72 65 20 6f 66 20 73 68 61 72 65 2e 0a share of share..
0ad0: 0a 3b 3b 3b 20 41 20 74 68 72 65 65 20 64 69 6d .;;; A three dim
0ae0: 65 6e 73 69 6f 6e 61 6c 20 63 68 65 73 73 20 62 ensional chess b
0af0: 6f 61 72 64 20 77 69 74 68 20 74 77 6f 20 70 68 oard with two ph
0b00: 61 73 65 73 3a 20 70 69 65 63 65 20 61 6e 64 20 ases: piece and
0b10: 63 6f 6c 6f 75 72 0a 3b 3b 3b 20 6f 66 20 70 69 colour.;;; of pi
0b20: 65 63 65 2e 20 54 68 69 6e 6b 20 6f 66 20 70 69 ece. Think of pi
0b30: 65 63 65 73 20 69 6e 20 61 20 63 75 62 65 20 77 eces in a cube w
0b40: 69 74 68 20 68 65 69 67 68 74 2c 20 77 69 64 74 ith height, widt
0b50: 68 20 61 6e 64 20 64 65 70 74 68 2c 0a 3b 3b 3b h and depth,.;;;
0b60: 20 61 6e 64 20 70 69 65 63 65 20 63 6f 6c 6f 75 and piece colou
0b70: 72 73 20 69 6e 20 61 20 70 61 72 61 6c 6c 65 6c rs in a parallel
0b80: 20 63 75 62 65 2e 20 57 65 20 70 75 74 20 70 69 cube. We put pi
0b90: 6e 6b 20 6a 61 79 73 20 61 72 6f 75 6e 64 20 61 nk jays around a
0ba0: 6e 64 0a 3b 3b 3b 20 67 72 65 79 20 63 72 6f 77 nd.;;; grey crow
0bb0: 73 20 69 6e 73 69 64 65 20 74 68 65 20 62 6f 61 s inside the boa
0bc0: 72 64 20 70 72 6f 70 65 72 2e 20 4c 61 74 65 72 rd proper. Later
0bd0: 20 77 65 20 70 75 74 20 69 6e 20 61 20 62 6c 75 we put in a blu
0be0: 65 20 72 6f 6f 6b 2e 0a 0a 28 64 65 66 69 6e 65 e rook...(define
0bf0: 20 62 6f 61 72 64 0a 20 20 28 74 61 62 75 6c 61 board. (tabula
0c00: 74 65 2d 61 72 72 61 79 0a 20 20 20 28 73 68 61 te-array. (sha
0c10: 70 65 20 2d 31 20 39 20 2d 31 20 39 20 2d 31 20 pe -1 9 -1 9 -1
0c20: 39 20 30 20 32 29 0a 20 20 20 28 6c 61 6d 62 64 9 0 2). (lambd
0c30: 61 20 28 74 20 75 20 76 20 77 29 0a 20 20 20 20 a (t u v w).
0c40: 20 28 63 61 73 65 20 77 0a 20 20 20 20 20 20 20 (case w.
0c50: 28 28 30 29 20 28 69 66 20 28 61 6e 64 20 28 3c ((0) (if (and (<
0c60: 20 2d 31 20 75 20 38 29 0a 20 20 20 20 20 20 20 -1 u 8).
0c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3c (<
0c80: 20 2d 31 20 76 20 38 29 0a 20 20 20 20 20 20 20 -1 v 8).
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3c (<
0ca0: 20 2d 31 20 74 20 38 29 29 0a 20 20 20 20 20 20 -1 t 8)).
0cb0: 20 20 20 20 20 20 20 20 20 20 27 63 72 6f 77 0a 'crow.
0cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cd0: 27 6a 61 79 29 29 0a 20 20 20 20 20 20 20 28 28 'jay)). ((
0ce0: 31 29 20 28 69 66 20 28 61 6e 64 20 28 3c 20 2d 1) (if (and (< -
0cf0: 31 20 75 20 38 29 0a 20 20 20 20 20 20 20 20 20 1 u 8).
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 28 3c 20 2d (< -
0d10: 31 20 76 20 38 29 0a 20 20 20 20 20 20 20 20 20 1 v 8).
0d20: 20 20 20 20 20 20 20 20 20 20 20 20 28 3c 20 2d (< -
0d30: 31 20 74 20 38 29 29 0a 20 20 20 20 20 20 20 20 1 t 8)).
0d40: 20 20 20 20 20 20 20 20 27 67 72 65 79 0a 20 20 'grey.
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 70 'p
0d60: 69 6e 6b 29 29 29 29 29 29 0a 0a 28 70 61 73 74 ink))))))..(past
0d70: 20 22 62 6f 61 72 64 22 29 0a 0a 3b 3b 3b 20 41 "board")..;;; A
0d80: 20 63 79 6c 69 6e 64 65 72 20 77 69 74 68 20 68 cylinder with h
0d90: 65 69 67 68 74 20 34 2c 20 77 69 64 74 68 20 34 eight 4, width 4
0da0: 2c 20 64 65 70 74 68 20 36 2c 20 62 6f 74 68 20 , depth 6, both
0db0: 70 68 61 73 65 73 2c 20 63 65 6e 74 65 72 65 64 phases, centered
0dc0: 0a 3b 3b 3b 20 69 6e 73 69 64 65 20 74 68 65 20 .;;; inside the
0dd0: 62 6f 61 72 64 2e 20 54 6f 70 20 6c 65 66 74 20 board. Top left
0de0: 66 72 6f 6e 74 20 63 6f 72 6e 65 72 20 69 73 20 front corner is
0df0: 61 74 20 30 20 30 20 30 20 6f 66 20 63 79 6c 69 at 0 0 0 of cyli
0e00: 6e 64 65 72 20 62 75 74 0a 3b 3b 3b 20 32 20 32 nder but.;;; 2 2
0e10: 20 31 20 6f 66 20 62 6f 61 72 64 2e 0a 0a 28 64 1 of board...(d
0e20: 65 66 69 6e 65 20 62 6f 61 72 64 2d 63 79 6c 69 efine board-cyli
0e30: 6e 64 65 72 0a 20 20 28 73 68 61 72 65 2d 61 72 nder. (share-ar
0e40: 72 61 79 0a 20 20 20 62 6f 61 72 64 0a 20 20 20 ray. board.
0e50: 28 73 68 61 70 65 20 30 20 34 20 30 20 34 20 30 (shape 0 4 0 4 0
0e60: 20 36 20 30 20 32 29 0a 20 20 20 28 6c 61 6d 62 6 0 2). (lamb
0e70: 64 61 20 28 74 20 75 20 76 20 77 29 0a 20 20 20 da (t u v w).
0e80: 20 20 28 76 61 6c 75 65 73 20 28 2b 20 74 20 32 (values (+ t 2
0e90: 29 20 28 2b 20 75 20 32 29 20 28 2b 20 76 20 31 ) (+ u 2) (+ v 1
0ea0: 29 20 77 29 29 29 29 0a 0a 28 70 61 73 74 20 22 ) w))))..(past "
0eb0: 62 6f 61 72 64 2d 63 79 6c 69 6e 64 65 72 22 29 board-cylinder")
0ec0: 0a 0a 3b 3b 3b 20 54 68 65 20 63 65 6e 74 65 72 ..;;; The center
0ed0: 20 63 75 62 65 20 77 69 74 68 20 73 69 64 65 20 cube with side
0ee0: 32 20 6f 66 20 74 68 65 20 63 79 6c 69 6e 64 65 2 of the cylinde
0ef0: 72 2c 20 68 65 6e 63 65 20 6f 66 20 74 68 65 20 r, hence of the
0f00: 62 6f 61 72 64 2c 0a 3b 3b 3b 20 77 69 74 68 20 board,.;;; with
0f10: 62 6f 74 68 20 70 68 61 73 65 73 2e 20 54 6f 70 both phases. Top
0f20: 20 6c 65 66 74 20 63 6f 72 6e 65 72 20 69 73 20 left corner is
0f30: 30 20 30 20 30 20 6f 66 20 63 65 6e 74 65 72 20 0 0 0 of center
0f40: 62 75 74 20 31 20 31 20 32 0a 3b 3b 3b 20 6f 66 but 1 1 2.;;; of
0f50: 20 63 79 6c 69 6e 64 65 72 20 61 6e 64 20 33 20 cylinder and 3
0f60: 33 20 33 20 6f 66 20 62 6f 61 72 64 2e 0a 0a 28 3 3 of board...(
0f70: 64 65 66 69 6e 65 20 62 6f 61 72 64 2d 63 65 6e define board-cen
0f80: 74 65 72 0a 20 20 28 73 68 61 72 65 2d 61 72 72 ter. (share-arr
0f90: 61 79 0a 20 20 20 62 6f 61 72 64 2d 63 79 6c 69 ay. board-cyli
0fa0: 6e 64 65 72 0a 20 20 20 28 73 68 61 70 65 20 30 nder. (shape 0
0fb0: 20 32 20 30 20 32 20 30 20 32 20 30 20 32 29 0a 2 0 2 0 2 0 2).
0fc0: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 20 75 20 (lambda (t u
0fd0: 76 20 77 29 0a 20 20 20 20 20 28 76 61 6c 75 65 v w). (value
0fe0: 73 20 28 2b 20 74 20 31 29 20 28 2b 20 75 20 31 s (+ t 1) (+ u 1
0ff0: 29 20 28 2b 20 76 20 32 29 20 77 29 29 29 29 0a ) (+ v 2) w)))).
1000: 0a 28 70 61 73 74 20 22 62 6f 61 72 64 2d 63 65 .(past "board-ce
1010: 6e 74 65 72 22 29 0a 0a 3b 3b 3b 20 46 72 6f 6e nter")..;;; Fron
1020: 74 20 66 61 63 65 20 6f 66 20 63 65 6e 74 65 72 t face of center
1030: 20 63 75 62 65 2c 20 69 6e 20 74 77 6f 20 64 69 cube, in two di
1040: 6d 65 6e 73 69 6f 6e 73 20 70 6c 75 73 20 70 68 mensions plus ph
1050: 61 73 65 2e 20 54 6f 70 20 6c 65 66 74 0a 3b 3b ase. Top left.;;
1060: 3b 20 63 6f 72 6e 65 72 20 69 73 20 30 20 30 20 ; corner is 0 0
1070: 6f 66 20 66 61 63 65 20 62 75 74 20 30 20 30 20 of face but 0 0
1080: 30 20 6f 66 20 63 65 6e 74 65 72 20 61 6e 64 20 0 of center and
1090: 31 20 31 20 32 20 6f 66 20 63 79 6c 69 6e 64 65 1 1 2 of cylinde
10a0: 72 0a 3b 3b 3b 20 33 20 33 20 33 20 6f 66 20 62 r.;;; 3 3 3 of b
10b0: 6f 61 72 64 2e 0a 0a 28 64 65 66 69 6e 65 20 62 oard...(define b
10c0: 6f 61 72 64 2d 66 61 63 65 0a 20 20 28 73 68 61 oard-face. (sha
10d0: 72 65 2d 61 72 72 61 79 0a 20 20 20 62 6f 61 72 re-array. boar
10e0: 64 2d 63 65 6e 74 65 72 0a 20 20 20 28 73 68 61 d-center. (sha
10f0: 70 65 20 30 20 32 20 30 20 32 20 30 20 32 29 0a pe 0 2 0 2 0 2).
1100: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 20 75 20 (lambda (t u
1110: 77 29 0a 20 20 20 20 20 28 76 61 6c 75 65 73 20 w). (values
1120: 74 20 75 20 30 20 77 29 29 29 29 0a 0a 28 70 61 t u 0 w))))..(pa
1130: 73 74 20 22 62 6f 61 72 64 2d 66 61 63 65 22 29 st "board-face")
1140: 0a 0a 3b 3b 3b 20 4c 65 66 74 20 73 69 64 65 20 ..;;; Left side
1150: 6f 66 20 66 61 63 65 20 69 6e 20 74 68 72 65 65 of face in three
1160: 20 64 69 6d 65 6e 73 69 6f 6e 73 20 70 6c 75 73 dimensions plus
1170: 20 70 68 61 73 65 2e 20 54 6f 70 20 69 73 20 30 phase. Top is 0
1180: 20 30 20 30 20 6f 66 0a 3b 3b 3b 20 70 69 6c 6c 0 0 of.;;; pill
1190: 61 72 20 62 75 74 20 30 20 30 20 6f 66 20 66 61 ar but 0 0 of fa
11a0: 63 65 20 61 6e 64 20 30 20 30 20 30 20 6f 66 20 ce and 0 0 0 of
11b0: 63 65 6e 74 65 72 20 61 6e 64 20 31 20 31 20 32 center and 1 1 2
11c0: 20 6f 66 20 63 79 6c 69 6e 64 65 72 0a 3b 3b 3b of cylinder.;;;
11d0: 20 61 6e 64 20 33 20 33 20 33 20 6f 66 20 62 6f and 3 3 3 of bo
11e0: 61 72 64 2e 20 42 6f 74 74 6f 6d 20 69 73 20 31 ard. Bottom is 1
11f0: 20 30 20 30 20 6f 66 20 70 69 6c 6c 61 72 20 62 0 0 of pillar b
1200: 75 74 20 31 20 30 20 6f 66 20 66 61 63 65 20 61 ut 1 0 of face a
1210: 6e 64 0a 3b 3b 3b 20 31 20 30 20 30 20 6f 66 20 nd.;;; 1 0 0 of
1220: 63 65 6e 74 65 72 20 61 6e 64 20 32 20 31 20 32 center and 2 1 2
1230: 20 6f 66 20 63 79 6c 69 6e 64 65 72 20 61 6e 64 of cylinder and
1240: 20 34 20 33 20 33 20 6f 66 20 62 6f 61 72 64 2e 4 3 3 of board.
1250: 0a 0a 28 64 65 66 69 6e 65 20 62 6f 61 72 64 2d ..(define board-
1260: 70 69 6c 6c 61 72 0a 20 20 28 73 68 61 72 65 2d pillar. (share-
1270: 61 72 72 61 79 0a 20 20 20 62 6f 61 72 64 2d 66 array. board-f
1280: 61 63 65 0a 20 20 20 28 73 68 61 70 65 20 30 20 ace. (shape 0
1290: 32 20 30 20 31 20 30 20 31 20 30 20 32 29 0a 20 2 0 1 0 1 0 2).
12a0: 20 20 28 6c 61 6d 62 64 61 20 28 74 20 75 20 76 (lambda (t u v
12b0: 20 77 29 0a 20 20 20 20 20 28 76 61 6c 75 65 73 w). (values
12c0: 20 74 20 30 20 77 29 29 29 29 0a 0a 28 70 61 73 t 0 w))))..(pas
12d0: 74 20 22 62 6f 61 72 64 2d 70 69 6c 6c 61 72 22 t "board-pillar"
12e0: 29 0a 0a 3b 3b 3b 20 50 69 6c 6c 61 72 20 75 70 )..;;; Pillar up
12f0: 73 69 64 65 20 64 6f 77 6e 2e 20 4e 6f 77 20 74 side down. Now t
1300: 6f 70 20 30 20 30 20 30 20 69 73 20 31 20 30 20 op 0 0 0 is 1 0
1310: 6f 66 20 66 61 63 65 20 61 6e 64 20 31 20 30 20 of face and 1 0
1320: 30 20 6f 66 20 63 65 6e 74 65 72 0a 3b 3b 3b 20 0 of center.;;;
1330: 61 6e 64 20 32 20 31 20 32 20 6f 66 20 63 79 6c and 2 1 2 of cyl
1340: 69 6e 64 65 72 20 61 6e 64 20 34 20 33 20 33 20 inder and 4 3 3
1350: 6f 66 20 62 6f 61 72 64 2e 0a 0a 28 64 65 66 69 of board...(defi
1360: 6e 65 20 62 6f 61 72 64 2d 72 65 76 65 72 73 65 ne board-reverse
1370: 2d 70 69 6c 6c 61 72 0a 20 20 28 73 68 61 72 65 -pillar. (share
1380: 2d 61 72 72 61 79 0a 20 20 20 62 6f 61 72 64 2d -array. board-
1390: 70 69 6c 6c 61 72 0a 20 20 20 28 73 68 61 70 65 pillar. (shape
13a0: 20 30 20 32 20 30 20 31 20 30 20 31 20 30 20 32 0 2 0 1 0 1 0 2
13b0: 29 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 74 20 ). (lambda (t
13c0: 75 20 76 20 77 29 0a 20 20 20 20 20 28 76 61 6c u v w). (val
13d0: 75 65 73 20 28 2d 20 31 20 74 29 20 75 20 76 20 ues (- 1 t) u v
13e0: 77 29 29 29 29 0a 0a 28 70 61 73 74 20 22 62 6f w))))..(past "bo
13f0: 61 72 64 2d 72 65 76 65 72 73 65 2d 70 69 6c 6c ard-reverse-pill
1400: 61 72 22 29 0a 0a 3b 3b 3b 20 42 6f 74 74 6f 6d ar")..;;; Bottom
1410: 20 6f 66 20 70 69 6c 6c 61 72 2e 0a 0a 28 64 65 of pillar...(de
1420: 66 69 6e 65 20 62 6f 61 72 64 2d 63 75 62 69 63 fine board-cubic
1430: 6c 65 0a 20 20 28 73 68 61 72 65 2d 61 72 72 61 le. (share-arra
1440: 79 0a 20 20 20 62 6f 61 72 64 2d 70 69 6c 6c 61 y. board-pilla
1450: 72 0a 20 20 20 28 73 68 61 70 65 20 30 20 32 29 r. (shape 0 2)
1460: 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 77 29 0a . (lambda (w).
1470: 20 20 20 20 20 28 76 61 6c 75 65 73 20 31 20 30 (values 1 0
1480: 20 30 20 77 29 29 29 29 0a 0a 28 70 61 73 74 20 0 w))))..(past
1490: 22 62 6f 61 72 64 2d 63 75 62 69 63 6c 65 22 29 "board-cubicle")
14a0: 0a 0a 3b 3b 3b 20 54 6f 70 20 6f 66 20 75 70 73 ..;;; Top of ups
14b0: 69 64 65 20 64 6f 77 6e 20 70 61 69 72 2e 0a 0a ide down pair...
14c0: 28 64 65 66 69 6e 65 20 62 6f 61 72 64 2d 72 65 (define board-re
14d0: 76 65 72 73 65 2d 63 75 62 69 63 6c 65 0a 20 20 verse-cubicle.
14e0: 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 (share-array.
14f0: 62 6f 61 72 64 2d 72 65 76 65 72 73 65 2d 70 69 board-reverse-pi
1500: 6c 6c 61 72 0a 20 20 20 28 73 68 61 70 65 20 30 llar. (shape 0
1510: 20 32 29 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 2). (lambda (
1520: 77 29 0a 20 20 20 20 20 28 76 61 6c 75 65 73 20 w). (values
1530: 30 20 30 20 30 20 77 29 29 29 29 0a 0a 28 70 61 0 0 0 w))))..(pa
1540: 73 74 20 22 62 6f 61 72 64 2d 72 65 76 65 72 73 st "board-revers
1550: 65 2d 63 75 62 69 63 6c 65 22 29 0a 0a 3b 3b 3b e-cubicle")..;;;
1560: 20 50 69 65 63 65 20 70 68 61 73 65 20 6f 66 20 Piece phase of
1570: 63 75 62 69 63 6c 65 2e 0a 0a 28 64 65 66 69 6e cubicle...(defin
1580: 65 20 62 6f 61 72 64 2d 70 69 65 63 65 0a 20 20 e board-piece.
1590: 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 (share-array.
15a0: 62 6f 61 72 64 2d 63 75 62 69 63 6c 65 0a 20 20 board-cubicle.
15b0: 20 28 73 68 61 70 65 29 0a 20 20 20 28 6c 61 6d (shape). (lam
15c0: 62 64 61 20 28 29 0a 20 20 20 20 20 28 76 61 6c bda (). (val
15d0: 75 65 73 20 30 29 29 29 29 0a 0a 28 70 61 73 74 ues 0))))..(past
15e0: 20 22 62 6f 61 72 64 2d 70 69 65 63 65 22 29 0a "board-piece").
15f0: 0a 3b 3b 3b 20 43 6f 6c 6f 75 72 20 70 68 61 73 .;;; Colour phas
1600: 65 20 6f 66 20 74 68 65 20 6f 74 68 65 72 20 63 e of the other c
1610: 75 62 69 63 6c 65 20 74 68 61 74 20 69 73 20 61 ubicle that is a
1620: 63 74 75 61 6c 6c 79 20 74 68 65 20 73 61 6d 65 ctually the same
1630: 20 63 75 62 69 63 6c 65 2e 0a 0a 28 64 65 66 69 cubicle...(defi
1640: 6e 65 20 62 6f 61 72 64 2d 63 6f 6c 6f 75 72 0a ne board-colour.
1650: 20 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 (share-array.
1660: 20 20 62 6f 61 72 64 2d 72 65 76 65 72 73 65 2d board-reverse-
1670: 63 75 62 69 63 6c 65 0a 20 20 20 28 73 68 61 70 cubicle. (shap
1680: 65 29 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 29 e). (lambda ()
1690: 0a 20 20 20 20 20 28 76 61 6c 75 65 73 20 31 29 . (values 1)
16a0: 29 29 29 0a 0a 28 70 61 73 74 20 22 62 6f 61 72 )))..(past "boar
16b0: 64 2d 63 6f 6c 6f 75 72 22 29 0a 0a 3b 3b 3b 20 d-colour")..;;;
16c0: 50 75 74 20 61 20 62 6c 75 65 20 72 6f 6f 6b 20 Put a blue rook
16d0: 61 74 20 74 68 65 20 62 6f 74 74 6f 6d 20 6f 66 at the bottom of
16e0: 20 74 68 65 20 70 69 6c 6c 61 72 20 61 6e 64 20 the pillar and
16f0: 61 74 20 74 68 65 20 74 6f 70 20 6f 66 20 74 68 at the top of th
1700: 65 0a 3b 3b 3b 20 75 70 73 69 64 65 20 70 69 6c e.;;; upside pil
1710: 6c 61 72 2e 0a 0a 28 61 72 72 61 79 2d 73 65 74 lar...(array-set
1720: 21 20 62 6f 61 72 64 2d 70 69 65 63 65 20 27 72 ! board-piece 'r
1730: 6f 6f 6b 29 0a 28 61 72 72 61 79 2d 73 65 74 21 ook).(array-set!
1740: 20 62 6f 61 72 64 2d 63 6f 6c 6f 75 72 20 27 62 board-colour 'b
1750: 6c 75 65 29 0a 0a 28 70 61 73 74 20 22 61 72 72 lue)..(past "arr
1760: 61 79 2d 73 65 74 21 20 74 6f 20 62 6f 61 72 64 ay-set! to board
1770: 2d 70 69 65 63 65 20 61 6e 64 20 62 6f 61 72 64 -piece and board
1780: 2d 63 6f 6c 6f 75 72 22 29 0a 0a 3b 3b 3b 20 42 -colour")..;;; B
1790: 75 69 6c 64 20 74 68 65 20 73 61 6d 65 20 63 68 uild the same ch
17a0: 65 73 73 20 70 6f 73 69 74 69 6f 6e 20 64 69 72 ess position dir
17b0: 65 63 74 6c 79 2e 0a 0a 28 64 65 66 69 6e 65 20 ectly...(define
17c0: 62 6f 61 72 64 2d 74 77 6f 0a 20 20 28 74 61 62 board-two. (tab
17d0: 75 6c 61 74 65 2d 61 72 72 61 79 0a 20 20 20 28 ulate-array. (
17e0: 73 68 61 70 65 20 2d 31 20 39 20 2d 31 20 39 20 shape -1 9 -1 9
17f0: 2d 31 20 39 20 30 20 32 29 0a 20 20 20 28 6c 61 -1 9 0 2). (la
1800: 6d 62 64 61 20 28 74 20 75 20 76 20 77 29 0a 20 mbda (t u v w).
1810: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 3d 20 (if (and (=
1820: 74 20 34 29 20 28 3d 20 75 20 33 29 20 28 3d 20 t 4) (= u 3) (=
1830: 76 20 33 29 29 0a 20 20 20 20 20 20 20 20 20 28 v 3)). (
1840: 63 61 73 65 20 77 0a 20 20 20 20 20 20 20 20 20 case w.
1850: 20 20 28 28 30 29 20 27 72 6f 6f 6b 29 0a 20 20 ((0) 'rook).
1860: 20 20 20 20 20 20 20 20 20 28 28 31 29 20 27 62 ((1) 'b
1870: 6c 75 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 lue)). (
1880: 63 61 73 65 20 77 0a 20 20 20 20 20 20 20 20 20 case w.
1890: 20 20 28 28 30 29 20 28 69 66 20 28 61 6e 64 20 ((0) (if (and
18a0: 28 3c 20 2d 31 20 75 20 38 29 0a 20 20 20 20 20 (< -1 u 8).
18b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18c0: 20 20 20 20 28 3c 20 2d 31 20 76 20 38 29 0a 20 (< -1 v 8).
18d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18e0: 20 20 20 20 20 20 20 20 28 3c 20 2d 31 20 74 20 (< -1 t
18f0: 38 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 8)).
1900: 20 20 20 20 20 20 20 20 27 63 72 6f 77 0a 20 20 'crow.
1910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1920: 20 20 27 6a 61 79 29 29 0a 20 20 20 20 20 20 20 'jay)).
1930: 20 20 20 20 28 28 31 29 20 28 69 66 20 28 61 6e ((1) (if (an
1940: 64 20 28 3c 20 2d 31 20 75 20 38 29 0a 20 20 20 d (< -1 u 8).
1950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1960: 20 20 20 20 20 20 28 3c 20 2d 31 20 76 20 38 29 (< -1 v 8)
1970: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1980: 20 20 20 20 20 20 20 20 20 20 28 3c 20 2d 31 20 (< -1
1990: 74 20 38 29 29 0a 20 20 20 20 20 20 20 20 20 20 t 8)).
19a0: 20 20 20 20 20 20 20 20 20 20 27 67 72 65 79 0a 'grey.
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c0: 20 20 20 20 27 70 69 6e 6b 29 29 29 29 29 29 29 'pink)))))))
19d0: 0a 0a 28 70 61 73 74 20 22 62 6f 61 72 64 2d 74 ..(past "board-t
19e0: 77 6f 22 29 0a 0a 28 6f 72 20 28 61 72 72 61 79 wo")..(or (array
19f0: 2d 65 71 75 61 6c 3f 20 62 6f 61 72 64 20 62 6f -equal? board bo
1a00: 61 72 64 2d 74 77 6f 29 0a 20 20 20 20 28 65 72 ard-two). (er
1a10: 72 6f 72 20 22 66 61 69 6c 65 64 20 69 6e 20 74 ror "failed in t
1a20: 68 72 65 65 20 64 69 6d 65 6e 73 69 6f 6e 61 6c hree dimensional
1a30: 20 63 68 65 73 73 22 29 29 0a 0a 28 70 61 73 74 chess"))..(past
1a40: 20 22 62 6f 61 72 64 20 76 73 20 62 6f 61 72 64 "board vs board
1a50: 2d 74 77 6f 22 29 0a 0a 3b 3b 3b 20 50 65 72 6d -two")..;;; Perm
1a60: 75 74 65 20 74 68 65 20 64 69 6d 65 6e 73 69 6f ute the dimensio
1a70: 6e 73 20 6f 66 20 74 68 65 20 63 68 65 73 73 20 ns of the chess
1a80: 62 6f 61 72 64 20 69 6e 20 74 77 6f 20 64 69 66 board in two dif
1a90: 66 65 72 65 6e 74 20 77 61 79 73 2e 0a 3b 3b 3b ferent ways..;;;
1aa0: 20 54 68 65 20 74 72 61 6e 73 70 6f 73 65 20 61 The transpose a
1ab0: 6c 73 6f 20 65 78 65 72 63 69 73 65 73 20 6d 61 lso exercises ma
1ac0: 74 72 69 78 20 6d 75 6c 74 69 70 6c 69 63 61 74 trix multiplicat
1ad0: 69 6f 6e 2e 0a 0a 28 64 65 66 69 6e 65 20 62 6f ion...(define bo
1ae0: 61 72 64 2d 74 68 72 65 65 0a 20 20 28 73 68 61 ard-three. (sha
1af0: 72 65 2d 61 72 72 61 79 0a 20 20 20 62 6f 61 72 re-array. boar
1b00: 64 2d 74 77 6f 0a 20 20 20 28 73 68 61 70 65 20 d-two. (shape
1b10: 30 20 32 20 2d 31 20 39 20 2d 31 20 39 20 2d 31 0 2 -1 9 -1 9 -1
1b20: 20 39 29 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 9). (lambda (
1b30: 77 20 74 20 75 20 76 29 0a 20 20 20 20 20 28 76 w t u v). (v
1b40: 61 6c 75 65 73 20 74 20 75 20 76 20 77 29 29 29 alues t u v w)))
1b50: 29 0a 0a 28 70 61 73 74 20 22 62 6f 61 72 64 2d )..(past "board-
1b60: 74 68 72 65 65 22 29 0a 0a 28 6f 72 20 28 61 72 three")..(or (ar
1b70: 72 61 79 2d 65 71 75 61 6c 3f 20 62 6f 61 72 64 ray-equal? board
1b80: 2d 74 68 72 65 65 0a 20 20 20 20 20 20 20 20 20 -three.
1b90: 20 20 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 (transp
1ba0: 6f 73 65 20 62 6f 61 72 64 2d 74 77 6f 20 33 20 ose board-two 3
1bb0: 30 20 31 20 32 29 29 0a 20 20 20 20 20 20 20 20 0 1 2)).
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bd0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 30 ;; 0
1be0: 20 30 20 30 20 31 0a 20 20 20 20 20 20 20 20 20 0 0 1.
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c00: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 31 20 ;; 1
1c10: 30 20 30 20 30 0a 20 20 20 20 20 20 20 20 20 20 0 0 0.
1c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c30: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 30 20 31 ;; 0 1
1c40: 20 30 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 0 0.
1c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c60: 20 20 20 20 20 20 20 20 20 3b 3b 20 30 20 30 20 ;; 0 0
1c70: 31 20 30 0a 20 20 20 20 28 65 72 72 6f 72 20 22 1 0. (error "
1c80: 66 61 69 6c 65 64 20 74 6f 20 70 65 72 6d 75 74 failed to permut
1c90: 65 20 63 68 65 73 73 20 62 6f 61 72 64 20 64 69 e chess board di
1ca0: 6d 65 6e 73 69 6f 6e 73 22 29 29 0a 0a 28 70 61 mensions"))..(pa
1cb0: 73 74 20 22 62 6f 61 72 64 2d 74 68 72 65 65 20 st "board-three
1cc0: 76 73 20 74 72 61 6e 73 70 6f 73 65 20 6f 66 20 vs transpose of
1cd0: 62 6f 61 72 64 2d 74 77 6f 22 29 0a 0a 28 6f 72 board-two")..(or
1ce0: 20 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 28 (array-equal? (
1cf0: 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 share-array.
1d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 62 b
1d10: 6f 61 72 64 2d 74 77 6f 0a 20 20 20 20 20 20 20 oard-two.
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 68 61 (sha
1d30: 70 65 20 2d 31 20 39 20 30 20 32 20 2d 31 20 39 pe -1 9 0 2 -1 9
1d40: 20 2d 31 20 39 29 0a 20 20 20 20 20 20 20 20 20 -1 9).
1d50: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
1d60: 61 20 28 74 20 77 20 75 20 76 29 0a 20 20 20 20 a (t w u v).
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d80: 20 28 76 61 6c 75 65 73 20 74 20 75 20 76 20 77 (values t u v w
1d90: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
1da0: 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 73 65 (transpose
1db0: 20 62 6f 61 72 64 2d 74 77 6f 20 30 20 33 20 31 board-two 0 3 1
1dc0: 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 2)).
1dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1de0: 20 20 20 20 20 20 20 20 20 3b 3b 20 31 20 30 20 ;; 1 0
1df0: 30 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 0 0.
1e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e10: 20 20 20 20 20 20 20 20 3b 3b 20 30 20 30 20 30 ;; 0 0 0
1e20: 20 31 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1.
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e40: 20 20 20 20 20 20 20 3b 3b 20 30 20 31 20 30 20 ;; 0 1 0
1e50: 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e70: 20 20 20 20 20 20 3b 3b 20 30 20 30 20 31 20 30 ;; 0 0 1 0
1e80: 0a 20 20 20 20 28 65 72 72 6f 72 20 22 66 61 69 . (error "fai
1e90: 6c 65 64 20 74 6f 20 70 65 72 6d 75 74 65 20 63 led to permute c
1ea0: 68 65 73 73 20 62 6f 61 72 64 20 64 69 6d 65 6e hess board dimen
1eb0: 73 69 6f 6e 73 20 61 6e 6f 74 68 65 72 20 77 61 sions another wa
1ec0: 79 22 29 29 0a 0a 28 70 61 73 74 20 22 62 6f 61 y"))..(past "boa
1ed0: 72 64 2d 74 77 6f 20 76 65 72 73 75 73 20 74 72 rd-two versus tr
1ee0: 61 6e 73 70 6f 73 65 20 6f 66 20 62 6f 61 72 64 anspose of board
1ef0: 2d 74 77 6f 22 29 0a 0a 3b 3b 3b 20 4a 75 73 74 -two")..;;; Just
1f00: 20 73 65 65 20 74 68 61 74 20 65 6d 70 74 79 20 see that empty
1f10: 73 68 61 72 65 20 64 6f 65 73 20 6e 6f 74 20 63 share does not c
1f20: 72 61 73 68 2e 20 4e 6f 20 69 6e 64 65 78 20 69 rash. No index i
1f30: 73 20 76 61 6c 69 64 2e 20 4a 75 73 74 20 62 79 s valid. Just by
1f40: 0a 3b 3b 3b 20 74 68 65 20 77 61 79 2e 20 54 68 .;;; the way. Th
1f50: 65 72 65 20 69 73 20 6e 6f 74 68 69 6e 67 20 74 ere is nothing t
1f60: 6f 20 62 65 20 64 6f 6e 65 20 77 69 74 68 20 69 o be done with i
1f70: 74 2e 0a 0a 28 64 65 66 69 6e 65 20 62 6f 61 72 t...(define boar
1f80: 64 2d 6e 6f 74 68 69 6e 67 0a 20 20 28 73 68 61 d-nothing. (sha
1f90: 72 65 2d 61 72 72 61 79 0a 20 20 20 62 6f 61 72 re-array. boar
1fa0: 64 0a 20 20 20 28 73 68 61 70 65 20 30 20 33 20 d. (shape 0 3
1fb0: 31 20 31 20 30 20 33 29 0a 20 20 20 28 6c 61 6d 1 1 0 3). (lam
1fc0: 62 64 61 20 28 74 20 75 20 76 29 0a 20 20 20 20 bda (t u v).
1fd0: 20 28 76 61 6c 75 65 73 20 30 20 30 20 30 29 29 (values 0 0 0))
1fe0: 29 29 0a 0a 28 6f 72 20 28 61 72 72 61 79 2d 65 ))..(or (array-e
1ff0: 71 75 61 6c 3f 20 62 6f 61 72 64 2d 6e 6f 74 68 qual? board-noth
2000: 69 6e 67 20 28 61 72 72 61 79 20 28 61 72 72 61 ing (array (arra
2010: 79 2d 73 68 61 70 65 20 62 6f 61 72 64 2d 6e 6f y-shape board-no
2020: 74 68 69 6e 67 29 29 29 0a 20 20 20 20 28 65 72 thing))). (er
2030: 72 6f 72 20 22 62 6f 61 72 64 2d 6e 6f 74 68 69 ror "board-nothi
2040: 6e 67 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 ng failed"))..(p
2050: 61 73 74 20 22 62 6f 61 72 64 2d 6e 6f 74 68 69 ast "board-nothi
2060: 6e 67 22 29 0a 0a 3b 3b 3b 20 2d 2d 2d 0a 0a 28 ng")..;;; ---..(
2070: 6f 72 20 28 61 72 72 61 79 2d 65 71 75 61 6c 3f or (array-equal?
2080: 20 28 74 61 62 75 6c 61 74 65 2d 61 72 72 61 79 (tabulate-array
2090: 20 28 73 68 61 70 65 20 34 20 38 20 32 20 35 20 (shape 4 8 2 5
20a0: 30 20 31 29 20 2a 29 0a 20 20 20 20 20 20 20 20 0 1) *).
20b0: 20 20 20 20 20 20 20 20 20 20 28 74 61 62 75 6c (tabul
20c0: 61 74 65 2d 61 72 72 61 79 21 20 28 73 68 61 70 ate-array! (shap
20d0: 65 20 34 20 38 20 32 20 35 20 30 20 31 29 0a 20 e 4 8 2 5 0 1).
20e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2100: 20 20 28 6c 61 6d 62 64 61 20 28 76 29 0a 20 20 (lambda (v).
2110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2130: 20 20 20 28 2a 20 28 76 65 63 74 6f 72 2d 72 65 (* (vector-re
2140: 66 20 76 20 30 29 0a 20 20 20 20 20 20 20 20 20 f v 0).
2150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2170: 76 65 63 74 6f 72 2d 72 65 66 20 76 20 31 29 0a vector-ref v 1).
2180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21a0: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
21b0: 72 65 66 20 76 20 32 29 29 29 0a 20 20 20 20 20 ref v 2))).
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
21e0: 65 63 74 6f 72 20 2a 20 2a 20 2a 29 29 29 0a 20 ector * * *))).
21f0: 20 20 20 28 65 72 72 6f 72 20 22 74 61 62 75 6c (error "tabul
2200: 61 74 65 2d 61 72 72 61 79 21 20 77 69 74 68 20 ate-array! with
2210: 76 65 63 74 6f 72 20 66 61 69 6c 65 64 22 29 29 vector failed"))
2220: 0a 0a 28 70 61 73 74 20 22 74 61 62 75 6c 61 74 ..(past "tabulat
2230: 65 2d 61 72 72 61 79 21 20 77 69 74 68 20 76 65 e-array! with ve
2240: 63 74 6f 72 22 29 0a 0a 28 6f 72 20 28 61 72 72 ctor")..(or (arr
2250: 61 79 2d 65 71 75 61 6c 3f 20 28 74 61 62 75 6c ay-equal? (tabul
2260: 61 74 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 ate-array (shape
2270: 20 34 20 38 20 32 20 35 20 30 20 31 29 20 2a 29 4 8 2 5 0 1) *)
2280: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2290: 20 20 20 28 6c 65 74 20 28 28 69 6e 64 65 78 20 (let ((index
22a0: 28 73 68 61 72 65 2d 61 72 72 61 79 20 28 6d 61 (share-array (ma
22b0: 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 ke-array (shape
22c0: 30 20 32 20 30 20 33 29 29 0a 20 20 20 20 20 20 0 2 0 3)).
22d0: 20 20 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 20 20 20
22f0: 20 20 20 20 20 20 28 73 68 61 70 65 20 30 20 33 (shape 0 3
2300: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
2330: 61 6d 62 64 61 20 28 6b 29 20 28 76 61 6c 75 65 ambda (k) (value
2340: 73 20 31 20 6b 29 29 29 29 29 0a 20 20 20 20 20 s 1 k))))).
2350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2360: 74 61 62 75 6c 61 74 65 2d 61 72 72 61 79 21 20 tabulate-array!
2370: 28 73 68 61 70 65 20 34 20 38 20 32 20 35 20 30 (shape 4 8 2 5 0
2380: 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 1).
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23a0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
23b0: 20 28 61 29 0a 20 20 20 20 20 20 20 20 20 20 20 (a).
23c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 2a 20 28 (* (
23e0: 61 72 72 61 79 2d 72 65 66 20 61 20 30 29 0a 20 array-ref a 0).
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2410: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 2d (array-
2420: 72 65 66 20 61 20 31 29 0a 20 20 20 20 20 20 20 ref a 1).
2430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2450: 20 20 20 28 61 72 72 61 79 2d 72 65 66 20 61 20 (array-ref a
2460: 32 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 2))).
2470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2480: 20 20 20 20 20 20 20 20 20 20 69 6e 64 65 78 29 index)
2490: 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 74 )). (error "t
24a0: 61 62 75 6c 61 74 65 2d 61 72 72 61 79 21 20 77 abulate-array! w
24b0: 69 74 68 20 61 72 72 61 79 20 66 61 69 6c 65 64 ith array failed
24c0: 22 29 29 0a 0a 28 70 61 73 74 20 22 74 61 62 75 "))..(past "tabu
24d0: 6c 61 74 65 2d 61 72 72 61 79 21 20 77 69 74 68 late-array! with
24e0: 20 61 72 72 61 79 22 29 0a 0a 3b 3b 3b 20 53 75 array")..;;; Su
24f0: 6d 20 6f 66 20 63 6f 6e 73 74 61 6e 74 73 0a 0a m of constants..
2500: 28 6f 72 20 28 61 72 72 61 79 2d 65 71 75 61 6c (or (array-equal
2510: 3f 0a 20 20 20 20 20 28 61 72 72 61 79 2d 6d 61 ?. (array-ma
2520: 70 0a 20 20 20 20 20 20 2b 0a 20 20 20 20 20 20 p. +.
2530: 28 73 68 61 72 65 2d 61 72 72 61 79 20 28 61 72 (share-array (ar
2540: 72 61 79 20 28 73 68 61 70 65 29 20 30 29 20 28 ray (shape) 0) (
2550: 73 68 61 70 65 20 31 20 32 20 31 20 34 29 20 28 shape 1 2 1 4) (
2560: 6c 61 6d 62 64 61 20 5f 20 28 76 61 6c 75 65 73 lambda _ (values
2570: 29 29 29 0a 20 20 20 20 20 20 28 73 68 61 72 65 ))). (share
2580: 2d 61 72 72 61 79 20 28 61 72 72 61 79 20 28 73 -array (array (s
2590: 68 61 70 65 29 20 31 29 20 28 73 68 61 70 65 20 hape) 1) (shape
25a0: 31 20 32 20 31 20 34 29 20 28 6c 61 6d 62 64 61 1 2 1 4) (lambda
25b0: 20 5f 20 28 76 61 6c 75 65 73 29 29 29 0a 20 20 _ (values))).
25c0: 20 20 20 20 28 73 68 61 72 65 2d 61 72 72 61 79 (share-array
25d0: 20 28 61 72 72 61 79 20 28 73 68 61 70 65 29 20 (array (shape)
25e0: 32 29 20 28 73 68 61 70 65 20 31 20 32 20 31 20 2) (shape 1 2 1
25f0: 34 29 20 28 6c 61 6d 62 64 61 20 5f 20 28 76 61 4) (lambda _ (va
2600: 6c 75 65 73 29 29 29 29 0a 20 20 20 20 20 28 61 lues)))). (a
2610: 72 72 61 79 20 28 73 68 61 70 65 20 31 20 32 20 rray (shape 1 2
2620: 31 20 34 29 20 33 20 33 20 33 29 29 0a 20 20 20 1 4) 3 3 3)).
2630: 20 28 65 72 72 6f 72 20 22 66 61 69 6c 65 64 20 (error "failed
2640: 74 6f 20 6d 61 70 20 63 6f 6e 73 74 61 6e 74 73 to map constants
2650: 20 74 6f 20 74 68 65 69 72 20 63 6f 6e 73 74 61 to their consta
2660: 6e 74 20 73 75 6d 22 29 29 0a 0a 28 70 61 73 74 nt sum"))..(past
2670: 20 22 61 72 72 61 79 2d 6d 61 70 20 73 75 6d 22 "array-map sum"
2680: 29 0a 0a 3b 3b 3b 20 4d 75 6c 74 69 70 6c 69 63 )..;;; Multiplic
2690: 61 74 69 6f 6e 20 74 61 62 6c 65 0a 0a 28 64 65 ation table..(de
26a0: 66 69 6e 65 20 66 6f 75 72 2d 62 79 2d 66 6f 75 fine four-by-fou
26b0: 72 0a 20 20 28 61 72 72 61 79 20 28 73 68 61 70 r. (array (shap
26c0: 65 20 30 20 34 20 30 20 34 29 0a 20 20 20 20 20 e 0 4 0 4).
26d0: 20 20 20 20 30 20 30 20 30 20 30 0a 20 20 20 20 0 0 0 0.
26e0: 20 20 20 20 20 30 20 31 20 32 20 33 0a 20 20 20 0 1 2 3.
26f0: 20 20 20 20 20 20 30 20 32 20 34 20 36 0a 20 20 0 2 4 6.
2700: 20 20 20 20 20 20 20 30 20 33 20 36 20 39 29 29 0 3 6 9))
2710: 0a 0a 28 70 61 73 74 20 22 66 6f 75 72 2d 62 79 ..(past "four-by
2720: 2d 66 6f 75 72 22 29 0a 0a 28 6f 72 20 28 61 72 -four")..(or (ar
2730: 72 61 79 2d 65 71 75 61 6c 3f 20 66 6f 75 72 2d ray-equal? four-
2740: 62 79 2d 66 6f 75 72 20 28 74 61 62 75 6c 61 74 by-four (tabulat
2750: 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 30 e-array (shape 0
2760: 20 34 20 30 20 34 29 20 2a 29 29 0a 20 20 20 20 4 0 4) *)).
2770: 28 65 72 72 6f 72 20 22 66 61 69 6c 65 64 20 74 (error "failed t
2780: 6f 20 74 61 62 75 6c 61 74 65 20 66 6f 75 72 20 o tabulate four
2790: 62 79 20 66 6f 75 72 22 29 29 0a 0a 28 70 61 73 by four"))..(pas
27a0: 74 20 22 66 6f 75 72 2d 62 79 2d 66 6f 75 72 20 t "four-by-four
27b0: 76 73 20 74 61 62 75 6c 61 74 65 2d 61 72 72 61 vs tabulate-arra
27c0: 79 22 29 0a 0a 28 6f 72 20 28 61 72 72 61 79 2d y")..(or (array-
27d0: 65 71 75 61 6c 3f 0a 20 20 20 20 20 66 6f 75 72 equal?. four
27e0: 2d 62 79 2d 66 6f 75 72 0a 20 20 20 20 20 28 6c -by-four. (l
27f0: 65 74 20 28 28 74 61 62 6c 65 20 28 6d 61 6b 65 et ((table (make
2800: 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 30 20 -array (shape 0
2810: 34 20 30 20 34 29 20 31 39 31 30 31 29 29 29 0a 4 0 4) 19101))).
2820: 20 20 20 20 20 20 20 28 61 72 72 61 79 2d 72 65 (array-re
2830: 74 61 62 75 6c 61 74 65 21 20 74 61 62 6c 65 20 tabulate! table
2840: 28 61 72 72 61 79 2d 73 68 61 70 65 20 74 61 62 (array-shape tab
2850: 6c 65 29 20 2a 29 0a 20 20 20 20 20 20 20 74 61 le) *). ta
2860: 62 6c 65 29 29 0a 20 20 20 20 28 65 72 72 6f 72 ble)). (error
2870: 20 22 66 61 69 6c 65 64 20 74 6f 20 72 65 74 61 "failed to reta
2880: 62 75 6c 61 74 65 20 66 6f 75 72 20 62 79 20 66 bulate four by f
2890: 6f 75 72 20 73 69 6d 70 6c 79 22 29 29 0a 0a 28 our simply"))..(
28a0: 70 61 73 74 20 22 66 6f 75 72 2d 62 79 2d 66 6f past "four-by-fo
28b0: 75 72 20 76 73 20 61 72 72 61 79 2d 72 65 74 61 ur vs array-reta
28c0: 62 75 6c 61 74 65 21 22 29 0a 0a 28 6f 72 20 28 bulate!")..(or (
28d0: 61 72 72 61 79 2d 65 71 75 61 6c 3f 0a 20 20 20 array-equal?.
28e0: 20 20 66 6f 75 72 2d 62 79 2d 66 6f 75 72 0a 20 four-by-four.
28f0: 20 20 20 20 28 6c 65 74 20 28 28 74 61 62 6c 65 (let ((table
2900: 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 28 73 68 (make-array (sh
2910: 61 70 65 20 30 20 34 20 30 20 34 29 20 31 39 31 ape 0 4 0 4) 191
2920: 30 31 29 29 29 0a 20 20 20 20 20 20 20 28 61 72 01))). (ar
2930: 72 61 79 2d 72 65 74 61 62 75 6c 61 74 65 21 0a ray-retabulate!.
2940: 20 20 20 20 20 20 20 20 74 61 62 6c 65 0a 20 20 table.
2950: 20 20 20 20 20 20 28 73 68 61 70 65 20 31 20 32 (shape 1 2
2960: 20 31 20 34 29 0a 20 20 20 20 20 20 20 20 28 6c 1 4). (l
2970: 61 6d 62 64 61 20 28 76 29 0a 20 20 20 20 20 20 ambda (v).
2980: 20 20 20 20 28 2a 20 28 76 65 63 74 6f 72 2d 72 (* (vector-r
2990: 65 66 20 76 20 30 29 20 28 76 65 63 74 6f 72 2d ef v 0) (vector-
29a0: 72 65 66 20 76 20 31 29 29 29 0a 20 20 20 20 20 ref v 1))).
29b0: 20 20 20 28 76 65 63 74 6f 72 20 2d 20 2d 29 29 (vector - -))
29c0: 0a 20 20 20 20 20 20 20 28 61 72 72 61 79 2d 72 . (array-r
29d0: 65 74 61 62 75 6c 61 74 65 21 0a 20 20 20 20 20 etabulate!.
29e0: 20 20 20 74 61 62 6c 65 0a 20 20 20 20 20 20 20 table.
29f0: 20 28 73 68 61 70 65 20 32 20 34 20 30 20 34 29 (shape 2 4 0 4)
2a00: 0a 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 . (lambda
2a10: 20 28 61 29 0a 20 20 20 20 20 20 20 20 20 20 28 (a). (
2a20: 2a 20 28 61 72 72 61 79 2d 72 65 66 20 61 20 28 * (array-ref a (
2a30: 76 65 63 74 6f 72 20 30 29 29 20 28 61 72 72 61 vector 0)) (arra
2a40: 79 2d 72 65 66 20 61 20 28 76 65 63 74 6f 72 20 y-ref a (vector
2a50: 31 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 6d 1)))). (m
2a60: 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 ake-array (shape
2a70: 20 30 20 32 29 29 29 0a 20 20 20 20 20 20 20 28 0 2))). (
2a80: 61 72 72 61 79 2d 73 65 74 21 20 74 61 62 6c 65 array-set! table
2a90: 20 30 20 30 20 30 29 0a 20 20 20 20 20 20 20 28 0 0 0). (
2aa0: 61 72 72 61 79 2d 73 65 74 21 20 74 61 62 6c 65 array-set! table
2ab0: 20 28 76 65 63 74 6f 72 20 30 20 31 29 20 30 29 (vector 0 1) 0)
2ac0: 0a 20 20 20 20 20 20 20 28 61 72 72 61 79 2d 73 . (array-s
2ad0: 65 74 21 20 74 61 62 6c 65 20 28 61 72 72 61 79 et! table (array
2ae0: 20 28 73 68 61 70 65 20 30 20 32 29 20 30 20 32 (shape 0 2) 0 2
2af0: 29 20 30 29 0a 20 20 20 20 20 20 20 28 73 68 61 ) 0). (sha
2b00: 70 65 2d 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 pe-for-each.
2b10: 20 20 20 20 28 73 68 61 70 65 20 30 20 31 20 33 (shape 0 1 3
2b20: 20 34 29 0a 20 20 20 20 20 20 20 20 28 6c 61 6d 4). (lam
2b30: 62 64 61 20 28 76 29 0a 20 20 20 20 20 20 20 20 bda (v).
2b40: 20 20 28 61 72 72 61 79 2d 73 65 74 21 20 74 61 (array-set! ta
2b50: 62 6c 65 20 76 20 28 76 65 63 74 6f 72 2d 72 65 ble v (vector-re
2b60: 66 20 76 20 30 29 29 29 0a 20 20 20 20 20 20 20 f v 0))).
2b70: 20 28 76 65 63 74 6f 72 20 2d 20 2d 29 29 0a 20 (vector - -)).
2b80: 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 72 72 (let ((arr
2b90: 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 (share-array.
2ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bb0: 20 74 61 62 6c 65 0a 20 20 20 20 20 20 20 20 20 table.
2bc0: 20 20 20 20 20 20 20 20 20 20 28 73 68 61 70 65 (shape
2bd0: 20 31 20 32 20 30 20 31 20 31 20 32 20 33 20 34 1 2 0 1 1 2 3 4
2be0: 20 35 20 36 20 37 20 38 20 31 20 32 20 33 20 34 5 6 7 8 1 2 3 4
2bf0: 20 35 20 36 20 37 20 38 29 0a 20 20 20 20 20 20 5 6 7 8).
2c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
2c10: 6d 62 64 61 20 28 72 20 6b 20 2e 20 5f 29 0a 20 mbda (r k . _).
2c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c30: 20 20 20 20 28 76 61 6c 75 65 73 20 72 20 6b 29 (values r k)
2c40: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 61 )))). (a
2c50: 72 72 61 79 2d 72 65 74 61 62 75 6c 61 74 65 21 rray-retabulate!
2c60: 20 61 72 72 20 28 61 72 72 61 79 2d 73 68 61 70 arr (array-shap
2c70: 65 20 61 72 72 29 20 2a 29 29 0a 20 20 20 20 20 e arr) *)).
2c80: 20 20 74 61 62 6c 65 29 29 0a 20 20 20 20 28 65 table)). (e
2c90: 72 72 6f 72 20 22 66 61 69 6c 65 64 20 74 6f 20 rror "failed to
2ca0: 72 65 74 61 62 75 6c 61 74 65 20 66 6f 75 72 20 retabulate four
2cb0: 62 79 20 66 6f 75 72 20 69 6e 20 61 20 68 61 72 by four in a har
2cc0: 64 20 77 61 79 22 29 29 0a 0a 28 70 61 73 74 20 d way"))..(past
2cd0: 22 66 6f 75 72 2d 62 79 2d 66 6f 75 72 20 76 73 "four-by-four vs
2ce0: 20 61 72 72 61 79 2d 72 65 74 61 62 75 6c 61 74 array-retabulat
2cf0: 65 21 20 6f 6e 20 70 61 72 74 73 22 29 0a 0a 3b e! on parts")..;
2d00: 3b 3b 20 41 6e 20 61 72 67 75 6d 65 6e 74 20 77 ;; An argument w
2d10: 61 73 20 6d 69 73 73 69 6e 67 20 69 6e 20 61 20 as missing in a
2d20: 63 61 6c 6c 20 69 6e 20 61 72 6c 69 62 20 77 68 call in arlib wh
2d30: 65 6e 0a 3b 3b 3b 20 73 68 61 70 65 2d 66 6f 72 en.;;; shape-for
2d40: 2d 65 61 63 68 20 77 61 73 20 63 61 6c 6c 65 64 -each was called
2d50: 20 77 69 74 68 6f 75 74 20 61 6e 20 69 6e 64 65 without an inde
2d60: 78 20 6f 62 6a 65 63 74 2e 0a 0a 28 6f 72 20 28 x object...(or (
2d70: 6c 65 74 20 28 28 65 6d 20 27 28 29 29 29 0a 20 let ((em '())).
2d80: 20 20 20 20 20 28 73 68 61 70 65 2d 66 6f 72 2d (shape-for-
2d90: 65 61 63 68 0a 20 20 20 20 20 20 20 28 73 68 61 each. (sha
2da0: 70 65 20 30 20 32 20 2d 32 20 30 20 30 20 31 29 pe 0 2 -2 0 0 1)
2db0: 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
2dc0: 28 75 20 76 20 77 29 0a 20 20 20 20 20 20 20 20 (u v w).
2dd0: 20 28 73 65 74 21 20 65 6d 20 28 63 6f 6e 73 20 (set! em (cons
2de0: 28 6c 69 73 74 20 75 20 76 20 77 29 20 65 6d 29 (list u v w) em)
2df0: 29 29 29 0a 20 20 20 20 20 20 28 65 71 75 61 6c ))). (equal
2e00: 3f 20 28 72 65 76 65 72 73 65 20 65 6d 29 20 27 ? (reverse em) '
2e10: 28 28 30 20 2d 32 20 30 29 20 28 30 20 2d 31 20 ((0 -2 0) (0 -1
2e20: 30 29 20 28 31 20 2d 32 20 30 29 20 28 31 20 2d 0) (1 -2 0) (1 -
2e30: 31 20 30 29 29 29 29 0a 20 20 20 20 28 65 72 72 1 0)))). (err
2e40: 6f 72 20 22 73 68 61 70 65 2d 66 6f 72 2d 65 61 or "shape-for-ea
2e50: 63 68 20 77 69 74 68 6f 75 74 20 69 6e 64 65 78 ch without index
2e60: 20 6f 62 6a 65 63 74 22 29 29 0a 0a 28 70 61 73 object"))..(pas
2e70: 74 20 22 73 68 61 70 65 2d 66 6f 72 2d 65 61 63 t "shape-for-eac
2e80: 68 20 77 69 74 68 6f 75 74 20 69 6e 64 65 78 20 h without index
2e90: 6f 62 6a 65 63 74 22 29 0a 20 20 20 20 20 20 20 object").
2ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2eb0: 20 20 20 20 20 20 20 20 20 20 0a 0a 3b 3b 3b 20 ..;;;
2ec0: 45 78 65 72 63 69 73 65 20 73 68 61 72 65 2d 61 Exercise share-a
2ed0: 72 72 61 79 2f 69 6e 64 65 78 21 0a 0a 28 6f 72 rray/index!..(or
2ee0: 20 28 6c 65 74 20 28 28 61 72 72 20 28 74 61 62 (let ((arr (tab
2ef0: 75 6c 61 74 65 2d 61 72 72 61 79 20 28 73 68 61 ulate-array (sha
2f00: 70 65 20 32 20 34 20 33 20 35 20 34 20 37 29 20 pe 2 4 3 5 4 7)
2f10: 2a 29 29 29 0a 20 20 20 20 20 20 28 61 72 72 61 *))). (arra
2f20: 79 2d 65 71 75 61 6c 3f 20 28 73 68 61 72 65 2d y-equal? (share-
2f30: 61 72 72 61 79 2f 69 6e 64 65 78 21 0a 20 20 20 array/index!.
2f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f50: 20 20 61 72 72 0a 20 20 20 20 20 20 20 20 20 20 arr.
2f60: 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 (arra
2f70: 79 2d 73 68 61 70 65 20 61 72 72 29 0a 20 20 20 y-shape arr).
2f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f90: 20 20 28 6c 61 6d 62 64 61 20 28 76 29 20 76 29 (lambda (v) v)
2fa0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2fb0: 20 20 20 20 20 20 28 76 65 63 74 6f 72 20 2a 20 (vector *
2fc0: 2a 20 2a 29 29 0a 20 20 20 20 20 20 20 20 20 20 * *)).
2fd0: 20 20 20 20 20 20 20 20 20 20 61 72 72 29 29 0a arr)).
2fe0: 20 20 20 20 28 65 72 72 6f 72 20 22 73 68 61 72 (error "shar
2ff0: 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 20 77 e-array/index! w
3000: 69 74 68 20 69 64 65 6e 74 69 74 79 20 61 6e 64 ith identity and
3010: 20 76 65 63 74 6f 72 20 66 61 69 6c 65 64 22 29 vector failed")
3020: 29 0a 0a 28 70 61 73 74 20 22 73 68 61 72 65 2d )..(past "share-
3030: 61 72 72 61 79 2f 69 6e 64 65 78 21 20 77 69 74 array/index! wit
3040: 68 20 69 64 65 6e 74 69 74 79 20 61 6e 64 20 76 h identity and v
3050: 65 63 74 6f 72 22 29 0a 0a 28 6f 72 20 28 6c 65 ector")..(or (le
3060: 74 20 28 28 61 72 72 20 28 74 61 62 75 6c 61 74 t ((arr (tabulat
3070: 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 32 e-array (shape 2
3080: 20 34 20 33 20 35 20 34 20 37 29 20 2a 29 29 0a 4 3 5 4 7) *)).
3090: 20 20 20 20 20 20 20 20 20 20 28 69 6e 64 20 28 (ind (
30a0: 73 68 61 72 65 2d 61 72 72 61 79 20 28 6d 61 6b share-array (mak
30b0: 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 30 e-array (shape 0
30c0: 20 32 20 30 20 33 29 29 0a 20 20 20 20 20 20 20 2 0 3)).
30d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30e0: 20 20 20 20 20 28 73 68 61 70 65 20 30 20 33 29 (shape 0 3)
30f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3100: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
3110: 6d 62 64 61 20 28 6b 29 20 28 76 61 6c 75 65 73 mbda (k) (values
3120: 20 31 20 6b 29 29 29 29 29 0a 20 20 20 20 20 20 1 k))))).
3130: 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 28 73 (array-equal? (s
3140: 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 hare-array/index
3150: 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 !.
3160: 20 20 20 20 20 20 20 61 72 72 0a 20 20 20 20 20 arr.
3170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3180: 28 61 72 72 61 79 2d 73 68 61 70 65 20 61 72 72 (array-shape arr
3190: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
31a0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
31b0: 61 29 20 61 29 20 69 6e 64 29 0a 20 20 20 20 20 a) a) ind).
31c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
31d0: 72 72 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 rr)). (error
31e0: 22 73 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 "share-array/ind
31f0: 65 78 21 20 77 69 74 68 20 69 64 65 6e 74 69 74 ex! with identit
3200: 79 20 61 6e 64 20 61 72 72 61 79 20 66 61 69 6c y and array fail
3210: 65 64 22 29 29 0a 0a 28 70 61 73 74 20 22 73 68 ed"))..(past "sh
3220: 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 are-array/index!
3230: 20 77 69 74 68 20 69 64 65 6e 74 69 74 79 20 61 with identity a
3240: 6e 64 20 61 72 72 61 79 22 29 0a 0a 28 6f 72 20 nd array")..(or
3250: 28 6c 65 74 20 28 28 61 72 72 20 28 74 61 62 75 (let ((arr (tabu
3260: 6c 61 74 65 2d 61 72 72 61 79 20 28 73 68 61 70 late-array (shap
3270: 65 20 33 20 35 20 34 20 35 20 34 20 37 29 20 2a e 3 5 4 5 4 7) *
3280: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 6e )). (in
3290: 20 28 76 65 63 74 6f 72 20 2a 20 2a 29 29 0a 20 (vector * *)).
32a0: 20 20 20 20 20 20 20 20 20 28 6f 75 74 20 28 61 (out (a
32b0: 72 72 61 79 20 28 73 68 61 70 65 20 30 20 33 29 rray (shape 0 3)
32c0: 20 34 20 2a 20 2a 29 29 29 0a 20 20 20 20 20 20 4 * *))).
32d0: 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 28 73 (array-equal? (s
32e0: 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 hare-array/index
32f0: 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 !.
3300: 20 20 20 20 20 20 20 61 72 72 0a 20 20 20 20 20 arr.
3310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3320: 28 73 68 61 70 65 20 34 20 35 20 34 20 37 29 0a (shape 4 5 4 7).
3330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3340: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 6e (lambda (in
3350: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3360: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 2d (array-
3370: 73 65 74 21 20 6f 75 74 20 31 20 28 76 65 63 74 set! out 1 (vect
3380: 6f 72 2d 72 65 66 20 69 6e 20 30 29 29 0a 20 20 or-ref in 0)).
3390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33a0: 20 20 20 20 20 28 61 72 72 61 79 2d 73 65 74 21 (array-set!
33b0: 20 6f 75 74 20 32 20 28 76 65 63 74 6f 72 2d 72 out 2 (vector-r
33c0: 65 66 20 69 6e 20 31 29 29 0a 20 20 20 20 20 20 ef in 1)).
33d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33e0: 20 6f 75 74 29 0a 20 20 20 20 20 20 20 20 20 20 out).
33f0: 20 20 20 20 20 20 20 20 20 20 20 69 6e 29 0a 20 in).
3400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3410: 20 20 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a (share-array.
3420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3430: 20 20 20 20 20 61 72 72 0a 20 20 20 20 20 20 20 arr.
3440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
3450: 68 61 70 65 20 34 20 35 20 34 20 37 29 0a 20 20 hape 4 5 4 7).
3460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3470: 20 20 20 28 6c 61 6d 62 64 61 20 28 6a 20 6b 29 (lambda (j k)
3480: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3490: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 (values
34a0: 34 20 6a 20 6b 29 29 29 29 29 0a 20 20 20 20 28 4 j k))))). (
34b0: 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 72 error "share-arr
34c0: 61 79 2f 69 6e 64 65 78 21 20 77 69 74 68 20 76 ay/index! with v
34d0: 65 63 74 6f 72 20 69 6e 20 61 72 72 61 79 20 6f ector in array o
34e0: 75 74 20 66 61 69 6c 65 64 22 29 29 0a 0a 28 70 ut failed"))..(p
34f0: 61 73 74 20 22 73 68 61 72 65 2d 61 72 72 61 79 ast "share-array
3500: 2f 69 6e 64 65 78 21 20 77 69 74 68 20 76 65 63 /index! with vec
3510: 74 6f 72 20 69 6e 20 61 72 72 61 79 20 6f 75 74 tor in array out
3520: 22 29 0a 0a 28 6f 72 20 28 6c 65 74 20 28 28 61 ")..(or (let ((a
3530: 72 72 20 28 74 61 62 75 6c 61 74 65 2d 61 72 72 rr (tabulate-arr
3540: 61 79 20 28 73 68 61 70 65 20 33 20 35 20 34 20 ay (shape 3 5 4
3550: 35 20 34 20 37 29 20 2a 29 29 0a 20 20 20 20 20 5 4 7) *)).
3560: 20 20 20 20 20 28 69 6e 20 28 61 72 72 61 79 20 (in (array
3570: 28 73 68 61 70 65 20 30 20 32 29 20 2a 20 2a 29 (shape 0 2) * *)
3580: 29 0a 20 20 20 20 20 20 20 20 20 20 28 6f 75 74 ). (out
3590: 20 28 76 65 63 74 6f 72 20 34 20 2a 20 2a 29 29 (vector 4 * *))
35a0: 29 0a 20 20 20 20 20 20 28 61 72 72 61 79 2d 65 ). (array-e
35b0: 71 75 61 6c 3f 20 28 73 68 61 72 65 2d 61 72 72 qual? (share-arr
35c0: 61 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 ay/index!.
35d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
35e0: 72 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 rr.
35f0: 20 20 20 20 20 20 20 20 28 73 68 61 70 65 20 34 (shape 4
3600: 20 35 20 34 20 37 29 0a 20 20 20 20 20 20 20 20 5 4 7).
3610: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
3620: 6d 62 64 61 20 28 69 6e 29 0a 20 20 20 20 20 20 mbda (in).
3630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3640: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6f 75 (vector-set! ou
3650: 74 20 31 20 28 61 72 72 61 79 2d 72 65 66 20 69 t 1 (array-ref i
3660: 6e 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 n 0)).
3670: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
3680: 63 74 6f 72 2d 73 65 74 21 20 6f 75 74 20 32 20 ctor-set! out 2
3690: 28 61 72 72 61 79 2d 72 65 66 20 69 6e 20 31 29 (array-ref in 1)
36a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
36b0: 20 20 20 20 20 20 20 20 20 6f 75 74 29 0a 20 20 out).
36c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
36d0: 20 20 20 69 6e 29 0a 20 20 20 20 20 20 20 20 20 in).
36e0: 20 20 20 20 20 20 20 20 20 20 20 28 73 68 61 72 (shar
36f0: 65 2d 61 72 72 61 79 0a 20 20 20 20 20 20 20 20 e-array.
3700: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 72 72 arr
3710: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3720: 20 20 20 20 20 20 28 73 68 61 70 65 20 34 20 35 (shape 4 5
3730: 20 34 20 37 29 0a 20 20 20 20 20 20 20 20 20 20 4 7).
3740: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
3750: 64 61 20 28 6a 20 6b 29 0a 20 20 20 20 20 20 20 da (j k).
3760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3770: 28 76 61 6c 75 65 73 20 34 20 6a 20 6b 29 29 29 (values 4 j k)))
3780: 29 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 73 )). (error "s
3790: 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 hare-array/index
37a0: 21 20 77 69 74 68 20 61 72 72 61 79 20 69 6e 20 ! with array in
37b0: 76 65 63 74 6f 72 20 6f 75 74 20 66 61 69 6c 65 vector out faile
37c0: 64 22 29 29 0a 0a 28 70 61 73 74 20 22 73 68 61 d"))..(past "sha
37d0: 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 20 re-array/index!
37e0: 77 69 74 68 20 61 72 72 61 79 20 69 6e 20 76 65 with array in ve
37f0: 63 74 6f 72 20 6f 75 74 22 29 0a 0a 28 6c 65 74 ctor out")..(let
3800: 20 28 28 78 20 28 61 72 72 61 79 20 28 73 68 61 ((x (array (sha
3810: 70 65 20 32 20 34 20 20 33 20 35 20 20 34 20 35 pe 2 4 3 5 4 5
3820: 20 20 35 20 37 20 20 36 20 38 29 0a 20 20 20 20 5 7 6 8).
3830: 20 20 20 20 20 20 20 20 20 20 20 20 31 30 20 31 10 1
3840: 31 20 31 32 20 31 33 0a 20 20 20 20 20 20 20 20 1 12 13.
3850: 20 20 20 20 20 20 20 20 32 30 20 32 31 20 32 32 20 21 22
3860: 20 32 33 0a 20 20 20 20 20 20 20 20 20 20 20 20 23.
3870: 20 20 20 20 33 30 20 33 31 20 33 32 20 33 33 0a 30 31 32 33.
3880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3890: 34 30 20 34 31 20 34 32 20 34 33 29 29 29 0a 20 40 41 42 43))).
38a0: 20 28 6f 72 20 28 61 72 72 61 79 2d 65 71 75 61 (or (array-equa
38b0: 6c 3f 20 28 73 68 61 72 65 2d 61 72 72 61 79 2f l? (share-array/
38c0: 6f 72 69 67 69 6e 20 78 20 33 20 33 20 33 20 33 origin x 3 3 3 3
38d0: 20 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 3).
38e0: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 2d 61 (array-a
38f0: 70 70 65 6e 64 20 30 20 28 61 72 72 61 79 20 28 ppend 0 (array (
3900: 73 68 61 70 65 20 33 20 33 0a 20 20 20 20 20 20 shape 3 3.
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 20 20 20 20 20 20 20 20 33 20 35 0a 3 5.
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 20 20 20 20 20 20 20 20 20 20 20 20
3970: 20 20 33 20 34 0a 20 20 20 20 20 20 20 20 20 20 3 4.
3980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39a0: 20 20 20 20 20 20 20 20 33 20 35 0a 20 20 20 20 3 5.
39b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 33 20 3
39e0: 35 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 5)).
39f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a00: 20 20 20 20 20 20 78 29 29 0a 20 20 20 20 20 20 x)).
3a10: 28 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 (error "share-ar
3a20: 72 61 79 2f 6f 72 69 67 69 6e 20 61 67 61 69 6e ray/origin again
3a30: 73 74 20 65 6d 70 74 79 20 61 72 72 61 79 2d 61 st empty array-a
3a40: 70 70 65 6e 64 20 66 61 69 6c 65 64 22 29 29 0a ppend failed")).
3a50: 20 20 28 6f 72 20 28 61 72 72 61 79 2d 65 71 75 (or (array-equ
3a60: 61 6c 3f 20 28 73 68 61 72 65 2d 61 72 72 61 79 al? (share-array
3a70: 2f 6f 72 69 67 69 6e 20 78 20 33 20 33 20 33 20 /origin x 3 3 3
3a80: 33 20 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 3 3).
3a90: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 2d (array-
3aa0: 61 70 70 65 6e 64 20 33 20 28 61 72 72 61 79 20 append 3 (array
3ab0: 28 73 68 61 70 65 20 33 20 35 0a 20 20 20 20 20 (shape 3 5.
3ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 33 20 35 3 5
3af0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b20: 20 20 20 33 20 34 0a 20 20 20 20 20 20 20 20 20 3 4.
3b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b50: 20 20 20 20 20 20 20 20 20 33 20 33 0a 20 20 20 3 3.
3b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 33 3
3b90: 20 35 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 5)).
3ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bb0: 20 20 20 20 20 20 20 78 29 29 0a 20 20 20 20 20 x)).
3bc0: 20 28 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 (error "share-a
3bd0: 72 72 61 79 2f 6f 72 69 67 69 6e 20 61 67 61 69 rray/origin agai
3be0: 6e 73 74 20 65 6d 70 74 79 20 61 72 72 61 79 2d nst empty array-
3bf0: 61 70 70 65 6e 64 20 66 61 69 6c 65 64 22 29 29 append failed"))
3c00: 29 0a 0a 28 70 61 73 74 20 22 73 68 61 72 65 2d )..(past "share-
3c10: 61 72 72 61 79 2f 6f 72 69 67 69 6e 20 61 67 61 array/origin aga
3c20: 69 6e 73 74 20 65 6d 70 74 79 20 61 72 72 61 79 inst empty array
3c30: 2d 61 70 70 65 6e 64 22 29 0a 0a 28 6c 65 74 20 -append")..(let
3c40: 28 28 61 2a 20 28 6d 61 6b 65 2d 61 72 72 61 79 ((a* (make-array
3c50: 20 28 73 68 61 70 65 20 34 20 36 20 37 20 39 20 (shape 4 6 7 9
3c60: 31 30 30 20 31 30 31 29 20 27 61 29 29 0a 20 20 100 101) 'a)).
3c70: 20 20 20 20 28 62 2a 20 28 6d 61 6b 65 2d 61 72 (b* (make-ar
3c80: 72 61 79 20 28 73 68 61 70 65 20 33 20 36 20 37 ray (shape 3 6 7
3c90: 20 38 20 32 30 30 20 32 30 31 29 20 27 62 29 29 8 200 201) 'b))
3ca0: 0a 20 20 20 20 20 20 28 63 2a 20 28 6d 61 6b 65 . (c* (make
3cb0: 2d 61 72 72 61 79 20 28 73 68 61 70 65 20 30 20 -array (shape 0
3cc0: 31 20 32 20 34 20 33 30 30 20 33 30 31 29 20 27 1 2 4 300 301) '
3cd0: 63 29 29 29 0a 20 20 28 6f 72 20 28 61 72 72 61 c))). (or (arra
3ce0: 79 2d 65 71 75 61 6c 3f 20 28 61 72 72 61 79 2d y-equal? (array-
3cf0: 61 70 70 65 6e 64 20 31 20 28 61 72 72 61 79 2d append 1 (array-
3d00: 61 70 70 65 6e 64 20 30 20 61 2a 20 63 2a 29 20 append 0 a* c*)
3d10: 62 2a 20 62 2a 20 62 2a 29 0a 20 20 20 20 20 20 b* b* b*).
3d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
3d30: 70 70 6c 79 20 61 72 72 61 79 20 28 73 68 61 70 pply array (shap
3d40: 65 20 34 20 37 20 37 20 31 32 20 31 30 30 20 31 e 4 7 7 12 100 1
3d50: 30 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 01).
3d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 '
3d70: 28 61 20 61 20 62 20 62 20 62 0a 20 20 20 20 20 (a a b b b.
3d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d90: 20 20 20 20 20 20 20 20 61 20 61 20 62 20 62 20 a a b b
3da0: 62 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 b.
3db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
3dc0: 20 63 20 62 20 62 20 62 29 29 29 0a 20 20 20 20 c b b b))).
3dd0: 20 20 28 65 72 72 6f 72 20 22 61 72 72 61 79 2d (error "array-
3de0: 61 70 70 65 6e 64 20 66 61 69 6c 65 64 22 29 29 append failed"))
3df0: 29 0a 0a 28 70 61 73 74 20 22 61 72 72 61 79 2d )..(past "array-
3e00: 61 70 70 65 6e 64 22 29 0a 0a 28 6c 65 74 20 28 append")..(let (
3e10: 28 61 2a 20 28 6d 61 6b 65 2d 61 72 72 61 79 20 (a* (make-array
3e20: 28 73 68 61 70 65 20 34 20 36 20 37 20 39 20 31 (shape 4 6 7 9 1
3e30: 30 30 20 31 30 31 29 20 27 61 29 29 0a 20 20 20 00 101) 'a)).
3e40: 20 20 20 28 62 2a 20 28 6d 61 6b 65 2d 61 72 72 (b* (make-arr
3e50: 61 79 20 28 73 68 61 70 65 20 33 20 36 20 37 20 ay (shape 3 6 7
3e60: 38 20 32 30 30 20 32 30 31 29 20 27 62 29 29 0a 8 200 201) 'b)).
3e70: 20 20 20 20 20 20 28 63 2a 20 28 6d 61 6b 65 2d (c* (make-
3e80: 61 72 72 61 79 20 28 73 68 61 70 65 20 30 20 31 array (shape 0 1
3e90: 20 32 20 34 20 33 30 30 20 33 30 31 29 20 27 63 2 4 300 301) 'c
3ea0: 29 29 29 0a 20 20 28 6f 72 20 28 61 72 72 61 79 ))). (or (array
3eb0: 2d 65 71 75 61 6c 3f 20 28 61 72 72 61 79 2d 61 -equal? (array-a
3ec0: 70 70 65 6e 64 20 31 20 61 2a 20 28 74 72 61 6e ppend 1 a* (tran
3ed0: 73 70 6f 73 65 20 63 2a 20 31 20 30 20 32 29 0a spose c* 1 0 2).
3ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f00: 20 20 28 61 72 72 61 79 2d 61 70 70 65 6e 64 20 (array-append
3f10: 30 20 28 74 72 61 6e 73 70 6f 73 65 20 62 2a 20 0 (transpose b*
3f20: 31 20 30 20 32 29 0a 20 20 20 20 20 20 20 20 20 1 0 2).
3f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f50: 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 73 (transpos
3f60: 65 20 62 2a 20 31 20 30 20 32 29 29 29 0a 20 20 e b* 1 0 2))).
3f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f80: 20 20 28 61 70 70 6c 79 20 61 72 72 61 79 20 28 (apply array (
3f90: 73 68 61 70 65 20 34 20 36 20 37 20 31 33 20 31 shape 4 6 7 13 1
3fa0: 30 30 20 31 30 31 29 0a 20 20 20 20 20 20 20 20 00 101).
3fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fc0: 20 20 20 27 28 61 20 61 20 63 20 62 20 62 20 62 '(a a c b b b
3fd0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 20 a
3ff0: 61 20 63 20 62 20 62 20 62 29 29 29 0a 20 20 20 a c b b b))).
4000: 20 20 20 28 65 72 72 6f 72 20 22 61 72 72 61 79 (error "array
4010: 2d 61 70 70 65 6e 64 20 77 69 74 68 20 74 72 61 -append with tra
4020: 6e 73 70 6f 73 65 20 66 61 69 6c 65 64 22 29 29 nspose failed"))
4030: 29 0a 0a 28 70 61 73 74 20 22 61 72 72 61 79 2d )..(past "array-
4040: 61 70 70 65 6e 64 20 77 69 74 68 20 74 72 61 6e append with tran
4050: 73 70 6f 73 65 22 29 0a 0a 3b 3b 3b 20 43 68 65 spose")..;;; Che
4060: 63 6b 20 74 68 61 74 20 73 68 61 72 65 2d 61 72 ck that share-ar
4070: 72 61 79 2f 69 6e 64 65 78 21 20 61 67 72 65 65 ray/index! agree
4080: 73 20 77 69 74 68 20 73 68 61 72 65 2d 61 72 72 s with share-arr
4090: 61 79 2e 0a 0a 28 6c 65 74 20 28 28 6d 20 28 61 ay...(let ((m (a
40a0: 72 72 61 79 20 28 73 68 61 70 65 20 31 20 33 20 rray (shape 1 3
40b0: 31 20 33 29 20 27 61 20 27 62 20 27 63 20 27 64 1 3) 'a 'b 'c 'd
40c0: 29 29 29 0a 20 20 28 6f 72 20 28 61 72 72 61 79 ))). (or (array
40d0: 2d 65 71 75 61 6c 3f 20 6d 20 28 73 68 61 72 65 -equal? m (share
40e0: 2d 61 72 72 61 79 20 6d 20 28 73 68 61 70 65 20 -array m (shape
40f0: 31 20 33 20 31 20 33 29 20 76 61 6c 75 65 73 29 1 3 1 3) values)
4100: 29 0a 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 ). (error "
4110: 73 68 61 72 65 2d 61 72 72 61 79 20 69 64 65 6e share-array iden
4120: 74 69 74 79 20 66 61 69 6c 65 64 22 29 29 0a 20 tity failed")).
4130: 20 28 6f 72 20 28 61 72 72 61 79 2d 65 71 75 61 (or (array-equa
4140: 6c 3f 20 6d 20 28 73 68 61 72 65 2d 61 72 72 61 l? m (share-arra
4150: 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 20 y/index!.
4160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4170: 6d 20 28 73 68 61 70 65 20 31 20 33 20 31 20 33 m (shape 1 3 1 3
4180: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4190: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
41a0: 20 28 78 29 20 78 29 0a 20 20 20 20 20 20 20 20 (x) x).
41b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
41c0: 76 65 63 74 6f 72 20 2a 20 2a 29 29 29 0a 20 20 vector * *))).
41d0: 20 20 20 20 28 65 72 72 6f 72 20 22 73 68 61 72 (error "shar
41e0: 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 20 69 e-array/index! i
41f0: 64 65 6e 74 69 74 79 20 77 69 74 68 20 76 65 63 dentity with vec
4200: 74 6f 72 20 66 61 69 6c 65 64 22 29 29 0a 20 20 tor failed")).
4210: 28 6f 72 20 28 61 72 72 61 79 2d 65 71 75 61 6c (or (array-equal
4220: 3f 20 6d 20 28 73 68 61 72 65 2d 61 72 72 61 79 ? m (share-array
4230: 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 20 20 /index!.
4240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d m
4250: 20 28 73 68 61 70 65 20 31 20 33 20 31 20 33 29 (shape 1 3 1 3)
4260: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4270: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
4280: 28 78 29 20 78 29 0a 20 20 20 20 20 20 20 20 20 (x) x).
4290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
42a0: 61 6b 65 2d 61 72 72 61 79 20 28 73 68 61 70 65 ake-array (shape
42b0: 20 30 20 32 29 29 29 29 0a 20 20 20 20 20 20 28 0 2)))). (
42c0: 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 72 error "share-arr
42d0: 61 79 2f 69 6e 64 65 78 21 20 69 64 65 6e 74 69 ay/index! identi
42e0: 74 79 20 77 69 74 68 20 61 63 74 6f 72 20 66 61 ty with actor fa
42f0: 69 6c 65 64 22 29 29 29 0a 0a 28 70 61 73 74 20 iled")))..(past
4300: 22 73 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 "share-array/ind
4310: 65 78 21 20 69 64 65 6e 74 69 74 79 22 29 0a 0a ex! identity")..
4320: 28 6c 65 74 20 28 28 6d 20 28 61 72 72 61 79 20 (let ((m (array
4330: 28 73 68 61 70 65 20 31 20 33 20 31 20 33 29 20 (shape 1 3 1 3)
4340: 27 61 20 27 62 20 27 63 20 27 64 29 29 29 0a 20 'a 'b 'c 'd))).
4350: 20 28 6f 72 20 28 61 72 72 61 79 2d 65 71 75 61 (or (array-equa
4360: 6c 3f 20 28 73 68 61 72 65 2d 61 72 72 61 79 0a l? (share-array.
4370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4380: 20 20 20 20 20 6d 20 28 73 68 61 70 65 20 31 20 m (shape 1
4390: 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3).
43a0: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
43b0: 28 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 (r).
43c0: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu
43d0: 65 73 20 72 20 31 29 29 29 0a 20 20 20 20 20 20 es r 1))).
43e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
43f0: 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 hare-array/index
4400: 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 !.
4410: 20 20 20 20 20 20 20 20 20 6d 20 28 73 68 61 70 m (shap
4420: 65 20 31 20 33 29 0a 20 20 20 20 20 20 20 20 20 e 1 3).
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
4440: 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 ambda (x).
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4460: 20 20 20 28 76 65 63 74 6f 72 20 28 76 65 63 74 (vector (vect
4470: 6f 72 2d 72 65 66 20 78 20 30 29 20 31 29 29 0a or-ref x 0) 1)).
4480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4490: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 20 2a (vector *
44a0: 29 29 29 0a 20 20 20 20 20 20 28 65 72 72 6f 72 ))). (error
44b0: 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f 69 6e "share-array/in
44c0: 64 65 78 21 20 31 2d 64 20 63 6f 6c 75 6d 6e 20 dex! 1-d column
44d0: 66 61 69 6c 65 64 22 29 29 29 0a 0a 28 70 61 73 failed")))..(pas
44e0: 74 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f 69 t "share-array/i
44f0: 6e 64 65 78 21 20 31 2d 64 20 63 6f 6c 75 6d 6e ndex! 1-d column
4500: 22 29 0a 0a 28 6c 65 74 20 28 28 6d 20 28 61 72 ")..(let ((m (ar
4510: 72 61 79 20 28 73 68 61 70 65 20 31 20 33 20 31 ray (shape 1 3 1
4520: 20 33 29 20 27 61 20 27 62 20 27 63 20 27 64 29 3) 'a 'b 'c 'd)
4530: 29 29 0a 20 20 28 6f 72 20 28 61 72 72 61 79 2d )). (or (array-
4540: 65 71 75 61 6c 3f 20 28 73 68 61 72 65 2d 61 72 equal? (share-ar
4550: 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 ray.
4560: 20 20 20 20 20 20 20 20 20 6d 20 28 73 68 61 70 m (shap
4570: 65 20 31 20 33 20 31 20 33 29 0a 20 20 20 20 20 e 1 3 1 3).
4580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4590: 28 6c 61 6d 62 64 61 20 28 72 20 6b 29 0a 20 20 (lambda (r k).
45a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45b0: 20 20 20 20 20 28 76 61 6c 75 65 73 20 72 20 31 (values r 1
45c0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
45d0: 20 20 20 20 20 20 20 20 28 73 68 61 72 65 2d 61 (share-a
45e0: 72 72 61 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 rray/index!.
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4600: 20 20 20 6d 20 28 73 68 61 70 65 20 31 20 33 20 m (shape 1 3
4610: 31 20 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 1 3).
4620: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
4630: 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 bda (x).
4640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4650: 20 28 76 65 63 74 6f 72 20 28 76 65 63 74 6f 72 (vector (vector
4660: 2d 72 65 66 20 78 20 30 29 20 31 29 29 0a 20 20 -ref x 0) 1)).
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4680: 20 20 20 20 20 28 76 65 63 74 6f 72 20 2a 20 2a (vector * *
4690: 29 29 29 0a 20 20 20 20 20 20 28 65 72 72 6f 72 ))). (error
46a0: 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f 69 6e "share-array/in
46b0: 64 65 78 21 20 32 2d 64 20 63 6f 6c 75 6d 6e 20 dex! 2-d column
46c0: 66 61 69 6c 65 64 22 29 29 29 0a 0a 28 70 61 73 failed")))..(pas
46d0: 74 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f 69 t "share-array/i
46e0: 6e 64 65 78 21 20 32 2d 64 20 63 6f 6c 75 6d 6e ndex! 2-d column
46f0: 22 29 0a 0a 28 6c 65 74 20 28 28 6d 20 28 61 72 ")..(let ((m (ar
4700: 72 61 79 20 28 73 68 61 70 65 20 31 20 33 20 31 ray (shape 1 3 1
4710: 20 33 29 20 27 61 20 27 62 20 27 63 20 27 64 29 3) 'a 'b 'c 'd)
4720: 29 29 0a 20 20 28 6f 72 20 28 61 72 72 61 79 2d )). (or (array-
4730: 65 71 75 61 6c 3f 20 28 73 68 61 72 65 2d 61 72 equal? (share-ar
4740: 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 ray.
4750: 20 20 20 20 20 20 20 20 20 6d 20 28 73 68 61 70 m (shap
4760: 65 20 31 20 33 29 0a 20 20 20 20 20 20 20 20 20 e 1 3).
4770: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
4780: 62 64 61 20 28 6b 29 0a 20 20 20 20 20 20 20 20 bda (k).
4790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
47a0: 76 61 6c 75 65 73 20 31 20 6b 29 29 29 0a 20 20 values 1 k))).
47b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47c0: 20 20 28 73 68 61 72 65 2d 61 72 72 61 79 2f 69 (share-array/i
47d0: 6e 64 65 78 21 0a 20 20 20 20 20 20 20 20 20 20 ndex!.
47e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 20 28 m (
47f0: 73 68 61 70 65 20 31 20 33 29 0a 20 20 20 20 20 shape 1 3).
4800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4810: 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 (lambda (x).
4820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4830: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 20 31 (vector 1
4840: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 (vector-ref x 0
4850: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
4860: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
4870: 6f 72 20 2a 29 29 29 0a 20 20 20 20 20 20 28 65 or *))). (e
4880: 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 72 61 rror "share-arra
4890: 79 2f 69 6e 64 65 78 21 20 31 2d 64 20 72 6f 77 y/index! 1-d row
48a0: 20 66 61 69 6c 65 64 22 29 29 29 0a 0a 28 70 61 failed")))..(pa
48b0: 73 74 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f st "share-array/
48c0: 69 6e 64 65 78 21 20 31 2d 64 20 72 6f 77 22 29 index! 1-d row")
48d0: 0a 0a 28 6c 65 74 20 28 28 6d 20 28 61 72 72 61 ..(let ((m (arra
48e0: 79 20 28 73 68 61 70 65 20 31 20 33 20 31 20 33 y (shape 1 3 1 3
48f0: 29 20 27 61 20 27 62 20 27 63 20 27 64 29 29 29 ) 'a 'b 'c 'd)))
4900: 0a 20 20 28 6f 72 20 28 61 72 72 61 79 2d 65 71 . (or (array-eq
4910: 75 61 6c 3f 20 28 73 68 61 72 65 2d 61 72 72 61 ual? (share-arra
4920: 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y.
4930: 20 20 20 20 20 20 20 6d 20 28 73 68 61 70 65 20 m (shape
4940: 31 20 32 20 31 20 33 29 0a 20 20 20 20 20 20 20 1 2 1 3).
4950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
4960: 61 6d 62 64 61 20 28 72 20 6b 29 0a 20 20 20 20 ambda (r k).
4970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4980: 20 20 20 28 76 61 6c 75 65 73 20 31 20 6b 29 29 (values 1 k))
4990: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
49a0: 20 20 20 20 20 20 28 73 68 61 72 65 2d 61 72 72 (share-arr
49b0: 61 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 ay/index!.
49c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49d0: 20 6d 20 28 73 68 61 70 65 20 31 20 32 20 31 20 m (shape 1 2 1
49e0: 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3).
49f0: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
4a00: 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 20 20 a (x).
4a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4a20: 76 65 63 74 6f 72 20 31 20 28 76 65 63 74 6f 72 vector 1 (vector
4a30: 2d 72 65 66 20 78 20 31 29 29 29 0a 20 20 20 20 -ref x 1))).
4a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a50: 20 20 20 28 76 65 63 74 6f 72 20 2a 20 2a 29 29 (vector * *))
4a60: 29 0a 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 ). (error "
4a70: 73 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 share-array/inde
4a80: 78 21 20 32 2d 64 20 72 6f 77 20 66 61 69 6c 65 x! 2-d row faile
4a90: 64 22 29 29 29 0a 0a 28 70 61 73 74 20 22 73 68 d")))..(past "sh
4aa0: 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 are-array/index!
4ab0: 20 32 2d 64 20 72 6f 77 22 29 0a 0a 28 6c 65 74 2-d row")..(let
4ac0: 20 28 28 6d 20 28 61 72 72 61 79 20 28 73 68 61 ((m (array (sha
4ad0: 70 65 20 31 20 33 20 31 20 33 29 20 27 61 20 27 pe 1 3 1 3) 'a '
4ae0: 62 20 27 63 20 27 64 29 29 29 0a 20 20 28 6f 72 b 'c 'd))). (or
4af0: 20 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 28 (array-equal? (
4b00: 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 share-array.
4b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b20: 20 6d 20 28 73 68 61 70 65 20 31 20 33 29 0a 20 m (shape 1 3).
4b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b40: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 29 0a (lambda (r).
4b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b60: 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 72 (values r
4b70: 20 72 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 r))).
4b80: 20 20 20 20 20 20 20 20 20 20 28 73 68 61 72 65 (share
4b90: 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 0a 20 20 -array/index!.
4ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bb0: 20 20 20 20 20 6d 20 28 73 68 61 70 65 20 31 20 m (shape 1
4bc0: 33 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3).
4bd0: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
4be0: 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 20 20 a (x).
4bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4c00: 76 65 63 74 6f 72 20 28 76 65 63 74 6f 72 2d 72 vector (vector-r
4c10: 65 66 20 78 20 30 29 20 28 76 65 63 74 6f 72 2d ef x 0) (vector-
4c20: 72 65 66 20 78 20 30 29 29 29 0a 20 20 20 20 20 ref x 0))).
4c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c40: 20 20 28 76 65 63 74 6f 72 20 2a 29 29 29 0a 20 (vector *))).
4c50: 20 20 20 20 20 28 65 72 72 6f 72 20 22 73 68 61 (error "sha
4c60: 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 20 re-array/index!
4c70: 64 69 61 67 6f 6e 61 6c 20 66 61 69 6c 65 64 22 diagonal failed"
4c80: 29 29 29 0a 0a 28 70 61 73 74 20 22 73 68 61 72 )))..(past "shar
4c90: 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 20 64 e-array/index! d
4ca0: 69 61 67 6f 6e 61 6c 22 29 0a 0a 28 6c 65 74 20 iagonal")..(let
4cb0: 28 28 6d 20 28 61 72 72 61 79 20 28 73 68 61 70 ((m (array (shap
4cc0: 65 20 31 20 33 20 31 20 33 29 20 27 61 20 27 62 e 1 3 1 3) 'a 'b
4cd0: 20 27 63 20 27 64 29 29 29 0a 20 20 28 6f 72 20 'c 'd))). (or
4ce0: 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 28 73 (array-equal? (s
4cf0: 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 20 hare-array.
4d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d10: 6d 20 28 73 68 61 70 65 29 0a 20 20 20 20 20 20 m (shape).
4d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4d30: 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 lambda ().
4d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d50: 20 28 76 61 6c 75 65 73 20 31 20 32 29 29 29 0a (values 1 2))).
4d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d70: 20 20 20 20 28 73 68 61 72 65 2d 61 72 72 61 79 (share-array
4d80: 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 20 20 /index!.
4d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d m
4da0: 20 28 73 68 61 70 65 29 0a 20 20 20 20 20 20 20 (shape).
4db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4dc0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 (lambda (x).
4dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4de0: 20 20 20 20 20 28 76 65 63 74 6f 72 20 31 20 32 (vector 1 2
4df0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4e00: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
4e10: 72 29 29 29 0a 20 20 20 20 20 20 28 65 72 72 6f r))). (erro
4e20: 72 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f 69 r "share-array/i
4e30: 6e 64 65 78 21 20 30 2d 64 20 63 6f 72 6e 65 72 ndex! 0-d corner
4e40: 20 66 61 69 6c 65 64 22 29 29 29 0a 0a 28 70 61 failed")))..(pa
4e50: 73 74 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f st "share-array/
4e60: 69 6e 64 65 78 21 20 30 2d 64 20 63 6f 72 6e 65 index! 0-d corne
4e70: 72 22 29 0a 0a 28 6c 65 74 20 28 28 6d 20 28 61 r")..(let ((m (a
4e80: 72 72 61 79 20 28 73 68 61 70 65 20 31 20 33 20 rray (shape 1 3
4e90: 31 20 33 29 20 27 61 20 27 62 20 27 63 20 27 64 1 3) 'a 'b 'c 'd
4ea0: 29 29 29 0a 20 20 28 6f 72 20 28 61 72 72 61 79 ))). (or (array
4eb0: 2d 65 71 75 61 6c 3f 20 28 73 68 61 72 65 2d 61 -equal? (share-a
4ec0: 72 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 rray.
4ed0: 20 20 20 20 20 20 20 20 20 20 6d 20 28 73 68 61 m (sha
4ee0: 70 65 20 31 20 32 29 0a 20 20 20 20 20 20 20 20 pe 1 2).
4ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
4f00: 6d 62 64 61 20 28 5f 29 0a 20 20 20 20 20 20 20 mbda (_).
4f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f20: 28 76 61 6c 75 65 73 20 31 20 32 29 29 29 0a 20 (values 1 2))).
4f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f40: 20 20 20 28 73 68 61 72 65 2d 61 72 72 61 79 2f (share-array/
4f50: 69 6e 64 65 78 21 0a 20 20 20 20 20 20 20 20 20 index!.
4f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 20 m
4f70: 28 73 68 61 70 65 20 31 20 32 29 0a 20 20 20 20 (shape 1 2).
4f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f90: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 (lambda (x).
4fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fb0: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 20 (vector
4fc0: 31 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 1 2)).
4fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
4fe0: 63 74 6f 72 20 2a 29 29 29 0a 20 20 20 20 20 20 ctor *))).
4ff0: 28 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 (error "share-ar
5000: 72 61 79 2f 69 6e 64 65 78 21 20 31 2d 64 20 63 ray/index! 1-d c
5010: 6f 72 6e 65 72 20 66 61 69 6c 65 64 22 29 29 29 orner failed")))
5020: 0a 0a 28 70 61 73 74 20 22 73 68 61 72 65 2d 61 ..(past "share-a
5030: 72 72 61 79 2f 69 6e 64 65 78 21 20 31 2d 64 20 rray/index! 1-d
5040: 63 6f 72 6e 65 72 22 29 0a 0a 28 6c 65 74 20 28 corner")..(let (
5050: 28 6d 20 28 61 72 72 61 79 20 28 73 68 61 70 65 (m (array (shape
5060: 20 31 20 33 20 31 20 33 29 20 27 61 20 27 62 20 1 3 1 3) 'a 'b
5070: 27 63 20 27 64 29 29 29 0a 20 20 28 6f 72 20 28 'c 'd))). (or (
5080: 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 28 73 68 array-equal? (sh
5090: 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20 20 20 are-array.
50a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d m
50b0: 20 28 73 68 61 70 65 20 31 20 32 20 31 20 32 29 (shape 1 2 1 2)
50c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
50d0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 (lambda (r
50e0: 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 k).
50f0: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu
5100: 65 73 20 31 20 32 29 29 29 0a 20 20 20 20 20 20 es 1 2))).
5110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
5120: 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 hare-array/index
5130: 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 !.
5140: 20 20 20 20 20 20 20 20 20 6d 20 28 73 68 61 70 m (shap
5150: 65 20 31 20 32 20 31 20 32 29 0a 20 20 20 20 20 e 1 2 1 2).
5160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5170: 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 (lambda (x).
5180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5190: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 20 31 (vector 1
51a0: 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 2)).
51b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec
51c0: 74 6f 72 20 2a 20 2a 29 29 29 0a 20 20 20 20 20 tor * *))).
51d0: 20 28 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 (error "share-a
51e0: 72 72 61 79 2f 69 6e 64 65 78 21 20 32 2d 64 20 rray/index! 2-d
51f0: 63 6f 72 6e 65 72 20 66 61 69 6c 65 64 22 29 29 corner failed"))
5200: 29 0a 0a 28 70 61 73 74 20 22 73 68 61 72 65 2d )..(past "share-
5210: 61 72 72 61 79 2f 69 6e 64 65 78 21 20 32 2d 64 array/index! 2-d
5220: 20 63 6f 72 6e 65 72 22 29 0a 0a 28 6c 65 74 20 corner")..(let
5230: 28 28 6d 20 28 61 72 72 61 79 20 28 73 68 61 70 ((m (array (shap
5240: 65 20 31 20 33 20 31 20 33 29 20 27 61 20 27 62 e 1 3 1 3) 'a 'b
5250: 20 27 63 20 27 64 29 29 29 0a 20 20 28 6f 72 20 'c 'd))). (or
5260: 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 28 73 (array-equal? (s
5270: 68 61 72 65 2d 61 72 72 61 79 2f 70 72 65 66 69 hare-array/prefi
5280: 78 20 6d 20 31 29 0a 20 20 20 20 20 20 20 20 20 x m 1).
5290: 20 20 20 20 20 20 20 20 20 20 20 28 73 68 61 72 (shar
52a0: 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 0a 20 e-array/index!.
52b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52c0: 20 20 20 20 6d 20 28 73 68 61 70 65 20 31 20 33 m (shape 1 3
52d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
52e0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
52f0: 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x).
5300: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
5310: 72 20 31 20 28 76 65 63 74 6f 72 2d 72 65 66 20 r 1 (vector-ref
5320: 78 20 30 29 29 29 0a 20 20 20 20 20 20 20 20 20 x 0))).
5330: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec
5340: 74 6f 72 20 2a 29 29 29 0a 20 20 20 20 20 20 28 tor *))). (
5350: 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 72 error "share-arr
5360: 61 79 2f 69 6e 64 65 78 21 20 77 69 74 68 20 70 ay/index! with p
5370: 72 65 66 69 78 20 31 20 66 61 69 6c 65 64 22 29 refix 1 failed")
5380: 29 29 0a 0a 28 70 61 73 74 20 22 73 68 61 72 65 ))..(past "share
5390: 2d 61 72 72 61 79 2f 7b 70 72 65 66 69 78 2c 69 -array/{prefix,i
53a0: 6e 64 65 78 21 7d 20 31 22 29 0a 0a 28 6c 65 74 ndex!} 1")..(let
53b0: 20 28 28 6d 20 28 61 72 72 61 79 20 28 73 68 61 ((m (array (sha
53c0: 70 65 20 31 20 33 20 31 20 33 29 20 27 61 20 27 pe 1 3 1 3) 'a '
53d0: 62 20 27 63 20 27 64 29 29 29 0a 20 20 28 6f 72 b 'c 'd))). (or
53e0: 20 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 28 (array-equal? (
53f0: 73 68 61 72 65 2d 61 72 72 61 79 2f 70 72 65 66 share-array/pref
5400: 69 78 20 6d 20 28 76 65 63 74 6f 72 20 31 29 29 ix m (vector 1))
5410: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5420: 20 20 20 20 20 28 73 68 61 72 65 2d 61 72 72 61 (share-arra
5430: 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 20 y/index!.
5440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 20 m
5450: 28 73 68 61 70 65 20 31 20 33 29 0a 20 20 20 20 (shape 1 3).
5460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5470: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 (lambda (x).
5480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5490: 20 20 20 20 28 76 65 63 74 6f 72 20 31 20 28 76 (vector 1 (v
54a0: 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 29 29 ector-ref x 0)))
54b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
54c0: 20 20 20 20 20 20 28 76 65 63 74 6f 72 20 2a 29 (vector *)
54d0: 29 29 0a 20 20 20 20 20 20 28 65 72 72 6f 72 20 )). (error
54e0: 22 73 68 61 72 65 2d 61 72 72 61 79 2f 70 72 65 "share-array/pre
54f0: 66 69 78 20 77 69 74 68 20 76 65 63 74 6f 72 20 fix with vector
5500: 66 61 69 6c 65 64 22 29 29 29 0a 0a 28 70 61 73 failed")))..(pas
5510: 74 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f 70 t "share-array/p
5520: 72 65 66 69 78 20 77 69 74 68 20 76 65 63 74 6f refix with vecto
5530: 72 22 29 0a 0a 28 6c 65 74 20 28 28 6d 20 28 61 r")..(let ((m (a
5540: 72 72 61 79 20 28 73 68 61 70 65 20 31 20 33 20 rray (shape 1 3
5550: 31 20 33 29 20 27 61 20 27 62 20 27 63 20 27 64 1 3) 'a 'b 'c 'd
5560: 29 29 29 0a 20 20 28 6f 72 20 28 61 72 72 61 79 ))). (or (array
5570: 2d 65 71 75 61 6c 3f 20 28 73 68 61 72 65 2d 61 -equal? (share-a
5580: 72 72 61 79 2f 70 72 65 66 69 78 20 6d 20 32 29 rray/prefix m 2)
5590: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
55a0: 20 20 20 20 20 28 73 68 61 72 65 2d 61 72 72 61 (share-arra
55b0: 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 20 y/index!.
55c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 20 m
55d0: 28 73 68 61 70 65 20 31 20 33 29 0a 20 20 20 20 (shape 1 3).
55e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55f0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 (lambda (x).
5600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5610: 20 20 20 20 28 76 65 63 74 6f 72 20 32 20 28 76 (vector 2 (v
5620: 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 29 29 ector-ref x 0)))
5630: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5640: 20 20 20 20 20 20 28 76 65 63 74 6f 72 20 2a 29 (vector *)
5650: 29 29 0a 20 20 20 20 20 20 28 65 72 72 6f 72 20 )). (error
5660: 22 73 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 "share-array/ind
5670: 65 78 21 20 77 69 74 68 20 70 72 65 66 69 78 20 ex! with prefix
5680: 32 20 66 61 69 6c 65 64 22 29 29 29 0a 0a 28 70 2 failed")))..(p
5690: 61 73 74 20 22 73 68 61 72 65 2d 61 72 72 61 79 ast "share-array
56a0: 2f 7b 70 72 65 66 69 78 2c 69 6e 64 65 78 21 7d /{prefix,index!}
56b0: 20 32 22 29 0a 0a 28 6c 65 74 20 28 28 6d 20 28 2")..(let ((m (
56c0: 61 72 72 61 79 20 28 73 68 61 70 65 20 31 20 33 array (shape 1 3
56d0: 20 31 20 33 29 20 27 61 20 27 62 20 27 63 20 27 1 3) 'a 'b 'c '
56e0: 64 29 29 29 0a 20 20 28 6f 72 20 28 61 72 72 61 d))). (or (arra
56f0: 79 2d 65 71 75 61 6c 3f 20 28 73 68 61 72 65 2d y-equal? (share-
5700: 61 72 72 61 79 2f 70 72 65 66 69 78 20 6d 20 28 array/prefix m (
5710: 61 72 72 61 79 20 28 73 68 61 70 65 20 30 20 31 array (shape 0 1
5720: 29 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) 2)).
5730: 20 20 20 20 20 20 20 20 20 20 28 73 68 61 72 65 (share
5740: 2d 61 72 72 61 79 2f 69 6e 64 65 78 21 0a 20 20 -array/index!.
5750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5760: 20 20 20 6d 20 28 73 68 61 70 65 20 31 20 33 29 m (shape 1 3)
5770: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5780: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 (lambda (x
5790: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
57a0: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
57b0: 20 32 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 2 (vector-ref x
57c0: 20 30 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 0))).
57d0: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
57e0: 6f 72 20 2a 29 29 29 0a 20 20 20 20 20 20 28 65 or *))). (e
57f0: 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 72 61 rror "share-arra
5800: 79 2f 70 72 65 66 69 78 20 77 69 74 68 20 61 72 y/prefix with ar
5810: 72 61 79 20 66 61 69 6c 65 64 22 29 29 29 0a 0a ray failed")))..
5820: 28 70 61 73 74 20 22 73 68 61 72 65 2d 61 72 72 (past "share-arr
5830: 61 79 2f 70 72 65 66 69 78 20 77 69 74 68 20 61 ay/prefix with a
5840: 72 72 61 79 22 29 0a 0a 28 6c 65 74 20 28 28 6d rray")..(let ((m
5850: 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 31 (array (shape 1
5860: 20 33 20 31 20 33 29 20 27 61 20 27 62 20 27 63 3 1 3) 'a 'b 'c
5870: 20 27 64 29 29 29 0a 20 20 28 6f 72 20 28 61 72 'd))). (or (ar
5880: 72 61 79 2d 65 71 75 61 6c 3f 20 28 73 68 61 72 ray-equal? (shar
5890: 65 2d 61 72 72 61 79 2f 70 72 65 66 69 78 20 6d e-array/prefix m
58a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
58b0: 20 20 20 20 20 20 28 73 68 61 72 65 2d 61 72 72 (share-arr
58c0: 61 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 ay/index!.
58d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d m
58e0: 20 28 73 68 61 70 65 20 31 20 33 20 31 20 33 29 (shape 1 3 1 3)
58f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5900: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 (lambda (x
5910: 29 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) x).
5920: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
5930: 72 20 2a 20 2a 29 29 29 0a 20 20 20 20 20 20 28 r * *))). (
5940: 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 72 error "share-arr
5950: 61 79 2f 69 6e 64 65 78 21 20 77 69 74 68 20 65 ay/index! with e
5960: 6d 70 74 79 20 70 72 65 66 69 78 20 66 61 69 6c mpty prefix fail
5970: 65 64 22 29 29 29 0a 0a 28 70 61 73 74 20 22 73 ed")))..(past "s
5980: 68 61 72 65 2d 61 72 72 61 79 2f 7b 70 72 65 66 hare-array/{pref
5990: 69 78 2c 69 6e 64 65 78 21 7d 20 65 22 29 0a 0a ix,index!} e")..
59a0: 28 6c 65 74 20 28 28 6d 20 28 61 72 72 61 79 20 (let ((m (array
59b0: 28 73 68 61 70 65 20 31 20 33 20 31 20 33 29 20 (shape 1 3 1 3)
59c0: 27 61 20 27 62 20 27 63 20 27 64 29 29 29 0a 20 'a 'b 'c 'd))).
59d0: 20 28 6f 72 20 28 61 72 72 61 79 2d 65 71 75 61 (or (array-equa
59e0: 6c 3f 20 28 73 68 61 72 65 2d 61 72 72 61 79 2f l? (share-array/
59f0: 70 72 65 66 69 78 20 6d 20 31 20 32 29 0a 20 20 prefix m 1 2).
5a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a10: 20 20 28 73 68 61 72 65 2d 61 72 72 61 79 2f 69 (share-array/i
5a20: 6e 64 65 78 21 0a 20 20 20 20 20 20 20 20 20 20 ndex!.
5a30: 20 20 20 20 20 20 20 20 20 20 20 6d 20 28 73 68 m (sh
5a40: 61 70 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 ape).
5a50: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
5a60: 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 20 20 a (x).
5a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
5a80: 63 74 6f 72 20 31 20 32 29 29 0a 20 20 20 20 20 ctor 1 2)).
5a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5aa0: 28 76 65 63 74 6f 72 29 29 29 0a 20 20 20 20 20 (vector))).
5ab0: 20 28 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 (error "share-a
5ac0: 72 72 61 79 2f 69 6e 64 65 78 21 20 77 69 74 68 rray/index! with
5ad0: 20 70 72 65 66 69 78 20 31 20 32 20 66 61 69 6c prefix 1 2 fail
5ae0: 65 64 22 29 29 29 0a 0a 28 70 61 73 74 20 22 73 ed")))..(past "s
5af0: 68 61 72 65 2d 61 72 72 61 79 2f 7b 70 72 65 66 hare-array/{pref
5b00: 69 78 2c 69 6e 64 65 78 21 7d 20 31 20 32 22 29 ix,index!} 1 2")
5b10: 0a 0a 3b 3b 3b 20 55 68 20 6f 68 2e 0a 0a 28 6c ..;;; Uh oh...(l
5b20: 65 74 2a 20 28 28 68 61 70 65 20 28 74 61 62 75 et* ((hape (tabu
5b30: 6c 61 74 65 2d 61 72 72 61 79 0a 20 20 20 20 20 late-array.
5b40: 20 20 20 20 20 20 20 20 20 28 73 68 61 70 65 20 (shape
5b50: 30 20 35 37 20 30 20 32 29 0a 20 20 20 20 20 20 0 57 0 2).
5b60: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
5b70: 28 72 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 (r k).
5b80: 20 20 20 20 20 20 28 63 61 73 65 20 6b 0a 20 20 (case k.
5b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ba0: 28 28 30 29 20 72 29 0a 20 20 20 20 20 20 20 20 ((0) r).
5bb0: 20 20 20 20 20 20 20 20 20 20 28 28 31 29 20 28 ((1) (
5bc0: 63 61 73 65 20 72 0a 20 20 20 20 20 20 20 20 20 case r.
5bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5be0: 28 28 30 29 20 20 28 2b 20 72 20 32 29 29 0a 20 ((0) (+ r 2)).
5bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c00: 20 20 20 20 20 20 20 20 28 28 35 36 29 20 28 2b ((56) (+
5c10: 20 72 20 34 29 29 0a 20 20 20 20 20 20 20 20 20 r 4)).
5c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c30: 28 65 6c 73 65 20 28 2b 20 72 20 31 29 29 29 29 (else (+ r 1))))
5c40: 29 29 29 29 0a 20 20 20 20 20 20 20 28 74 61 70 )))). (tap
5c50: 65 20 28 74 61 62 75 6c 61 74 65 2d 61 72 72 61 e (tabulate-arra
5c60: 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y.
5c70: 28 73 68 61 70 65 20 30 20 33 34 20 30 20 32 29 (shape 0 34 0 2)
5c80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
5c90: 6c 61 6d 62 64 61 20 28 72 20 6b 29 0a 20 20 20 lambda (r k).
5ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 (ca
5cb0: 73 65 20 6b 0a 20 20 20 20 20 20 20 20 20 20 20 se k.
5cc0: 20 20 20 20 20 20 20 28 28 30 29 20 28 2b 20 72 ((0) (+ r
5cd0: 20 32 33 29 29 0a 20 20 20 20 20 20 20 20 20 20 23)).
5ce0: 20 20 20 20 20 20 20 20 28 28 31 29 20 28 63 61 ((1) (ca
5cf0: 73 65 20 72 0a 20 20 20 20 20 20 20 20 20 20 20 se r.
5d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
5d10: 33 33 29 20 28 2b 20 72 20 32 37 29 29 0a 20 20 33) (+ r 27)).
5d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d30: 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 2b 20 (else (+
5d40: 72 20 32 34 29 29 29 29 29 29 29 29 0a 20 20 20 r 24)))))))).
5d50: 20 20 20 20 28 6c 6f 6e 67 20 28 6d 61 6b 65 2d (long (make-
5d60: 76 65 63 74 6f 72 20 35 37 20 2a 29 29 0a 20 20 vector 57 *)).
5d70: 20 20 20 20 20 28 73 68 6f 74 20 28 6d 61 6b 65 (shot (make
5d80: 2d 76 65 63 74 6f 72 20 33 34 20 2a 29 29 0a 20 -vector 34 *)).
5d90: 20 20 20 20 20 20 28 68 75 67 65 20 28 74 61 62 (huge (tab
5da0: 75 6c 61 74 65 2d 61 72 72 61 79 21 0a 20 20 20 ulate-array!.
5db0: 20 20 20 20 20 20 20 20 20 20 20 68 61 70 65 0a hape.
5dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
5dd0: 61 6d 62 64 61 20 28 69 78 29 20 28 76 65 63 74 ambda (ix) (vect
5de0: 6f 72 2d 72 65 66 20 27 23 28 61 20 62 29 20 28 or-ref '#(a b) (
5df0: 76 65 63 74 6f 72 2d 72 65 66 20 69 78 20 30 29 vector-ref ix 0)
5e00: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5e10: 20 6c 6f 6e 67 29 29 0a 20 20 20 20 20 20 20 28 long)). (
5e20: 74 69 6e 79 30 20 28 73 68 61 72 65 2d 61 72 72 tiny0 (share-arr
5e30: 61 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 ay/index!.
5e40: 20 20 20 20 20 20 20 20 20 68 75 67 65 0a 20 20 huge.
5e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61 70 tap
5e60: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
5e70: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
5e80: 20 20 20 20 20 20 20 20 20 28 64 6f 20 28 28 6b (do ((k
5e90: 20 30 20 28 2b 20 6b 20 31 29 29 29 0a 20 20 20 0 (+ k 1))).
5ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5eb0: 28 28 3d 20 6b 20 32 33 29 29 0a 20 20 20 20 20 ((= k 23)).
5ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
5ed0: 65 63 74 6f 72 2d 73 65 74 21 20 6c 6f 6e 67 20 ector-set! long
5ee0: 6b 20 6b 29 29 0a 20 20 20 20 20 20 20 20 20 20 k k)).
5ef0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
5f00: 69 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ix).
5f10: 20 20 20 20 20 20 20 28 64 6f 20 28 28 6b 20 32 (do ((k 2
5f20: 33 20 28 2b 20 6b 20 31 29 29 29 0a 20 20 20 20 3 (+ k 1))).
5f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f40: 20 28 28 3d 20 6b 20 35 37 29 29 0a 20 20 20 20 ((= k 57)).
5f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f60: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6c 6f (vector-set! lo
5f70: 6e 67 20 6b 20 28 76 65 63 74 6f 72 2d 72 65 66 ng k (vector-ref
5f80: 20 69 78 20 28 2d 20 6b 20 32 33 29 29 29 29 0a ix (- k 23)))).
5f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fa0: 20 20 20 6c 6f 6e 67 29 29 0a 20 20 20 20 20 20 long)).
5fb0: 20 20 20 20 20 20 20 20 20 73 68 6f 74 29 29 0a shot)).
5fc0: 20 20 20 20 20 20 20 28 74 69 6e 79 31 20 28 73 (tiny1 (s
5fd0: 68 61 72 65 2d 61 72 72 61 79 2f 69 6e 64 65 78 hare-array/index
5fe0: 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 !.
5ff0: 20 68 75 67 65 0a 20 20 20 20 20 20 20 20 20 20 huge.
6000: 20 20 20 20 20 74 61 70 65 0a 20 20 20 20 20 20 tape.
6010: 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a (begin.
6020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6030: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6c 6f (vector-set! lo
6040: 6e 67 20 30 20 31 29 0a 20 20 20 20 20 20 20 20 ng 0 1).
6050: 20 20 20 20 20 20 20 20 20 28 64 6f 20 28 28 6b (do ((k
6060: 20 31 20 28 2b 20 6b 20 31 29 29 29 0a 20 20 20 1 (+ k 1))).
6070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6080: 28 28 3d 20 6b 20 32 33 29 29 0a 20 20 20 20 20 ((= k 23)).
6090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
60a0: 65 63 74 6f 72 2d 73 65 74 21 20 6c 6f 6e 67 20 ector-set! long
60b0: 6b 20 6b 29 29 0a 20 20 20 20 20 20 20 20 20 20 k k)).
60c0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
60d0: 69 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ix).
60e0: 20 20 20 20 20 20 20 28 64 6f 20 28 28 6b 20 32 (do ((k 2
60f0: 33 20 28 2b 20 6b 20 31 29 29 29 0a 20 20 20 20 3 (+ k 1))).
6100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6110: 20 28 28 3d 20 6b 20 35 37 29 29 0a 20 20 20 20 ((= k 57)).
6120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6130: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6c 6f (vector-set! lo
6140: 6e 67 20 6b 20 28 76 65 63 74 6f 72 2d 72 65 66 ng k (vector-ref
6150: 20 69 78 20 28 2d 20 6b 20 32 33 29 29 29 29 0a ix (- k 23)))).
6160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6170: 20 20 20 6c 6f 6e 67 29 29 0a 20 20 20 20 20 20 long)).
6180: 20 20 20 20 20 20 20 20 20 73 68 6f 74 29 29 29 shot)))
6190: 0a 20 20 28 6f 72 20 28 61 6e 64 20 28 65 71 75 . (or (and (equ
61a0: 61 6c 3f 20 28 61 72 72 61 79 2d 3e 76 65 63 74 al? (array->vect
61b0: 6f 72 20 68 75 67 65 29 20 27 23 28 61 20 61 20 or huge) '#(a a
61c0: 61 20 61 20 62 20 62 20 62 20 62 29 29 0a 20 20 a a b b b b)).
61d0: 20 20 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f (equal?
61e0: 20 28 61 72 72 61 79 2d 3e 76 65 63 74 6f 72 20 (array->vector
61f0: 74 69 6e 79 30 29 20 27 23 28 61 20 61 20 61 20 tiny0) '#(a a a
6200: 61 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 a)). (
6210: 65 71 75 61 6c 3f 20 28 61 72 72 61 79 2d 3e 76 equal? (array->v
6220: 65 63 74 6f 72 20 74 69 6e 79 31 29 20 27 23 28 ector tiny1) '#(
6230: 62 20 62 20 62 20 62 29 29 29 0a 20 20 20 20 20 b b b b))).
6240: 20 28 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 (error "share-a
6250: 72 72 61 79 2f 69 6e 64 65 78 21 20 66 61 69 6c rray/index! fail
6260: 65 64 20 68 75 67 65 20 6f 72 20 74 69 6e 79 20 ed huge or tiny
6270: 63 6f 6e 74 65 6e 74 73 22 29 29 0a 20 20 28 6f contents")). (o
6280: 72 20 28 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 r (array-equal?
6290: 68 75 67 65 0a 20 20 20 20 20 20 20 20 20 20 20 huge.
62a0: 20 20 20 20 20 20 20 20 20 28 73 68 61 72 65 2d (share-
62b0: 61 72 72 61 79 2f 69 6e 64 65 78 21 0a 20 20 20 array/index!.
62c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62d0: 20 20 28 61 72 72 61 79 20 28 73 68 61 70 65 20 (array (shape
62e0: 34 20 36 29 20 27 61 20 27 62 29 0a 20 20 20 20 4 6) 'a 'b).
62f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6300: 20 68 61 70 65 0a 20 20 20 20 20 20 20 20 20 20 hape.
6310: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
6320: 64 61 20 28 69 78 29 0a 20 20 20 20 20 20 20 20 da (ix).
6330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6340: 76 65 63 74 6f 72 2d 72 65 66 20 27 23 28 23 28 vector-ref '#(#(
6350: 34 29 20 23 28 35 29 29 20 28 76 65 63 74 6f 72 4) #(5)) (vector
6360: 2d 72 65 66 20 69 78 20 30 29 29 29 0a 20 20 20 -ref ix 0))).
6370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6380: 20 20 6c 6f 6e 67 29 29 0a 20 20 20 20 20 20 28 long)). (
6390: 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 72 error "share-arr
63a0: 61 79 2f 69 6e 64 65 78 21 20 66 61 69 6c 65 64 ay/index! failed
63b0: 20 68 75 67 65 22 29 29 0a 20 20 28 6f 72 20 28 huge")). (or (
63c0: 61 72 72 61 79 2d 65 71 75 61 6c 3f 20 74 69 6e array-equal? tin
63d0: 79 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 y0.
63e0: 20 20 20 20 20 20 20 28 73 68 61 72 65 2d 61 72 (share-ar
63f0: 72 61 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 ray/index!.
6400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6410: 28 61 72 72 61 79 20 28 73 68 61 70 65 20 36 20 (array (shape 6
6420: 37 29 20 27 61 29 0a 20 20 20 20 20 20 20 20 20 7) 'a).
6430: 20 20 20 20 20 20 20 20 20 20 20 20 74 61 70 65 tape
6440: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6450: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 (lambda (i
6460: 78 29 20 27 23 28 36 29 29 0a 20 20 20 20 20 20 x) '#(6)).
6470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
6480: 68 6f 74 29 29 0a 20 20 20 20 20 20 28 65 72 72 hot)). (err
6490: 6f 72 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f or "share-array/
64a0: 69 6e 64 65 78 21 20 66 61 69 6c 65 64 20 74 69 index! failed ti
64b0: 6e 79 30 22 29 29 0a 20 20 28 6f 72 20 28 61 72 ny0")). (or (ar
64c0: 72 61 79 2d 65 71 75 61 6c 3f 20 74 69 6e 79 31 ray-equal? tiny1
64d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
64e0: 20 20 20 20 20 28 73 68 61 72 65 2d 61 72 72 61 (share-arra
64f0: 79 2f 69 6e 64 65 78 21 0a 20 20 20 20 20 20 20 y/index!.
6500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
6510: 72 72 61 79 20 28 73 68 61 70 65 20 36 20 37 20 rray (shape 6 7
6520: 38 20 39 29 20 27 62 29 0a 20 20 20 20 20 20 20 8 9) 'b).
6530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61 ta
6540: 70 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 pe.
6550: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
6560: 28 69 78 29 20 27 23 28 36 20 38 29 29 0a 20 20 (ix) '#(6 8)).
6570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6580: 20 20 20 73 68 6f 74 29 29 0a 20 20 20 20 20 20 shot)).
6590: 28 65 72 72 6f 72 20 22 73 68 61 72 65 2d 61 72 (error "share-ar
65a0: 72 61 79 2f 69 6e 64 65 78 21 20 66 61 69 6c 65 ray/index! faile
65b0: 64 20 74 69 6e 79 31 22 29 29 29 0a 0a 28 70 61 d tiny1")))..(pa
65c0: 73 74 20 22 73 68 61 72 65 2d 61 72 72 61 79 2f st "share-array/
65d0: 69 6e 64 65 78 21 20 68 75 67 65 20 61 73 20 74 index! huge as t
65e0: 69 6e 79 22 29 0a iny").