Artifact ebb3873855960e9d30da65723880b782fc048138:

• File srfi/s25/array.scm — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 23232)

0000: 3b 3b 3b 20 61 72 72 61 79 0a 3b 3b 3b 20 31 39  ;;; array.;;; 19
0010: 39 37 20 2d 20 32 30 30 31 20 4a 75 73 73 69 20  97 - 2001 Jussi 
0020: 50 69 69 74 75 6c 61 69 6e 65 6e 0a 0a 3b 3b 3b  Piitulainen..;;;
0030: 20 2d 2d 2d 20 49 6e 74 72 6f 20 2d 2d 2d 0a 0a   --- Intro ---..
0040: 3b 3b 3b 20 54 68 69 73 20 69 6e 74 65 72 66 61  ;;; This interfa
0050: 63 65 20 74 6f 20 61 72 72 61 79 73 20 69 73 20  ce to arrays is 
0060: 62 61 73 65 64 20 6f 6e 20 41 6c 61 6e 20 42 61  based on Alan Ba
0070: 77 64 65 6e 27 73 20 61 72 72 61 79 2e 73 63 6d  wden's array.scm
0080: 20 6f 66 0a 3b 3b 3b 20 31 39 39 33 20 28 65 61   of.;;; 1993 (ea
0090: 72 6c 69 65 72 20 76 65 72 73 69 6f 6e 20 69 6e  rlier version in
00a0: 20 74 68 65 20 49 6e 74 65 72 6e 65 74 20 52 65   the Internet Re
00b0: 70 6f 73 69 74 6f 72 79 20 61 6e 64 20 61 6e 6f  pository and ano
00c0: 74 68 65 72 0a 3b 3b 3b 20 76 65 72 73 69 6f 6e  ther.;;; version
00d0: 20 69 6e 20 53 4c 49 42 29 2e 20 54 68 69 73 20   in SLIB). This 
00e0: 69 73 20 61 20 63 6f 6d 70 6c 65 74 65 20 72 65  is a complete re
00f0: 77 72 69 74 65 2c 20 74 6f 20 62 65 20 63 6f 6e  write, to be con
0100: 73 69 73 74 65 6e 74 0a 3b 3b 3b 20 77 69 74 68  sistent.;;; with
0110: 20 74 68 65 20 72 65 73 74 20 6f 66 20 53 63 68   the rest of Sch
0120: 65 6d 65 20 61 6e 64 20 74 6f 20 6d 61 6b 65 20  eme and to make 
0130: 61 72 72 61 79 73 20 69 6e 64 65 70 65 6e 64 65  arrays independe
0140: 6e 74 20 6f 66 20 6c 69 73 74 73 2e 0a 0a 3b 3b  nt of lists...;;
0150: 3b 20 53 6f 6d 65 20 6d 6f 64 69 66 69 63 61 74  ; Some modificat
0160: 69 6f 6e 73 20 61 72 65 20 64 75 65 20 74 6f 20  ions are due to 
0170: 64 69 73 63 75 73 73 69 6f 6e 20 69 6e 20 73 72  discussion in sr
0180: 66 69 2d 32 35 20 6d 61 69 6c 69 6e 67 20 6c 69  fi-25 mailing li
0190: 73 74 2e 0a 0a 3b 3b 3b 20 28 61 72 72 61 79 3f  st...;;; (array?
01a0: 20 6f 62 6a 29 0a 3b 3b 3b 20 28 6d 61 6b 65 2d   obj).;;; (make-
01b0: 61 72 72 61 79 20 73 68 61 70 65 20 5b 6f 62 6a  array shape [obj
01c0: 5d 29 20 20 20 20 20 20 20 20 20 20 20 20 20 63  ])             c
01d0: 68 61 6e 67 65 64 20 61 72 67 75 6d 65 6e 74 73  hanged arguments
01e0: 0a 3b 3b 3b 20 28 73 68 61 70 65 20 62 6f 75 6e  .;;; (shape boun
01f0: 64 20 2e 2e 2e 29 20 20 20 20 20 20 20 20 20 20  d ...)          
0200: 20 20 20 20 20 20 20 20 20 20 6e 65 77 0a 3b 3b            new.;;
0210: 3b 20 28 61 72 72 61 79 20 73 68 61 70 65 20 6f  ; (array shape o
0220: 62 6a 20 2e 2e 2e 29 20 20 20 20 20 20 20 20 20  bj ...)         
0230: 20 20 20 20 20 20 20 6e 65 77 0a 3b 3b 3b 20 28         new.;;; (
0240: 61 72 72 61 79 2d 72 61 6e 6b 20 61 72 72 61 79  array-rank array
0250: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  )               
0260: 20 20 20 20 63 68 61 6e 67 65 64 20 6e 61 6d 65      changed name
0270: 20 62 61 63 6b 0a 3b 3b 3b 20 28 61 72 72 61 79   back.;;; (array
0280: 2d 73 74 61 72 74 20 61 72 72 61 79 20 64 69 6d  -start array dim
0290: 65 6e 73 69 6f 6e 29 20 20 20 20 20 20 20 20 6e  ension)        n
02a0: 65 77 0a 3b 3b 3b 20 28 61 72 72 61 79 2d 65 6e  ew.;;; (array-en
02b0: 64 20 61 72 72 61 79 20 64 69 6d 65 6e 73 69 6f  d array dimensio
02c0: 6e 29 20 20 20 20 20 20 20 20 20 20 6e 65 77 0a  n)          new.
02d0: 3b 3b 3b 20 28 61 72 72 61 79 2d 72 65 66 20 61  ;;; (array-ref a
02e0: 72 72 61 79 20 6b 20 2e 2e 2e 29 0a 3b 3b 3b 20  rray k ...).;;; 
02f0: 28 61 72 72 61 79 2d 72 65 66 20 61 72 72 61 79  (array-ref array
0300: 20 69 6e 64 65 78 29 20 20 20 20 20 20 20 20 20   index)         
0310: 20 20 20 20 20 6e 65 77 20 76 61 72 69 61 6e 74       new variant
0320: 0a 3b 3b 3b 20 28 61 72 72 61 79 2d 73 65 74 21  .;;; (array-set!
0330: 20 61 72 72 61 79 20 6b 20 2e 2e 2e 20 6f 62 6a   array k ... obj
0340: 29 20 20 20 20 20 20 20 20 20 63 68 61 6e 67 65  )         change
0350: 64 20 61 72 67 75 6d 65 6e 74 20 6f 72 64 65 72  d argument order
0360: 0a 3b 3b 3b 20 28 61 72 72 61 79 2d 73 65 74 21  .;;; (array-set!
0370: 20 61 72 72 61 79 20 69 6e 64 65 78 20 6f 62 6a   array index obj
0380: 29 20 20 20 20 20 20 20 20 20 6e 65 77 20 76 61  )         new va
0390: 72 69 61 6e 74 0a 3b 3b 3b 20 28 73 68 61 72 65  riant.;;; (share
03a0: 2d 61 72 72 61 79 20 61 72 72 61 79 20 73 68 61  -array array sha
03b0: 70 65 20 70 72 6f 63 29 20 20 20 20 20 20 20 63  pe proc)       c
03c0: 68 61 6e 67 65 64 20 61 72 67 75 6d 65 6e 74 73  hanged arguments
03d0: 0a 0a 3b 3b 3b 20 41 6c 6c 20 6f 74 68 65 72 20  ..;;; All other 
03e0: 76 61 72 69 61 62 6c 65 73 20 69 6e 20 74 68 69  variables in thi
03f0: 73 20 66 69 6c 65 20 68 61 76 65 20 6e 61 6d 65  s file have name
0400: 73 20 69 6e 20 22 61 72 72 61 79 3a 22 2e 0a 0a  s in "array:"...
0410: 3b 3b 3b 20 53 68 6f 75 6c 64 20 74 68 65 72 65  ;;; Should there
0420: 20 62 65 20 61 20 77 61 79 20 74 6f 20 6d 61 6b   be a way to mak
0430: 65 20 61 72 72 61 79 73 20 77 69 74 68 20 69 6e  e arrays with in
0440: 69 74 69 61 6c 20 76 61 6c 75 65 73 20 6d 61 70  itial values map
0450: 70 65 64 0a 3b 3b 3b 20 66 72 6f 6d 20 69 6e 64  ped.;;; from ind
0460: 69 63 65 73 3f 20 53 75 72 65 2e 20 54 68 65 20  ices? Sure. The 
0470: 63 75 72 72 65 6e 74 20 22 69 6e 69 74 69 61 6c  current "initial
0480: 20 6f 62 6a 65 63 74 22 20 69 73 20 6c 61 6d 65   object" is lame
0490: 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 52 65 6d 6f 76 65  ..;;;.;;; Remove
04a0: 64 20 28 61 72 72 61 79 2d 73 68 61 70 65 20 61  d (array-shape a
04b0: 72 72 61 79 29 20 66 72 6f 6d 20 68 65 72 65 2e  rray) from here.
04c0: 20 54 68 65 72 65 20 69 73 20 61 20 6e 65 77 20   There is a new 
04d0: 76 65 72 73 69 6f 6e 0a 3b 3b 3b 20 69 6e 20 61  version.;;; in a
04e0: 72 6c 69 62 20 74 68 6f 75 67 68 2e 0a 0a 3b 3b  rlib though...;;
04f0: 3b 20 2d 2d 2d 20 52 65 70 72 65 73 65 6e 74 61  ; --- Representa
0500: 74 69 6f 6e 20 74 79 70 65 20 64 65 70 65 6e 64  tion type depend
0510: 65 6e 63 69 65 73 20 2d 2d 2d 0a 0a 3b 3b 3b 20  encies ---..;;; 
0520: 54 68 65 20 6d 61 70 70 69 6e 67 20 66 72 6f 6d  The mapping from
0530: 20 61 72 72 61 79 20 69 6e 64 69 63 65 73 20 74   array indices t
0540: 6f 20 74 68 65 20 69 6e 64 65 78 20 74 6f 20 74  o the index to t
0550: 68 65 20 75 6e 64 65 72 6c 79 69 6e 67 20 76 65  he underlying ve
0560: 63 74 6f 72 0a 3b 3b 3b 20 69 73 20 77 68 61 74  ctor.;;; is what
0570: 65 76 65 72 20 61 72 72 61 79 3a 6f 70 74 69 6d  ever array:optim
0580: 69 7a 65 20 72 65 74 75 72 6e 73 2e 20 54 68 65  ize returns. The
0590: 20 66 69 6c 65 20 22 6f 70 74 22 20 70 72 6f 76   file "opt" prov
05a0: 69 64 65 73 20 74 68 72 65 65 0a 3b 3b 3b 20 72  ides three.;;; r
05b0: 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 73 3a 0a  epresentations:.
05c0: 3b 3b 3b 20 0a 3b 3b 3b 20 6d 62 64 61 29 20 6d  ;;; .;;; mbda) m
05d0: 61 70 70 69 6e 67 20 69 73 20 61 20 70 72 6f 63  apping is a proc
05e0: 65 64 75 72 65 20 74 68 61 74 20 61 6c 6c 6f 77  edure that allow
05f0: 73 20 61 6e 20 6f 70 74 69 6f 6e 61 6c 20 61 72  s an optional ar
0600: 67 75 6d 65 6e 74 0a 3b 3b 3b 20 74 74 65 72 29  gument.;;; tter)
0610: 20 6d 61 70 70 69 6e 67 20 69 73 20 74 77 6f 20   mapping is two 
0620: 70 72 6f 63 65 64 75 72 65 73 20 74 68 61 74 20  procedures that 
0630: 74 61 6b 65 73 20 65 78 61 63 74 6c 79 20 74 68  takes exactly th
0640: 65 20 69 6e 64 69 63 65 73 0a 3b 3b 3b 20 63 74  e indices.;;; ct
0650: 6f 72 29 20 6d 61 70 70 69 6e 67 20 69 73 20 61  or) mapping is a
0660: 20 76 65 63 74 6f 72 20 6f 66 20 61 20 63 6f 6e   vector of a con
0670: 73 74 61 6e 74 20 74 65 72 6d 20 61 6e 64 20 63  stant term and c
0680: 6f 65 66 66 69 63 69 65 6e 74 73 0a 3b 3b 3b 0a  oefficients.;;;.
0690: 3b 3b 3b 20 43 68 6f 6f 73 65 20 6f 6e 65 20 69  ;;; Choose one i
06a0: 6e 20 22 6f 70 74 22 20 74 6f 20 6d 61 6b 65 20  n "opt" to make 
06b0: 74 68 65 20 6f 70 74 69 6d 69 7a 65 72 2e 20 54  the optimizer. T
06c0: 68 65 6e 20 63 68 6f 6f 73 65 20 74 68 65 20 6d  hen choose the m
06d0: 61 74 63 68 69 6e 67 0a 3b 3b 3b 20 69 6d 70 6c  atching.;;; impl
06e0: 65 6d 65 6e 74 61 74 69 6f 6e 20 6f 66 20 61 72  ementation of ar
06f0: 72 61 79 2d 72 65 66 20 61 6e 64 20 61 72 72 61  ray-ref and arra
0700: 79 2d 73 65 74 21 2e 0a 3b 3b 3b 0a 3b 3b 3b 20  y-set!..;;;.;;; 
0710: 54 68 65 73 65 20 73 68 6f 75 6c 64 20 62 65 20  These should be 
0720: 6d 61 64 65 20 6d 61 63 72 6f 73 20 74 6f 20 69  made macros to i
0730: 6e 6c 69 6e 65 20 74 68 65 6d 2e 20 4f 72 20 68  nline them. Or h
0740: 61 76 65 20 61 20 67 6f 6f 64 20 63 6f 6d 70 69  ave a good compi
0750: 6c 65 72 0a 3b 3b 3b 20 61 6e 64 20 70 6c 61 6e  ler.;;; and plan
0760: 74 20 74 68 65 20 70 61 63 6b 61 67 65 20 61 73  t the package as
0770: 20 61 20 6d 6f 64 75 6c 65 2e 0a 0a 3b 3b 3b 20   a module...;;; 
0780: 31 2e 20 50 69 63 6b 20 61 6e 20 6f 70 74 69 6d  1. Pick an optim
0790: 69 7a 65 72 2e 0a 3b 3b 3b 20 32 2e 20 50 69 63  izer..;;; 2. Pic
07a0: 6b 20 6d 61 74 63 68 69 6e 67 20 69 6e 64 65 78  k matching index
07b0: 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 2e   representation.
07c0: 0a 3b 3b 3b 20 33 2e 20 50 69 63 6b 20 61 20 72  .;;; 3. Pick a r
07d0: 65 63 6f 72 64 20 69 6d 70 6c 65 6d 65 6e 74 61  ecord implementa
07e0: 74 69 6f 6e 3b 20 61 73 2d 70 72 6f 63 65 64 75  tion; as-procedu
07f0: 72 65 20 69 73 20 67 65 6e 65 72 69 63 3b 20 73  re is generic; s
0800: 79 6e 74 61 78 20 69 6e 6c 69 6e 65 73 2e 0a 3b  yntax inlines..;
0810: 3b 3b 20 33 2e 20 54 68 69 73 20 66 69 6c 65 20  ;; 3. This file 
0820: 69 73 20 6f 74 68 65 72 77 69 73 65 20 70 6f 72  is otherwise por
0830: 74 61 62 6c 65 2e 0a 0a 3b 3b 3b 20 2d 2d 2d 20  table...;;; --- 
0840: 50 6f 72 74 61 62 6c 65 20 52 35 52 53 20 28 52  Portable R5RS (R
0850: 34 52 53 20 61 6e 64 20 6d 75 6c 74 69 70 6c 65  4RS and multiple
0860: 20 76 61 6c 75 65 73 29 20 2d 2d 2d 0a 0a 3b 3b   values) ---..;;
0870: 3b 20 28 61 72 72 61 79 3f 20 6f 62 6a 29 0a 3b  ; (array? obj).;
0880: 3b 3b 20 72 65 74 75 72 6e 73 20 23 74 20 69 66  ;; returns #t if
0890: 20 60 6f 62 6a 27 20 69 73 20 61 6e 20 61 72 72   `obj' is an arr
08a0: 61 79 20 61 6e 64 20 23 74 20 6f 72 20 23 66 20  ay and #t or #f 
08b0: 6f 74 68 65 72 77 69 73 65 2e 0a 0a 28 64 65 66  otherwise...(def
08c0: 69 6e 65 20 28 61 72 72 61 79 3f 20 6f 62 6a 29  ine (array? obj)
08d0: 0a 20 20 20 28 61 72 72 61 79 3a 61 72 72 61 79  .   (array:array
08e0: 3f 20 6f 62 6a 29 29 0a 0a 3b 3b 3b 20 28 6d 61  ? obj))..;;; (ma
08f0: 6b 65 2d 61 72 72 61 79 20 73 68 61 70 65 29 0a  ke-array shape).
0900: 3b 3b 3b 20 28 6d 61 6b 65 2d 61 72 72 61 79 20  ;;; (make-array 
0910: 73 68 61 70 65 20 6f 62 6a 29 0a 3b 3b 3b 20 6d  shape obj).;;; m
0920: 61 6b 65 73 20 61 72 72 61 79 20 6f 66 20 60 73  akes array of `s
0930: 68 61 70 65 27 20 77 69 74 68 20 65 61 63 68 20  hape' with each 
0940: 63 65 6c 6c 20 63 6f 6e 74 61 69 6e 69 6e 67 20  cell containing 
0950: 60 6f 62 6a 27 20 69 6e 69 74 69 61 6c 6c 79 2e  `obj' initially.
0960: 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d  ..(define (make-
0970: 61 72 72 61 79 20 73 68 61 70 65 20 2e 20 72 65  array shape . re
0980: 73 74 29 0a 20 20 28 6f 72 20 28 61 72 72 61 79  st).  (or (array
0990: 3a 67 6f 6f 64 2d 73 68 61 70 65 3f 20 73 68 61  :good-shape? sha
09a0: 70 65 29 0a 20 20 20 20 20 20 28 65 72 72 6f 72  pe).      (error
09b0: 20 22 6d 61 6b 65 2d 61 72 72 61 79 3a 20 73 68   "make-array: sh
09c0: 61 70 65 20 69 73 20 6e 6f 74 20 61 20 73 68 61  ape is not a sha
09d0: 70 65 22 29 29 0a 20 20 28 61 70 70 6c 79 20 61  pe")).  (apply a
09e0: 72 72 61 79 3a 6d 61 6b 65 2d 61 72 72 61 79 20  rray:make-array 
09f0: 73 68 61 70 65 20 72 65 73 74 29 29 0a 0a 28 64  shape rest))..(d
0a00: 65 66 69 6e 65 20 28 61 72 72 61 79 3a 6d 61 6b  efine (array:mak
0a10: 65 2d 61 72 72 61 79 20 73 68 61 70 65 20 2e 20  e-array shape . 
0a20: 72 65 73 74 29 0a 20 20 28 6c 65 74 20 28 28 73  rest).  (let ((s
0a30: 69 7a 65 20 28 61 72 72 61 79 3a 73 69 7a 65 20  ize (array:size 
0a40: 73 68 61 70 65 29 29 29 0a 20 20 20 20 28 61 72  shape))).    (ar
0a50: 72 61 79 3a 6d 61 6b 65 0a 20 20 20 20 20 28 69  ray:make.     (i
0a60: 66 20 28 70 61 69 72 3f 20 72 65 73 74 29 0a 20  f (pair? rest). 
0a70: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 28          (apply (
0a80: 6c 61 6d 62 64 61 20 28 6f 29 20 28 6d 61 6b 65  lambda (o) (make
0a90: 2d 76 65 63 74 6f 72 20 73 69 7a 65 20 6f 29 29  -vector size o))
0aa0: 20 72 65 73 74 29 0a 20 20 20 20 20 20 20 20 20   rest).         
0ab0: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 73 69 7a  (make-vector siz
0ac0: 65 29 29 0a 20 20 20 20 20 28 69 66 20 28 3d 20  e)).     (if (= 
0ad0: 73 69 7a 65 20 30 29 0a 20 20 20 20 20 20 20 20  size 0).        
0ae0: 20 28 61 72 72 61 79 3a 6f 70 74 69 6d 69 7a 65   (array:optimize
0af0: 2d 65 6d 70 74 79 0a 20 20 20 20 20 20 20 20 20  -empty.         
0b00: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28 61 72   (vector-ref (ar
0b10: 72 61 79 3a 73 68 61 70 65 20 73 68 61 70 65 29  ray:shape shape)
0b20: 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 61   1)).         (a
0b30: 72 72 61 79 3a 6f 70 74 69 6d 69 7a 65 0a 20 20  rray:optimize.  
0b40: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 6d          (array:m
0b50: 61 6b 65 2d 69 6e 64 65 78 20 73 68 61 70 65 29  ake-index shape)
0b60: 0a 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74  .          (vect
0b70: 6f 72 2d 72 65 66 20 28 61 72 72 61 79 3a 73 68  or-ref (array:sh
0b80: 61 70 65 20 73 68 61 70 65 29 20 31 29 29 29 0a  ape shape) 1))).
0b90: 20 20 20 20 20 28 61 72 72 61 79 3a 73 68 61 70       (array:shap
0ba0: 65 2d 3e 76 65 63 74 6f 72 20 73 68 61 70 65 29  e->vector shape)
0bb0: 29 29 29 0a 0a 3b 3b 3b 20 28 73 68 61 70 65 20  )))..;;; (shape 
0bc0: 62 6f 75 6e 64 20 2e 2e 2e 29 0a 3b 3b 3b 20 6d  bound ...).;;; m
0bd0: 61 6b 65 73 20 61 20 73 68 61 70 65 2e 20 42 6f  akes a shape. Bo
0be0: 75 6e 64 73 20 6d 75 73 74 20 62 65 20 61 6e 20  unds must be an 
0bf0: 65 76 65 6e 20 6e 75 6d 62 65 72 20 6f 66 20 65  even number of e
0c00: 78 61 63 74 2c 20 70 61 69 72 77 69 73 65 0a 3b  xact, pairwise.;
0c10: 3b 3b 20 6e 6f 6e 2d 64 65 63 72 65 61 73 69 6e  ;; non-decreasin
0c20: 67 20 69 6e 74 65 67 65 72 73 2e 20 4e 6f 74 65  g integers. Note
0c30: 20 74 68 61 74 20 61 6e 79 20 73 75 63 68 20 61   that any such a
0c40: 72 72 61 79 20 63 61 6e 20 62 65 20 61 20 73 68  rray can be a sh
0c50: 61 70 65 2e 0a 0a 28 64 65 66 69 6e 65 20 28 73  ape...(define (s
0c60: 68 61 70 65 20 2e 20 62 6f 75 6e 64 73 29 0a 20  hape . bounds). 
0c70: 20 28 6c 65 74 20 28 28 76 20 28 6c 69 73 74 2d   (let ((v (list-
0c80: 3e 76 65 63 74 6f 72 20 62 6f 75 6e 64 73 29 29  >vector bounds))
0c90: 29 0a 20 20 20 20 28 6f 72 20 28 65 76 65 6e 3f  ).    (or (even?
0ca0: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20   (vector-length 
0cb0: 76 29 29 0a 20 20 20 20 20 20 20 20 28 65 72 72  v)).        (err
0cc0: 6f 72 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e  or (string-appen
0cd0: 64 20 22 73 68 61 70 65 3a 20 75 6e 65 76 65 6e  d "shape: uneven
0ce0: 20 6e 75 6d 62 65 72 20 6f 66 20 62 6f 75 6e 64   number of bound
0cf0: 73 3a 20 22 0a 20 20 20 20 20 20 20 20 20 20 20  s: ".           
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0d10: 20 20 20 28 61 72 72 61 79 3a 6c 69 73 74 2d 3e     (array:list->
0d20: 73 74 72 69 6e 67 20 62 6f 75 6e 64 73 29 29 29  string bounds)))
0d30: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 73 68 70  ).    (let ((shp
0d40: 20 28 61 72 72 61 79 3a 6d 61 6b 65 0a 20 20 20   (array:make.   
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 0a 20               v. 
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
0d70: 69 66 20 28 70 61 69 72 3f 20 62 6f 75 6e 64 73  if (pair? bounds
0d80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
0d90: 20 20 20 20 20 20 28 61 72 72 61 79 3a 73 68 61        (array:sha
0da0: 70 65 2d 69 6e 64 65 78 29 0a 20 20 20 20 20 20  pe-index).      
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61                (a
0dc0: 72 72 61 79 3a 65 6d 70 74 79 2d 73 68 61 70 65  rray:empty-shape
0dd0: 2d 69 6e 64 65 78 29 29 0a 20 20 20 20 20 20 20  -index)).       
0de0: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72           (vector
0df0: 20 30 20 28 71 75 6f 74 69 65 6e 74 20 28 76 65   0 (quotient (ve
0e00: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 29 20 32  ctor-length v) 2
0e10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
0e20: 20 20 20 20 20 20 20 20 20 20 30 20 32 29 29 29            0 2)))
0e30: 29 0a 20 20 20 20 20 20 28 6f 72 20 28 61 72 72  ).      (or (arr
0e40: 61 79 3a 67 6f 6f 64 2d 73 68 61 70 65 3f 20 73  ay:good-shape? s
0e50: 68 70 29 0a 20 20 20 20 20 20 20 20 20 20 28 65  hp).          (e
0e60: 72 72 6f 72 20 28 73 74 72 69 6e 67 2d 61 70 70  rror (string-app
0e70: 65 6e 64 20 22 73 68 61 70 65 3a 20 62 6f 75 6e  end "shape: boun
0e80: 64 73 20 61 72 65 20 6e 6f 74 20 70 61 69 72 77  ds are not pairw
0e90: 69 73 65 20 22 0a 20 20 20 20 20 20 20 20 20 20  ise ".          
0ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0eb0: 20 20 20 20 20 20 22 6e 6f 6e 2d 64 65 63 72 65        "non-decre
0ec0: 61 73 69 6e 67 20 65 78 61 63 74 20 69 6e 74 65  asing exact inte
0ed0: 67 65 72 73 3a 20 22 0a 20 20 20 20 20 20 20 20  gers: ".        
0ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0ef0: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 6c          (array:l
0f00: 69 73 74 2d 3e 73 74 72 69 6e 67 20 62 6f 75 6e  ist->string boun
0f10: 64 73 29 29 29 29 0a 20 20 20 20 20 20 73 68 70  ds)))).      shp
0f20: 29 29 29 0a 0a 3b 3b 3b 20 28 61 72 72 61 79 20  )))..;;; (array 
0f30: 73 68 61 70 65 20 6f 62 6a 20 2e 2e 2e 29 0a 3b  shape obj ...).;
0f40: 3b 3b 20 69 73 20 61 6e 61 6c 6f 67 6f 75 73 20  ;; is analogous 
0f50: 74 6f 20 60 76 65 63 74 6f 72 27 2e 0a 0a 28 64  to `vector'...(d
0f60: 65 66 69 6e 65 20 28 61 72 72 61 79 20 73 68 61  efine (array sha
0f70: 70 65 20 2e 20 65 6c 74 73 29 0a 20 20 28 6f 72  pe . elts).  (or
0f80: 20 28 61 72 72 61 79 3a 67 6f 6f 64 2d 73 68 61   (array:good-sha
0f90: 70 65 3f 20 73 68 61 70 65 29 0a 20 20 20 20 20  pe? shape).     
0fa0: 20 28 65 72 72 6f 72 20 28 73 74 72 69 6e 67 2d   (error (string-
0fb0: 61 70 70 65 6e 64 20 22 61 72 72 61 79 3a 20 73  append "array: s
0fc0: 68 61 70 65 20 22 20 28 61 72 72 61 79 3a 74 68  hape " (array:th
0fd0: 69 6e 67 2d 3e 73 74 72 69 6e 67 20 73 68 61 70  ing->string shap
0fe0: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  e).             
0ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22                 "
1000: 20 69 73 20 6e 6f 74 20 61 20 73 68 61 70 65 22   is not a shape"
1010: 29 29 29 0a 20 20 28 6c 65 74 20 28 28 73 69 7a  ))).  (let ((siz
1020: 65 20 28 61 72 72 61 79 3a 73 69 7a 65 20 73 68  e (array:size sh
1030: 61 70 65 29 29 29 0a 20 20 20 20 28 6c 65 74 20  ape))).    (let 
1040: 28 28 76 65 63 74 6f 72 20 28 6c 69 73 74 2d 3e  ((vector (list->
1050: 76 65 63 74 6f 72 20 65 6c 74 73 29 29 29 0a 20  vector elts))). 
1060: 20 20 20 20 20 28 6f 72 20 28 3d 20 28 76 65 63       (or (= (vec
1070: 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f  tor-length vecto
1080: 72 29 20 73 69 7a 65 29 0a 20 20 20 20 20 20 20  r) size).       
1090: 20 20 20 28 65 72 72 6f 72 20 28 73 74 72 69 6e     (error (strin
10a0: 67 2d 61 70 70 65 6e 64 20 22 61 72 72 61 79 3a  g-append "array:
10b0: 20 61 6e 20 61 72 72 61 79 20 6f 66 20 73 68 61   an array of sha
10c0: 70 65 20 22 0a 20 20 20 20 20 20 20 20 20 20 20  pe ".           
10d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10e0: 20 20 20 20 20 28 61 72 72 61 79 3a 73 68 61 70       (array:shap
10f0: 65 2d 76 65 63 74 6f 72 2d 3e 73 74 72 69 6e 67  e-vector->string
1100: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
1110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1120: 20 20 28 61 72 72 61 79 3a 76 65 63 74 6f 72 20    (array:vector 
1130: 73 68 61 70 65 29 29 0a 20 20 20 20 20 20 20 20  shape)).        
1140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1150: 20 20 20 20 20 20 20 20 22 20 68 61 73 20 22 0a          " has ".
1160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1180: 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20  (number->string 
1190: 73 69 7a 65 29 0a 20 20 20 20 20 20 20 20 20 20  size).          
11a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
11b0: 20 20 20 20 20 20 22 20 65 6c 65 6d 65 6e 74 73        " elements
11c0: 20 62 75 74 20 67 6f 74 20 22 0a 20 20 20 20 20   but got ".     
11d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
11e0: 20 20 20 20 20 20 20 20 20 20 20 28 6e 75 6d 62             (numb
11f0: 65 72 2d 3e 73 74 72 69 6e 67 20 28 76 65 63 74  er->string (vect
1200: 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f 72  or-length vector
1210: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
1220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1230: 20 20 20 22 20 76 61 6c 75 65 73 3a 20 22 0a 20     " values: ". 
1240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
1260: 61 72 72 61 79 3a 6c 69 73 74 2d 3e 73 74 72 69  array:list->stri
1270: 6e 67 20 65 6c 74 73 29 29 29 29 0a 20 20 20 20  ng elts)))).    
1280: 20 20 28 61 72 72 61 79 3a 6d 61 6b 65 0a 20 20    (array:make.  
1290: 20 20 20 20 20 76 65 63 74 6f 72 0a 20 20 20 20       vector.    
12a0: 20 20 20 28 69 66 20 28 3d 20 73 69 7a 65 20 30     (if (= size 0
12b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 72  ).           (ar
12c0: 72 61 79 3a 6f 70 74 69 6d 69 7a 65 2d 65 6d 70  ray:optimize-emp
12d0: 74 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  ty.            (
12e0: 76 65 63 74 6f 72 2d 72 65 66 20 28 61 72 72 61  vector-ref (arra
12f0: 79 3a 73 68 61 70 65 20 73 68 61 70 65 29 20 31  y:shape shape) 1
1300: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61  )).           (a
1310: 72 72 61 79 3a 6f 70 74 69 6d 69 7a 65 0a 20 20  rray:optimize.  
1320: 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79            (array
1330: 3a 6d 61 6b 65 2d 69 6e 64 65 78 20 73 68 61 70  :make-index shap
1340: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  e).            (
1350: 76 65 63 74 6f 72 2d 72 65 66 20 28 61 72 72 61  vector-ref (arra
1360: 79 3a 73 68 61 70 65 20 73 68 61 70 65 29 20 31  y:shape shape) 1
1370: 29 29 29 0a 20 20 20 20 20 20 20 28 61 72 72 61  ))).       (arra
1380: 79 3a 73 68 61 70 65 2d 3e 76 65 63 74 6f 72 20  y:shape->vector 
1390: 73 68 61 70 65 29 29 29 29 29 0a 0a 3b 3b 3b 20  shape)))))..;;; 
13a0: 28 61 72 72 61 79 2d 72 61 6e 6b 20 61 72 72 61  (array-rank arra
13b0: 79 29 0a 3b 3b 3b 20 72 65 74 75 72 6e 73 20 74  y).;;; returns t
13c0: 68 65 20 6e 75 6d 62 65 72 20 6f 66 20 64 69 6d  he number of dim
13d0: 65 6e 73 69 6f 6e 73 20 6f 66 20 60 61 72 72 61  ensions of `arra
13e0: 79 27 2e 0a 0a 28 64 65 66 69 6e 65 20 28 61 72  y'...(define (ar
13f0: 72 61 79 2d 72 61 6e 6b 20 61 72 72 61 79 29 0a  ray-rank array).
1400: 20 20 20 28 71 75 6f 74 69 65 6e 74 20 28 76 65     (quotient (ve
1410: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 28 61 72 72  ctor-length (arr
1420: 61 79 3a 73 68 61 70 65 20 61 72 72 61 79 29 29  ay:shape array))
1430: 20 32 29 29 0a 0a 3b 3b 3b 20 28 61 72 72 61 79   2))..;;; (array
1440: 2d 73 74 61 72 74 20 61 72 72 61 79 20 6b 29 0a  -start array k).
1450: 3b 3b 3b 20 72 65 74 75 72 6e 73 20 74 68 65 20  ;;; returns the 
1460: 6c 6f 77 65 72 20 62 6f 75 6e 64 20 69 6e 64 65  lower bound inde
1470: 78 20 6f 66 20 61 72 72 61 79 20 61 6c 6f 6e 67  x of array along
1480: 20 64 69 6d 65 6e 73 69 6f 6e 20 6b 2e 20 54 68   dimension k. Th
1490: 69 73 20 69 73 0a 3b 3b 3b 20 74 68 65 20 6c 65  is is.;;; the le
14a0: 61 73 74 20 76 61 6c 69 64 20 69 6e 64 65 78 20  ast valid index 
14b0: 61 6c 6f 6e 67 20 74 68 61 74 20 64 69 6d 65 6e  along that dimen
14c0: 73 69 6f 6e 20 69 66 20 74 68 65 20 64 69 6d 65  sion if the dime
14d0: 6e 73 69 6f 6e 20 69 73 20 6e 6f 74 0a 3b 3b 3b  nsion is not.;;;
14e0: 20 65 6d 70 74 79 2e 0a 0a 28 64 65 66 69 6e 65   empty...(define
14f0: 20 28 61 72 72 61 79 2d 73 74 61 72 74 20 61 72   (array-start ar
1500: 72 61 79 20 64 29 0a 20 20 28 76 65 63 74 6f 72  ray d).  (vector
1510: 2d 72 65 66 20 28 61 72 72 61 79 3a 73 68 61 70  -ref (array:shap
1520: 65 20 61 72 72 61 79 29 20 28 2b 20 64 20 64 29  e array) (+ d d)
1530: 29 29 0a 0a 3b 3b 3b 20 28 61 72 72 61 79 2d 65  ))..;;; (array-e
1540: 6e 64 20 61 72 72 61 79 20 6b 29 0a 3b 3b 3b 20  nd array k).;;; 
1550: 72 65 74 75 72 6e 73 20 74 68 65 20 75 70 70 65  returns the uppe
1560: 72 20 62 6f 75 6e 64 20 69 6e 64 65 78 20 6f 66  r bound index of
1570: 20 61 72 72 61 79 20 61 6c 6f 6e 67 20 64 69 6d   array along dim
1580: 65 6e 73 69 6f 6e 20 6b 2e 20 54 68 69 73 20 69  ension k. This i
1590: 73 0a 3b 3b 3b 20 6e 6f 74 20 61 20 76 61 6c 69  s.;;; not a vali
15a0: 64 20 69 6e 64 65 78 2e 20 49 66 20 74 68 65 20  d index. If the 
15b0: 64 69 6d 65 6e 73 69 6f 6e 20 69 73 20 65 6d 70  dimension is emp
15c0: 74 79 2c 20 74 68 69 73 20 69 73 20 74 68 65 20  ty, this is the 
15d0: 73 61 6d 65 20 61 73 0a 3b 3b 3b 20 74 68 65 20  same as.;;; the 
15e0: 6c 6f 77 65 72 20 62 6f 75 6e 64 20 61 6c 6f 6e  lower bound alon
15f0: 67 20 69 74 2e 0a 0a 28 64 65 66 69 6e 65 20 28  g it...(define (
1600: 61 72 72 61 79 2d 65 6e 64 20 61 72 72 61 79 20  array-end array 
1610: 64 29 0a 20 20 28 76 65 63 74 6f 72 2d 72 65 66  d).  (vector-ref
1620: 20 28 61 72 72 61 79 3a 73 68 61 70 65 20 61 72   (array:shape ar
1630: 72 61 79 29 20 28 2b 20 64 20 64 20 31 29 29 29  ray) (+ d d 1)))
1640: 0a 0a 3b 3b 3b 20 28 73 68 61 72 65 2d 61 72 72  ..;;; (share-arr
1650: 61 79 20 61 72 72 61 79 20 73 68 61 70 65 20 70  ay array shape p
1660: 72 6f 63 29 0a 3b 3b 3b 20 6d 61 6b 65 73 20 61  roc).;;; makes a
1670: 6e 20 61 72 72 61 79 20 74 68 61 74 20 73 68 61  n array that sha
1680: 72 65 73 20 65 6c 65 6d 65 6e 74 73 20 6f 66 20  res elements of 
1690: 60 61 72 72 61 79 27 20 61 74 20 73 68 61 70 65  `array' at shape
16a0: 20 60 73 68 61 70 65 27 2e 0a 3b 3b 3b 20 54 68   `shape'..;;; Th
16b0: 65 20 61 72 67 75 6d 65 6e 74 73 20 74 6f 20 60  e arguments to `
16c0: 70 72 6f 63 27 20 61 72 65 20 69 6e 64 69 63 65  proc' are indice
16d0: 73 20 6f 66 20 74 68 65 20 72 65 73 75 6c 74 2e  s of the result.
16e0: 20 20 54 68 65 20 76 61 6c 75 65 73 20 6f 66 0a    The values of.
16f0: 3b 3b 3b 20 60 70 72 6f 63 27 20 61 72 65 20 69  ;;; `proc' are i
1700: 6e 64 69 63 65 73 20 6f 66 20 60 61 72 72 61 79  ndices of `array
1710: 27 2e 0a 0a 3b 3b 3b 20 54 6f 64 6f 3a 20 69 6e  '...;;; Todo: in
1720: 20 74 68 65 20 65 72 72 6f 72 20 6d 65 73 73 61   the error messa
1730: 67 65 2c 20 73 68 6f 75 6c 64 20 72 65 63 6f 67  ge, should recog
1740: 6e 69 73 65 20 74 68 65 20 6d 61 70 70 69 6e 67  nise the mapping
1750: 20 61 6e 64 20 73 68 6f 77 20 69 74 2e 0a 0a 28   and show it...(
1760: 64 65 66 69 6e 65 20 28 73 68 61 72 65 2d 61 72  define (share-ar
1770: 72 61 79 20 61 72 72 61 79 20 73 75 62 73 68 61  ray array subsha
1780: 70 65 20 66 29 0a 20 20 28 6f 72 20 28 61 72 72  pe f).  (or (arr
1790: 61 79 3a 67 6f 6f 64 2d 73 68 61 70 65 3f 20 73  ay:good-shape? s
17a0: 75 62 73 68 61 70 65 29 0a 20 20 20 20 20 20 28  ubshape).      (
17b0: 65 72 72 6f 72 20 28 73 74 72 69 6e 67 2d 61 70  error (string-ap
17c0: 70 65 6e 64 20 22 73 68 61 72 65 2d 61 72 72 61  pend "share-arra
17d0: 79 3a 20 73 68 61 70 65 20 22 0a 20 20 20 20 20  y: shape ".     
17e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
17f0: 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 74 68         (array:th
1800: 69 6e 67 2d 3e 73 74 72 69 6e 67 20 73 75 62 73  ing->string subs
1810: 68 61 70 65 29 0a 20 20 20 20 20 20 20 20 20 20  hape).          
1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1830: 20 20 22 20 69 73 20 6e 6f 74 20 61 20 73 68 61    " is not a sha
1840: 70 65 22 29 29 29 0a 20 20 28 6c 65 74 20 28 28  pe"))).  (let ((
1850: 73 75 62 73 69 7a 65 20 28 61 72 72 61 79 3a 73  subsize (array:s
1860: 69 7a 65 20 73 75 62 73 68 61 70 65 29 29 29 0a  ize subshape))).
1870: 20 20 20 20 28 6f 72 20 28 61 72 72 61 79 3a 67      (or (array:g
1880: 6f 6f 64 2d 73 68 61 72 65 3f 20 73 75 62 73 68  ood-share? subsh
1890: 61 70 65 20 73 75 62 73 69 7a 65 20 66 20 28 61  ape subsize f (a
18a0: 72 72 61 79 3a 73 68 61 70 65 20 61 72 72 61 79  rray:shape array
18b0: 29 29 0a 20 20 20 20 20 20 20 20 28 65 72 72 6f  )).        (erro
18c0: 72 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64  r (string-append
18d0: 20 22 73 68 61 72 65 2d 61 72 72 61 79 3a 20 73   "share-array: s
18e0: 75 62 73 68 61 70 65 20 22 0a 20 20 20 20 20 20  ubshape ".      
18f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1900: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 73          (array:s
1910: 68 61 70 65 2d 76 65 63 74 6f 72 2d 3e 73 74 72  hape-vector->str
1920: 69 6e 67 0a 20 20 20 20 20 20 20 20 20 20 20 20  ing.            
1930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1940: 20 20 20 28 61 72 72 61 79 3a 76 65 63 74 6f 72     (array:vector
1950: 20 73 75 62 73 68 61 70 65 29 29 0a 20 20 20 20   subshape)).    
1960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1970: 20 20 20 20 20 20 20 20 20 20 22 20 64 6f 65 73            " does
1980: 20 6e 6f 74 20 6d 61 70 20 69 6e 74 6f 20 73 75   not map into su
1990: 70 65 72 73 68 61 70 65 20 22 0a 20 20 20 20 20  pershape ".     
19a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
19b0: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 3a           (array:
19c0: 73 68 61 70 65 2d 76 65 63 74 6f 72 2d 3e 73 74  shape-vector->st
19d0: 72 69 6e 67 0a 20 20 20 20 20 20 20 20 20 20 20  ring.           
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
19f0: 20 20 20 20 28 61 72 72 61 79 3a 73 68 61 70 65      (array:shape
1a00: 20 61 72 72 61 79 29 29 0a 20 20 20 20 20 20 20   array)).       
1a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1a20: 20 20 20 20 20 20 20 22 20 75 6e 64 65 72 20 6d         " under m
1a30: 61 70 70 69 6e 67 20 22 0a 20 20 20 20 20 20 20  apping ".       
1a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1a50: 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 6d 61         (array:ma
1a60: 70 2d 3e 73 74 72 69 6e 67 0a 20 20 20 20 20 20  p->string.      
1a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1a80: 20 20 20 20 20 20 20 20 20 66 0a 20 20 20 20 20           f.     
1a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1aa0: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f            (vecto
1ab0: 72 2d 72 65 66 20 28 61 72 72 61 79 3a 73 68 61  r-ref (array:sha
1ac0: 70 65 20 73 75 62 73 68 61 70 65 29 20 31 29 29  pe subshape) 1))
1ad0: 29 29 29 20 20 20 20 0a 20 20 20 20 28 6c 65 74  )))    .    (let
1ae0: 20 28 28 67 20 28 61 72 72 61 79 3a 69 6e 64 65   ((g (array:inde
1af0: 78 20 61 72 72 61 79 29 29 29 0a 20 20 20 20 20  x array))).     
1b00: 20 28 61 72 72 61 79 3a 6d 61 6b 65 0a 20 20 20   (array:make.   
1b10: 20 20 20 20 28 61 72 72 61 79 3a 76 65 63 74 6f      (array:vecto
1b20: 72 20 61 72 72 61 79 29 0a 20 20 20 20 20 20 20  r array).       
1b30: 28 69 66 20 28 3d 20 73 75 62 73 69 7a 65 20 30  (if (= subsize 0
1b40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 72  ).           (ar
1b50: 72 61 79 3a 6f 70 74 69 6d 69 7a 65 2d 65 6d 70  ray:optimize-emp
1b60: 74 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  ty.            (
1b70: 76 65 63 74 6f 72 2d 72 65 66 20 28 61 72 72 61  vector-ref (arra
1b80: 79 3a 73 68 61 70 65 20 73 75 62 73 68 61 70 65  y:shape subshape
1b90: 29 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20  ) 1)).          
1ba0: 20 28 61 72 72 61 79 3a 6f 70 74 69 6d 69 7a 65   (array:optimize
1bb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61  .            (la
1bc0: 6d 62 64 61 20 6b 73 0a 20 20 20 20 20 20 20 20  mbda ks.        
1bd0: 20 20 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 68        (call-with
1be0: 2d 76 61 6c 75 65 73 0a 20 20 20 20 20 20 20 20  -values.        
1bf0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28         (lambda (
1c00: 29 20 28 61 70 70 6c 79 20 66 20 6b 73 29 29 0a  ) (apply f ks)).
1c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
1c20: 6c 61 6d 62 64 61 20 6b 73 20 28 61 72 72 61 79  lambda ks (array
1c30: 3a 76 65 63 74 6f 72 2d 69 6e 64 65 78 20 67 20  :vector-index g 
1c40: 6b 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 20  ks)))).         
1c50: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28     (vector-ref (
1c60: 61 72 72 61 79 3a 73 68 61 70 65 20 73 75 62 73  array:shape subs
1c70: 68 61 70 65 29 20 31 29 29 29 0a 20 20 20 20 20  hape) 1))).     
1c80: 20 20 28 61 72 72 61 79 3a 73 68 61 70 65 2d 3e    (array:shape->
1c90: 76 65 63 74 6f 72 20 73 75 62 73 68 61 70 65 29  vector subshape)
1ca0: 29 29 29 29 0a 0a 3b 3b 3b 20 2d 2d 2d 20 48 72  ))))..;;; --- Hr
1cb0: 6d 70 68 20 2d 2d 2d 0a 0a 3b 3b 3b 20 28 61 72  mph ---..;;; (ar
1cc0: 72 61 79 3a 73 68 61 72 65 2f 69 6e 64 65 78 21  ray:share/index!
1cd0: 20 2e 2e 2e 29 0a 3b 3b 3b 20 72 65 75 73 65 73   ...).;;; reuses
1ce0: 20 61 20 75 73 65 72 20 73 75 70 70 6c 69 65 64   a user supplied
1cf0: 20 69 6e 64 65 78 20 6f 62 6a 65 63 74 20 77 68   index object wh
1d00: 65 6e 20 72 65 63 6f 67 6e 69 73 69 6e 67 20 74  en recognising t
1d10: 68 65 0a 3b 3b 3b 20 6d 61 70 70 69 6e 67 2e 20  he.;;; mapping. 
1d20: 54 68 65 20 6d 69 6e 64 20 62 61 6c 6b 73 20 61  The mind balks a
1d30: 74 20 74 68 65 20 76 65 72 79 20 6e 61 73 74 79  t the very nasty
1d40: 20 73 69 64 65 20 65 66 66 65 63 74 20 74 68 61   side effect tha
1d50: 74 0a 3b 3b 3b 20 65 78 70 6f 73 65 73 20 74 68  t.;;; exposes th
1d60: 65 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e  e implementation
1d70: 2e 20 53 6f 20 74 68 69 73 20 69 73 20 6e 6f 74  . So this is not
1d80: 20 69 6e 20 74 68 65 20 73 70 65 63 2e 0a 3b 3b   in the spec..;;
1d90: 3b 20 42 75 74 20 6c 65 74 74 69 6e 67 20 69 6e  ; But letting in
1da0: 64 65 78 20 6f 62 6a 65 63 74 73 20 69 6e 20 61  dex objects in a
1db0: 74 20 61 6c 6c 20 63 72 65 61 74 65 73 20 61 20  t all creates a 
1dc0: 70 72 65 73 73 75 72 65 0a 3b 3b 3b 20 74 6f 20  pressure.;;; to 
1dd0: 67 6f 20 74 68 65 20 77 68 6f 6c 65 20 68 6f 67  go the whole hog
1de0: 2e 20 41 72 66 2e 0a 0a 3b 3b 3b 20 55 73 65 20  . Arf...;;; Use 
1df0: 61 72 72 61 79 3a 6f 70 74 69 6d 69 7a 65 2d 65  array:optimize-e
1e00: 6d 70 74 79 20 66 6f 72 20 61 6e 20 65 6d 70 74  mpty for an empt
1e10: 79 20 61 72 72 61 79 20 74 6f 20 67 65 74 20 61  y array to get a
1e20: 0a 3b 3b 3b 20 63 6c 65 61 72 6c 79 20 69 6e 76  .;;; clearly inv
1e30: 61 6c 69 64 20 76 65 63 74 6f 72 20 69 6e 64 65  alid vector inde
1e40: 78 2e 0a 0a 3b 3b 3b 20 53 75 72 65 6c 79 20 69  x...;;; Surely i
1e50: 74 27 73 20 70 65 72 76 65 72 73 65 20 74 6f 20  t's perverse to 
1e60: 75 73 65 20 61 6e 20 61 63 74 6f 72 20 66 6f 72  use an actor for
1e70: 20 69 6e 64 65 78 20 68 65 72 65 3f 20 42 75 74   index here? But
1e80: 0a 3b 3b 3b 20 74 68 65 20 70 6f 73 73 69 62 69  .;;; the possibi
1e90: 6c 69 74 79 20 69 73 20 70 72 6f 76 69 64 65 64  lity is provided
1ea0: 20 66 6f 72 20 63 6f 6d 70 6c 65 74 65 6e 65 73   for completenes
1eb0: 73 2e 0a 0a 28 64 65 66 69 6e 65 20 28 61 72 72  s...(define (arr
1ec0: 61 79 3a 73 68 61 72 65 2f 69 6e 64 65 78 21 20  ay:share/index! 
1ed0: 61 72 72 61 79 20 73 75 62 73 68 61 70 65 20 70  array subshape p
1ee0: 72 6f 63 20 69 6e 64 65 78 29 0a 20 20 28 61 72  roc index).  (ar
1ef0: 72 61 79 3a 6d 61 6b 65 0a 20 20 20 28 61 72 72  ray:make.   (arr
1f00: 61 79 3a 76 65 63 74 6f 72 20 61 72 72 61 79 29  ay:vector array)
1f10: 0a 20 20 20 28 69 66 20 28 3d 20 28 61 72 72 61  .   (if (= (arra
1f20: 79 3a 73 69 7a 65 20 73 75 62 73 68 61 70 65 29  y:size subshape)
1f30: 20 30 29 0a 20 20 20 20 20 20 20 28 61 72 72 61   0).       (arra
1f40: 79 3a 6f 70 74 69 6d 69 7a 65 2d 65 6d 70 74 79  y:optimize-empty
1f50: 0a 20 20 20 20 20 20 20 20 28 71 75 6f 74 69 65  .        (quotie
1f60: 6e 74 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74  nt (vector-lengt
1f70: 68 20 28 61 72 72 61 79 3a 73 68 61 70 65 20 61  h (array:shape a
1f80: 72 72 61 79 29 29 20 32 29 29 0a 20 20 20 20 20  rray)) 2)).     
1f90: 20 20 28 28 69 66 20 28 76 65 63 74 6f 72 3f 20    ((if (vector? 
1fa0: 69 6e 64 65 78 29 0a 20 20 20 20 20 20 20 20 20  index).         
1fb0: 20 20 20 61 72 72 61 79 3a 6f 70 74 69 6d 69 7a     array:optimiz
1fc0: 65 2f 76 65 63 74 6f 72 0a 20 20 20 20 20 20 20  e/vector.       
1fd0: 20 20 20 20 20 61 72 72 61 79 3a 6f 70 74 69 6d       array:optim
1fe0: 69 7a 65 2f 61 63 74 6f 72 29 0a 20 20 20 20 20  ize/actor).     
1ff0: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 75 62 69     (lambda (subi
2000: 6e 64 65 78 29 0a 20 20 20 20 20 20 20 20 20 20  ndex).          
2010: 28 6c 65 74 20 28 28 73 75 70 65 72 69 6e 64 65  (let ((superinde
2020: 78 20 28 70 72 6f 63 20 73 75 62 69 6e 64 65 78  x (proc subindex
2030: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ))).            
2040: 28 69 66 20 28 76 65 63 74 6f 72 3f 20 73 75 70  (if (vector? sup
2050: 65 72 69 6e 64 65 78 29 0a 20 20 20 20 20 20 20  erindex).       
2060: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 3a           (array:
2070: 69 6e 64 65 78 2f 76 65 63 74 6f 72 0a 20 20 20  index/vector.   
2080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 71                (q
2090: 75 6f 74 69 65 6e 74 20 28 76 65 63 74 6f 72 2d  uotient (vector-
20a0: 6c 65 6e 67 74 68 20 28 61 72 72 61 79 3a 73 68  length (array:sh
20b0: 61 70 65 20 61 72 72 61 79 29 29 20 32 29 0a 20  ape array)) 2). 
20c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
20d0: 28 61 72 72 61 79 3a 69 6e 64 65 78 20 61 72 72  (array:index arr
20e0: 61 79 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ay).            
20f0: 20 20 20 20 20 73 75 70 65 72 69 6e 64 65 78 29       superindex)
2100: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
2110: 20 28 61 72 72 61 79 3a 69 6e 64 65 78 2f 61 72   (array:index/ar
2120: 72 61 79 0a 20 20 20 20 20 20 20 20 20 20 20 20  ray.            
2130: 20 20 20 20 20 28 71 75 6f 74 69 65 6e 74 20 28       (quotient (
2140: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 28 61  vector-length (a
2150: 72 72 61 79 3a 73 68 61 70 65 20 61 72 72 61 79  rray:shape array
2160: 29 29 20 32 29 0a 20 20 20 20 20 20 20 20 20 20  )) 2).          
2170: 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 69 6e         (array:in
2180: 64 65 78 20 61 72 72 61 79 29 0a 20 20 20 20 20  dex array).     
2190: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72              (arr
21a0: 61 79 3a 76 65 63 74 6f 72 20 73 75 70 65 72 69  ay:vector superi
21b0: 6e 64 65 78 29 0a 20 20 20 20 20 20 20 20 20 20  ndex).          
21c0: 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 69 6e         (array:in
21d0: 64 65 78 20 73 75 70 65 72 69 6e 64 65 78 29 29  dex superindex))
21e0: 29 29 29 0a 20 20 20 20 20 20 20 20 69 6e 64 65  ))).        inde
21f0: 78 29 29 0a 20 20 20 28 61 72 72 61 79 3a 73 68  x)).   (array:sh
2200: 61 70 65 2d 3e 76 65 63 74 6f 72 20 73 75 62 73  ape->vector subs
2210: 68 61 70 65 29 29 29 0a 0a 28 64 65 66 69 6e 65  hape)))..(define
2220: 20 28 61 72 72 61 79 3a 6f 70 74 69 6d 69 7a 65   (array:optimize
2230: 2f 76 65 63 74 6f 72 20 66 20 76 29 0a 20 20 28  /vector f v).  (
2240: 6c 65 74 20 28 28 72 20 28 76 65 63 74 6f 72 2d  let ((r (vector-
2250: 6c 65 6e 67 74 68 20 76 29 29 29 0a 20 20 20 20  length v))).    
2260: 28 64 6f 20 28 28 6b 20 30 20 28 2b 20 6b 20 31  (do ((k 0 (+ k 1
2270: 29 29 29 0a 20 20 20 20 20 20 28 28 3d 20 6b 20  ))).      ((= k 
2280: 72 29 29 0a 20 20 20 20 20 20 28 76 65 63 74 6f  r)).      (vecto
2290: 72 2d 73 65 74 21 20 76 20 6b 20 30 29 29 0a 20  r-set! v k 0)). 
22a0: 20 20 20 28 6c 65 74 20 28 28 6e 30 20 28 66 20     (let ((n0 (f 
22b0: 76 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 63  v)).          (c
22c0: 73 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28  s (make-vector (
22d0: 2b 20 72 20 31 29 29 29 0a 20 20 20 20 20 20 20  + r 1))).       
22e0: 20 20 20 28 61 70 70 6c 79 20 28 61 72 72 61 79     (apply (array
22f0: 3a 61 70 70 6c 69 65 72 2d 74 6f 2d 76 65 63 74  :applier-to-vect
2300: 6f 72 20 28 2b 20 72 20 31 29 29 29 29 0a 20 20  or (+ r 1)))).  
2310: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21      (vector-set!
2320: 20 63 73 20 30 20 6e 30 29 0a 20 20 20 20 20 20   cs 0 n0).      
2330: 28 6c 65 74 20 77 6f 6b 20 28 28 6b 20 30 29 29  (let wok ((k 0))
2340: 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 3c 20  .        (if (< 
2350: 6b 20 72 29 0a 20 20 20 20 20 20 20 20 20 20 20  k r).           
2360: 20 28 6c 65 74 20 28 28 6b 31 20 28 2b 20 6b 20   (let ((k1 (+ k 
2370: 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  1))).           
2380: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20     (vector-set! 
2390: 76 20 6b 20 31 29 0a 20 20 20 20 20 20 20 20 20  v k 1).         
23a0: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 6b 20 28       (let ((nk (
23b0: 2d 20 28 66 20 76 29 20 6e 30 29 29 29 0a 20 20  - (f v) n0))).  
23c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76                (v
23d0: 65 63 74 6f 72 2d 73 65 74 21 20 76 20 6b 20 30  ector-set! v k 0
23e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
23f0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 63    (vector-set! c
2400: 73 20 6b 31 20 6e 6b 29 0a 20 20 20 20 20 20 20  s k1 nk).       
2410: 20 20 20 20 20 20 20 20 20 28 77 6f 6b 20 6b 31           (wok k1
2420: 29 29 29 29 29 0a 20 20 20 20 20 20 28 61 70 70  ))))).      (app
2430: 6c 79 20 28 61 72 72 61 79 3a 6d 61 6b 65 72 20  ly (array:maker 
2440: 72 29 20 63 73 29 29 29 29 0a 0a 28 64 65 66 69  r) cs))))..(defi
2450: 6e 65 20 28 61 72 72 61 79 3a 6f 70 74 69 6d 69  ne (array:optimi
2460: 7a 65 2f 61 63 74 6f 72 20 66 20 61 29 0a 20 20  ze/actor f a).  
2470: 28 6c 65 74 20 28 28 72 20 28 61 72 72 61 79 2d  (let ((r (array-
2480: 65 6e 64 20 61 20 30 29 29 0a 20 20 20 20 20 20  end a 0)).      
2490: 20 20 28 76 20 28 61 72 72 61 79 3a 76 65 63 74    (v (array:vect
24a0: 6f 72 20 61 29 29 0a 20 20 20 20 20 20 20 20 28  or a)).        (
24b0: 69 20 28 61 72 72 61 79 3a 69 6e 64 65 78 20 61  i (array:index a
24c0: 29 29 29 0a 20 20 20 20 28 64 6f 20 28 28 6b 20  ))).    (do ((k 
24d0: 30 20 28 2b 20 6b 20 31 29 29 29 0a 20 20 20 20  0 (+ k 1))).    
24e0: 20 20 28 28 3d 20 6b 20 72 29 29 0a 20 20 20 20    ((= k r)).    
24f0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76    (vector-set! v
2500: 20 28 61 72 72 61 79 3a 61 63 74 6f 72 2d 69 6e   (array:actor-in
2510: 64 65 78 20 69 20 6b 29 20 30 29 29 0a 20 20 20  dex i k) 0)).   
2520: 20 28 6c 65 74 20 28 28 6e 30 20 28 66 20 61 29   (let ((n0 (f a)
2530: 29 0a 20 20 20 20 20 20 20 20 20 20 28 63 73 20  ).          (cs 
2540: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 2b 20  (make-vector (+ 
2550: 72 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20  r 1))).         
2560: 20 28 61 70 70 6c 79 20 28 61 72 72 61 79 3a 61   (apply (array:a
2570: 70 70 6c 69 65 72 2d 74 6f 2d 76 65 63 74 6f 72  pplier-to-vector
2580: 20 28 2b 20 72 20 31 29 29 29 29 0a 20 20 20 20   (+ r 1)))).    
2590: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 63    (vector-set! c
25a0: 73 20 30 20 6e 30 29 0a 20 20 20 20 20 20 28 6c  s 0 n0).      (l
25b0: 65 74 20 77 6f 6b 20 28 28 6b 20 30 29 29 0a 20  et wok ((k 0)). 
25c0: 20 20 20 20 20 20 20 28 69 66 20 28 3c 20 6b 20         (if (< k 
25d0: 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  r).            (
25e0: 6c 65 74 20 28 28 6b 31 20 28 2b 20 6b 20 31 29  let ((k1 (+ k 1)
25f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
2600: 20 20 20 20 28 74 20 28 61 72 72 61 79 3a 61 63      (t (array:ac
2610: 74 6f 72 2d 69 6e 64 65 78 20 69 20 6b 29 29 29  tor-index i k)))
2620: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28  .              (
2630: 76 65 63 74 6f 72 2d 73 65 74 21 20 76 20 74 20  vector-set! v t 
2640: 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  1).             
2650: 20 28 6c 65 74 20 28 28 6e 6b 20 28 2d 20 28 66   (let ((nk (- (f
2660: 20 61 29 20 6e 30 29 29 29 0a 20 20 20 20 20 20   a) n0))).      
2670: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f            (vecto
2680: 72 2d 73 65 74 21 20 76 20 74 20 30 29 0a 20 20  r-set! v t 0).  
2690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76                (v
26a0: 65 63 74 6f 72 2d 73 65 74 21 20 63 73 20 6b 31  ector-set! cs k1
26b0: 20 6e 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20   nk).           
26c0: 20 20 20 20 20 28 77 6f 6b 20 6b 31 29 29 29 29       (wok k1))))
26d0: 29 0a 20 20 20 20 20 20 28 61 70 70 6c 79 20 28  ).      (apply (
26e0: 61 72 72 61 79 3a 6d 61 6b 65 72 20 72 29 20 63  array:maker r) c
26f0: 73 29 29 29 29 0a 0a 3b 3b 3b 20 2d 2d 2d 20 49  s))))..;;; --- I
2700: 6e 74 65 72 6e 61 6c 73 20 2d 2d 2d 0a 0a 28 64  nternals ---..(d
2710: 65 66 69 6e 65 20 28 61 72 72 61 79 3a 73 68 61  efine (array:sha
2720: 70 65 2d 3e 76 65 63 74 6f 72 20 73 68 61 70 65  pe->vector shape
2730: 29 0a 20 20 28 6c 65 74 20 28 28 69 64 78 20 28  ).  (let ((idx (
2740: 61 72 72 61 79 3a 69 6e 64 65 78 20 73 68 61 70  array:index shap
2750: 65 29 29 0a 20 20 20 20 20 20 20 20 28 73 68 76  e)).        (shv
2760: 20 28 61 72 72 61 79 3a 76 65 63 74 6f 72 20 73   (array:vector s
2770: 68 61 70 65 29 29 0a 20 20 20 20 20 20 20 20 28  hape)).        (
2780: 72 6e 6b 20 28 76 65 63 74 6f 72 2d 72 65 66 20  rnk (vector-ref 
2790: 28 61 72 72 61 79 3a 73 68 61 70 65 20 73 68 61  (array:shape sha
27a0: 70 65 29 20 31 29 29 29 0a 20 20 20 20 28 6c 65  pe) 1))).    (le
27b0: 74 20 28 28 76 65 63 20 28 6d 61 6b 65 2d 76 65  t ((vec (make-ve
27c0: 63 74 6f 72 20 28 2a 20 72 6e 6b 20 32 29 29 29  ctor (* rnk 2)))
27d0: 29 0a 20 20 20 20 20 20 28 64 6f 20 28 28 6b 20  ).      (do ((k 
27e0: 30 20 28 2b 20 6b 20 31 29 29 29 0a 20 20 20 20  0 (+ k 1))).    
27f0: 20 20 20 20 28 28 3d 20 6b 20 72 6e 6b 29 0a 20      ((= k rnk). 
2800: 20 20 20 20 20 20 20 20 76 65 63 29 0a 20 20 20          vec).   
2810: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74       (vector-set
2820: 21 20 76 65 63 20 28 2b 20 6b 20 6b 29 0a 20 20  ! vec (+ k k).  
2830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2840: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73     (vector-ref s
2850: 68 76 20 28 61 72 72 61 79 3a 73 68 61 70 65 2d  hv (array:shape-
2860: 76 65 63 74 6f 72 2d 69 6e 64 65 78 20 69 64 78  vector-index idx
2870: 20 6b 20 30 29 29 29 0a 20 20 20 20 20 20 20 20   k 0))).        
2880: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63  (vector-set! vec
2890: 20 28 2b 20 6b 20 6b 20 31 29 0a 20 20 20 20 20   (+ k k 1).     
28a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
28b0: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 68 76 20  (vector-ref shv 
28c0: 28 61 72 72 61 79 3a 73 68 61 70 65 2d 76 65 63  (array:shape-vec
28d0: 74 6f 72 2d 69 6e 64 65 78 20 69 64 78 20 6b 20  tor-index idx k 
28e0: 31 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 61  1)))))))..;;; (a
28f0: 72 72 61 79 3a 73 69 7a 65 20 73 68 61 70 65 29  rray:size shape)
2900: 0a 3b 3b 3b 20 72 65 74 75 72 6e 73 20 74 68 65  .;;; returns the
2910: 20 6e 75 6d 62 65 72 20 6f 66 20 65 6c 65 6d 65   number of eleme
2920: 6e 74 73 20 69 6e 20 61 72 72 61 79 73 20 6f 66  nts in arrays of
2930: 20 73 68 61 70 65 20 60 73 68 61 70 65 27 2e 0a   shape `shape'..
2940: 0a 28 64 65 66 69 6e 65 20 28 61 72 72 61 79 3a  .(define (array:
2950: 73 69 7a 65 20 73 68 61 70 65 29 0a 20 20 20 28  size shape).   (
2960: 6c 65 74 20 28 28 69 64 78 20 28 61 72 72 61 79  let ((idx (array
2970: 3a 69 6e 64 65 78 20 73 68 61 70 65 29 29 0a 20  :index shape)). 
2980: 20 20 20 20 20 20 20 20 28 73 68 76 20 28 61 72          (shv (ar
2990: 72 61 79 3a 76 65 63 74 6f 72 20 73 68 61 70 65  ray:vector shape
29a0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 6e 6b  )).         (rnk
29b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28 61 72   (vector-ref (ar
29c0: 72 61 79 3a 73 68 61 70 65 20 73 68 61 70 65 29  ray:shape shape)
29d0: 20 31 29 29 29 0a 20 20 20 20 20 28 64 6f 20 20   1))).     (do  
29e0: 20 28 28 6b 20 30 20 28 2b 20 6b 20 31 29 29 0a   ((k 0 (+ k 1)).
29f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 20 31              (s 1
2a00: 20 28 2a 20 73 0a 20 20 20 20 20 20 20 20 20 20   (* s.          
2a10: 20 20 20 20 20 20 20 20 20 20 28 2d 20 28 76 65            (- (ve
2a20: 63 74 6f 72 2d 72 65 66 20 73 68 76 20 28 61 72  ctor-ref shv (ar
2a30: 72 61 79 3a 73 68 61 70 65 2d 76 65 63 74 6f 72  ray:shape-vector
2a40: 2d 69 6e 64 65 78 20 69 64 78 20 6b 20 31 29 29  -index idx k 1))
2a50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
2a60: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d          (vector-
2a70: 72 65 66 20 73 68 76 20 28 61 72 72 61 79 3a 73  ref shv (array:s
2a80: 68 61 70 65 2d 76 65 63 74 6f 72 2d 69 6e 64 65  hape-vector-inde
2a90: 78 20 69 64 78 20 6b 20 30 29 29 29 29 29 29 0a  x idx k 0)))))).
2aa0: 20 20 20 20 20 20 20 28 28 3d 20 6b 20 72 6e 6b         ((= k rnk
2ab0: 29 20 73 29 29 29 29 0a 0a 3b 3b 3b 20 28 61 72  ) s))))..;;; (ar
2ac0: 72 61 79 3a 6d 61 6b 65 2d 69 6e 64 65 78 20 73  ray:make-index s
2ad0: 68 61 70 65 29 0a 3b 3b 3b 20 72 65 74 75 72 6e  hape).;;; return
2ae0: 73 20 61 6e 20 69 6e 64 65 78 20 66 75 6e 63 74  s an index funct
2af0: 69 6f 6e 20 66 6f 72 20 61 72 72 61 79 73 20 6f  ion for arrays o
2b00: 66 20 73 68 61 70 65 20 60 73 68 61 70 65 27 2e  f shape `shape'.
2b10: 20 54 68 69 73 20 69 73 20 61 0a 3b 3b 3b 20 72   This is a.;;; r
2b20: 75 6e 74 69 6d 65 20 63 6f 6d 70 6f 73 69 74 69  untime compositi
2b30: 6f 6e 20 6f 66 20 73 65 76 65 72 61 6c 20 76 61  on of several va
2b40: 72 69 61 62 6c 65 20 61 72 69 74 79 20 70 72 6f  riable arity pro
2b50: 63 65 64 75 72 65 73 2c 20 74 6f 20 62 65 0a 3b  cedures, to be.;
2b60: 3b 3b 20 70 61 73 73 65 64 20 74 6f 20 61 72 72  ;; passed to arr
2b70: 61 79 3a 6f 70 74 69 6d 69 7a 65 20 66 6f 72 20  ay:optimize for 
2b80: 72 65 63 6f 67 6e 69 74 69 6f 6e 20 61 73 20 61  recognition as a
2b90: 6e 20 61 66 66 69 6e 65 20 66 75 6e 63 74 69 6f  n affine functio
2ba0: 6e 20 6f 66 0a 3b 3b 3b 20 61 73 20 6d 61 6e 79  n of.;;; as many
2bb0: 20 76 61 72 69 61 62 6c 65 73 20 61 73 20 74 68   variables as th
2bc0: 65 72 65 20 61 72 65 20 64 69 6d 65 6e 73 69 6f  ere are dimensio
2bd0: 6e 73 20 69 6e 20 61 72 72 61 79 73 20 6f 66 20  ns in arrays of 
2be0: 74 68 69 73 20 73 68 61 70 65 2e 0a 0a 28 64 65  this shape...(de
2bf0: 66 69 6e 65 20 28 61 72 72 61 79 3a 6d 61 6b 65  fine (array:make
2c00: 2d 69 6e 64 65 78 20 73 68 61 70 65 29 0a 20 20  -index shape).  
2c10: 20 28 6c 65 74 20 28 28 69 64 78 20 28 61 72 72   (let ((idx (arr
2c20: 61 79 3a 69 6e 64 65 78 20 73 68 61 70 65 29 29  ay:index shape))
2c30: 0a 20 20 20 20 20 20 20 20 20 28 73 68 76 20 28  .         (shv (
2c40: 61 72 72 61 79 3a 76 65 63 74 6f 72 20 73 68 61  array:vector sha
2c50: 70 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 72  pe)).         (r
2c60: 6e 6b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28  nk (vector-ref (
2c70: 61 72 72 61 79 3a 73 68 61 70 65 20 73 68 61 70  array:shape shap
2c80: 65 29 20 31 29 29 29 0a 20 20 20 20 20 28 64 6f  e) 1))).     (do
2c90: 20 28 28 66 20 28 6c 61 6d 62 64 61 20 28 29 20   ((f (lambda () 
2ca0: 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  0).             
2cb0: 28 6c 61 6d 62 64 61 20 28 6b 20 2e 20 6b 73 29  (lambda (k . ks)
2cc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
2cd0: 28 2b 20 28 2a 20 73 20 28 2d 20 6b 20 28 76 65  (+ (* s (- k (ve
2ce0: 63 74 6f 72 2d 72 65 66 0a 20 20 20 20 20 20 20  ctor-ref.       
2cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2d00: 20 20 20 20 20 20 73 68 76 0a 20 20 20 20 20 20        shv.      
2d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2d20: 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 73 68         (array:sh
2d30: 61 70 65 2d 76 65 63 74 6f 72 2d 69 6e 64 65 78  ape-vector-index
2d40: 20 69 64 78 20 28 2d 20 6a 20 31 29 20 30 29 29   idx (- j 1) 0))
2d50: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
2d60: 20 20 20 20 20 28 61 70 70 6c 79 20 66 20 6b 73       (apply f ks
2d70: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28  )))).          (
2d80: 73 20 31 20 28 2a 20 73 20 28 2d 20 28 76 65 63  s 1 (* s (- (vec
2d90: 74 6f 72 2d 72 65 66 0a 20 20 20 20 20 20 20 20  tor-ref.        
2da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2db0: 73 68 76 0a 20 20 20 20 20 20 20 20 20 20 20 20  shv.            
2dc0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72              (arr
2dd0: 61 79 3a 73 68 61 70 65 2d 76 65 63 74 6f 72 2d  ay:shape-vector-
2de0: 69 6e 64 65 78 20 69 64 78 20 28 2d 20 6a 20 31  index idx (- j 1
2df0: 29 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20  ) 1)).          
2e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65               (ve
2e10: 63 74 6f 72 2d 72 65 66 0a 20 20 20 20 20 20 20  ctor-ref.       
2e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e30: 20 73 68 76 0a 20 20 20 20 20 20 20 20 20 20 20   shv.           
2e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72               (ar
2e50: 72 61 79 3a 73 68 61 70 65 2d 76 65 63 74 6f 72  ray:shape-vector
2e60: 2d 69 6e 64 65 78 20 69 64 78 20 28 2d 20 6a 20  -index idx (- j 
2e70: 31 29 20 30 29 29 29 29 29 0a 20 20 20 20 20 20  1) 0))))).      
2e80: 20 20 20 20 28 6a 20 72 6e 6b 20 28 2d 20 6a 20      (j rnk (- j 
2e90: 31 29 29 29 0a 20 20 20 20 20 20 20 28 28 3d 20  1))).       ((= 
2ea0: 6a 20 30 29 0a 20 20 20 20 20 20 20 20 66 29 29  j 0).        f))
2eb0: 29 29 0a 0a 0a 3b 3b 3b 20 2d 2d 2d 20 45 72 72  ))...;;; --- Err
2ec0: 6f 72 20 63 68 65 63 6b 69 6e 67 20 2d 2d 2d 0a  or checking ---.
2ed0: 0a 3b 3b 3b 20 28 61 72 72 61 79 3a 67 6f 6f 64  .;;; (array:good
2ee0: 2d 73 68 61 70 65 3f 20 73 68 61 70 65 29 0a 3b  -shape? shape).;
2ef0: 3b 3b 20 72 65 74 75 72 6e 73 20 74 72 75 65 20  ;; returns true 
2f00: 69 66 20 60 73 68 61 70 65 27 20 69 73 20 61 6e  if `shape' is an
2f10: 20 61 72 72 61 79 20 6f 66 20 74 68 65 20 72 69   array of the ri
2f20: 67 68 74 20 73 68 61 70 65 20 61 6e 64 20 69 74  ght shape and it
2f30: 73 0a 3b 3b 3b 20 65 6c 65 6d 65 6e 74 73 20 61  s.;;; elements a
2f40: 72 65 20 65 78 61 63 74 20 69 6e 74 65 67 65 72  re exact integer
2f50: 73 20 74 68 61 74 20 70 61 69 72 77 69 73 65 20  s that pairwise 
2f60: 62 6f 75 6e 64 20 69 6e 74 65 72 76 61 6c 73 20  bound intervals 
2f70: 60 5b 6c 6f 2e 2e 68 69 29 b4 2e 0a 0a 28 64 65  `[lo..hi)....(de
2f80: 66 69 6e 65 20 28 61 72 72 61 79 3a 67 6f 6f 64  fine (array:good
2f90: 2d 73 68 61 70 65 3f 20 73 68 61 70 65 29 0a 20  -shape? shape). 
2fa0: 20 28 61 6e 64 20 28 61 72 72 61 79 3a 61 72 72   (and (array:arr
2fb0: 61 79 3f 20 73 68 61 70 65 29 0a 20 20 20 20 20  ay? shape).     
2fc0: 20 20 28 6c 65 74 20 28 28 75 20 28 61 72 72 61    (let ((u (arra
2fd0: 79 3a 73 68 61 70 65 20 73 68 61 70 65 29 29 0a  y:shape shape)).
2fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 20               (v 
2ff0: 28 61 72 72 61 79 3a 76 65 63 74 6f 72 20 73 68  (array:vector sh
3000: 61 70 65 29 29 0a 20 20 20 20 20 20 20 20 20 20  ape)).          
3010: 20 20 20 28 78 20 28 61 72 72 61 79 3a 69 6e 64     (x (array:ind
3020: 65 78 20 73 68 61 70 65 29 29 29 0a 20 20 20 20  ex shape))).    
3030: 20 20 20 20 20 28 61 6e 64 20 28 3d 20 28 76 65       (and (= (ve
3040: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 75 29 20 34  ctor-length u) 4
3050: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
3060: 28 3d 20 28 76 65 63 74 6f 72 2d 72 65 66 20 75  (= (vector-ref u
3070: 20 30 29 20 30 29 0a 20 20 20 20 20 20 20 20 20   0) 0).         
3080: 20 20 20 20 20 28 3d 20 28 76 65 63 74 6f 72 2d       (= (vector-
3090: 72 65 66 20 75 20 32 29 20 30 29 0a 20 20 20 20  ref u 2) 0).    
30a0: 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 76 65            (= (ve
30b0: 63 74 6f 72 2d 72 65 66 20 75 20 33 29 20 32 29  ctor-ref u 3) 2)
30c0: 29 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 20  ).         (let 
30d0: 28 28 70 20 28 76 65 63 74 6f 72 2d 72 65 66 20  ((p (vector-ref 
30e0: 75 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20  u 1))).         
30f0: 20 20 28 64 6f 20 28 28 6b 20 30 20 28 2b 20 6b    (do ((k 0 (+ k
3100: 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20   1)).           
3110: 20 20 20 20 20 28 74 72 75 65 20 23 74 20 28 6c       (true #t (l
3120: 65 74 20 28 28 6c 6f 20 28 76 65 63 74 6f 72 2d  et ((lo (vector-
3130: 72 65 66 0a 20 20 20 20 20 20 20 20 20 20 20 20  ref.            
3140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3150: 20 20 20 20 20 20 20 20 76 0a 20 20 20 20 20 20          v.      
3160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61                (a
3180: 72 72 61 79 3a 73 68 61 70 65 2d 76 65 63 74 6f  rray:shape-vecto
3190: 72 2d 69 6e 64 65 78 20 78 20 6b 20 30 29 29 29  r-index x k 0)))
31a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
31b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
31c0: 28 68 69 20 28 76 65 63 74 6f 72 2d 72 65 66 0a  (hi (vector-ref.
31d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
31e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
31f0: 20 20 20 20 76 0a 20 20 20 20 20 20 20 20 20 20      v.          
3200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3210: 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79            (array
3220: 3a 73 68 61 70 65 2d 76 65 63 74 6f 72 2d 69 6e  :shape-vector-in
3230: 64 65 78 20 78 20 6b 20 31 29 29 29 29 0a 20 20  dex x k 1)))).  
3240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3250: 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 74 72           (and tr
3260: 75 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  ue.             
3270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3280: 20 20 20 28 69 6e 74 65 67 65 72 3f 20 6c 6f 29     (integer? lo)
3290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
32a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
32b0: 20 28 65 78 61 63 74 3f 20 6c 6f 29 0a 20 20 20   (exact? lo).   
32c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
32d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 6e               (in
32e0: 74 65 67 65 72 3f 20 68 69 29 0a 20 20 20 20 20  teger? hi).     
32f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3300: 20 20 20 20 20 20 20 20 20 20 20 28 65 78 61 63             (exac
3310: 74 3f 20 68 69 29 0a 20 20 20 20 20 20 20 20 20  t? hi).         
3320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3330: 20 20 20 20 20 20 20 28 3c 3d 20 6c 6f 20 68 69         (<= lo hi
3340: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20  ))))).          
3350: 20 20 20 28 28 3d 20 6b 20 70 29 20 74 72 75 65     ((= k p) true
3360: 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 61 72 72  ))))))..;;; (arr
3370: 61 79 3a 67 6f 6f 64 2d 73 68 61 72 65 3f 20 73  ay:good-share? s
3380: 75 62 76 20 73 75 62 73 69 7a 65 20 6d 61 70 70  ubv subsize mapp
3390: 69 6e 67 20 73 75 70 65 72 76 29 0a 3b 3b 3b 20  ing superv).;;; 
33a0: 72 65 74 75 72 6e 73 20 74 72 75 65 20 69 66 20  returns true if 
33b0: 74 68 65 20 65 78 74 72 65 6d 65 20 69 6e 64 69  the extreme indi
33c0: 63 65 73 20 69 6e 20 74 68 65 20 73 75 62 73 68  ces in the subsh
33d0: 61 70 65 20 76 65 63 74 6f 72 20 6d 61 70 0a 3b  ape vector map.;
33e0: 3b 3b 20 69 6e 74 6f 20 74 68 65 20 62 6f 75 6e  ;; into the boun
33f0: 64 73 20 69 6e 20 74 68 65 20 73 75 70 65 72 73  ds in the supers
3400: 68 61 70 65 20 76 65 63 74 6f 72 2e 0a 0a 3b 3b  hape vector...;;
3410: 3b 20 49 66 20 73 6f 6d 65 20 69 6e 74 65 72 76  ; If some interv
3420: 61 6c 20 69 6e 20 60 73 75 62 76 27 20 69 73 20  al in `subv' is 
3430: 65 6d 70 74 79 2c 20 74 68 65 6e 20 60 73 75 62  empty, then `sub
3440: 76 27 20 69 73 20 65 6d 70 74 79 20 61 6e 64 20  v' is empty and 
3450: 69 74 73 0a 3b 3b 3b 20 69 6d 61 67 65 20 75 6e  its.;;; image un
3460: 64 65 72 20 60 66 27 20 69 73 20 65 6d 70 74 79  der `f' is empty
3470: 20 61 6e 64 20 69 74 20 69 73 20 74 72 69 76 69   and it is trivi
3480: 61 6c 6c 79 20 61 6c 72 69 67 68 74 2e 20 20 4f  ally alright.  O
3490: 6e 65 20 6d 75 73 74 0a 3b 3b 3b 20 6e 6f 74 20  ne must.;;; not 
34a0: 63 61 6c 6c 20 60 66 27 2c 20 74 68 6f 75 67 68  call `f', though
34b0: 2e 0a 0a 28 64 65 66 69 6e 65 20 28 61 72 72 61  ...(define (arra
34c0: 79 3a 67 6f 6f 64 2d 73 68 61 72 65 3f 20 73 75  y:good-share? su
34d0: 62 73 68 61 70 65 20 73 75 62 73 69 7a 65 20 66  bshape subsize f
34e0: 20 73 75 70 65 72 29 0a 20 20 28 6f 72 20 28 7a   super).  (or (z
34f0: 65 72 6f 3f 20 73 75 62 73 69 7a 65 29 0a 20 20  ero? subsize).  
3500: 20 20 20 20 28 6c 65 74 72 65 63 0a 20 20 20 20      (letrec.    
3510: 20 20 20 20 20 20 28 28 73 75 62 20 28 61 72 72        ((sub (arr
3520: 61 79 3a 76 65 63 74 6f 72 20 73 75 62 73 68 61  ay:vector subsha
3530: 70 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  pe)).           
3540: 28 64 65 78 20 28 61 72 72 61 79 3a 69 6e 64 65  (dex (array:inde
3550: 78 20 73 75 62 73 68 61 70 65 29 29 0a 20 20 20  x subshape)).   
3560: 20 20 20 20 20 20 20 20 28 63 6b 20 28 6c 61 6d          (ck (lam
3570: 62 64 61 20 28 6b 20 6b 73 29 0a 09 09 20 28 69  bda (k ks)... (i
3580: 66 20 28 7a 65 72 6f 3f 20 6b 29 0a 20 20 20 20  f (zero? k).    
3590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
35a0: 20 28 63 61 6c 6c 2d 77 69 74 68 2d 76 61 6c 75   (call-with-valu
35b0: 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  es.             
35c0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61           (lambda
35d0: 20 28 29 20 28 61 70 70 6c 79 20 66 20 6b 73 29   () (apply f ks)
35e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
35f0: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20          (lambda 
3600: 71 73 20 28 61 72 72 61 79 3a 67 6f 6f 64 2d 69  qs (array:good-i
3610: 6e 64 69 63 65 73 3f 20 71 73 20 73 75 70 65 72  ndices? qs super
3620: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ))).            
3630: 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 63           (and (c
3640: 6b 20 28 2d 20 6b 20 31 29 0a 20 20 20 20 20 20  k (- k 1).      
3650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3660: 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 76          (cons (v
3670: 65 63 74 6f 72 2d 72 65 66 0a 20 20 20 20 20 20  ector-ref.      
3680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73                 s
36a0: 75 62 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  ub.             
36b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
36c0: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 73          (array:s
36d0: 68 61 70 65 2d 76 65 63 74 6f 72 2d 69 6e 64 65  hape-vector-inde
36e0: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  x.              
36f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3700: 20 20 20 20 20 20 20 20 64 65 78 0a 20 20 20 20          dex.    
3710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3730: 20 20 28 2d 20 6b 20 31 29 0a 20 20 20 20 20 20    (- k 1).      
3740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3760: 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  0)).            
3770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3780: 20 20 20 20 20 20 20 20 6b 73 29 29 0a 20 20 20          ks)).   
3790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
37a0: 20 20 20 20 20 20 20 28 63 6b 20 28 2d 20 6b 20         (ck (- k 
37b0: 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  1).             
37c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
37d0: 20 28 63 6f 6e 73 20 28 2d 20 28 76 65 63 74 6f   (cons (- (vecto
37e0: 72 2d 72 65 66 0a 20 20 20 20 20 20 20 20 20 20  r-ref.          
37f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 75                su
3810: 62 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  b.              
3820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3830: 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79            (array
3840: 3a 73 68 61 70 65 2d 76 65 63 74 6f 72 2d 69 6e  :shape-vector-in
3850: 64 65 78 0a 20 20 20 20 20 20 20 20 20 20 20 20  dex.            
3860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3870: 20 20 20 20 20 20 20 20 20 20 20 20 20 64 65 78               dex
3880: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
3890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
38a0: 20 20 20 20 20 20 20 20 20 20 28 2d 20 6b 20 31            (- k 1
38b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
38c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
38d0: 20 20 20 20 20 20 20 20 20 20 20 31 29 29 0a 20             1)). 
38e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
38f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3900: 20 20 20 20 20 20 31 29 0a 20 20 20 20 20 20 20        1).       
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 6b 73 29               ks)
3930: 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 28  )))))).        (
3940: 6c 65 74 20 28 28 72 6e 6b 20 28 76 65 63 74 6f  let ((rnk (vecto
3950: 72 2d 72 65 66 20 28 61 72 72 61 79 3a 73 68 61  r-ref (array:sha
3960: 70 65 20 73 75 62 73 68 61 70 65 29 20 31 29 29  pe subshape) 1))
3970: 29 0a 20 20 20 20 20 20 20 20 20 20 28 6f 72 20  ).          (or 
3980: 28 61 72 72 61 79 3a 75 6e 63 68 65 63 6b 65 64  (array:unchecked
3990: 2d 73 68 61 72 65 2d 64 65 70 74 68 3f 20 72 6e  -share-depth? rn
39a0: 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  k).             
39b0: 20 28 63 6b 20 72 6e 6b 20 27 28 29 29 29 29 29   (ck rnk '()))))
39c0: 29 29 0a 0a 3b 3b 3b 20 43 68 65 63 6b 20 67 6f  ))..;;; Check go
39d0: 6f 64 2d 73 68 61 72 65 20 6f 6e 20 31 30 20 64  od-share on 10 d
39e0: 69 6d 65 6e 73 69 6f 6e 73 20 61 74 20 6d 6f 73  imensions at mos
39f0: 74 2e 20 54 68 65 20 74 72 6f 75 62 6c 65 20 69  t. The trouble i
3a00: 73 2c 0a 3b 3b 3b 20 74 68 65 20 63 6f 73 74 20  s,.;;; the cost 
3a10: 6f 66 20 74 68 69 73 20 63 68 65 63 6b 20 69 73  of this check is
3a20: 20 65 78 70 6f 6e 65 6e 74 69 61 6c 20 69 6e 20   exponential in 
3a30: 74 68 65 20 6e 75 6d 62 65 72 20 6f 66 20 64 69  the number of di
3a40: 6d 65 6e 73 69 6f 6e 73 2e 0a 0a 28 64 65 66 69  mensions...(defi
3a50: 6e 65 20 28 61 72 72 61 79 3a 75 6e 63 68 65 63  ne (array:unchec
3a60: 6b 65 64 2d 73 68 61 72 65 2d 64 65 70 74 68 3f  ked-share-depth?
3a70: 20 72 61 6e 6b 29 0a 20 20 28 69 66 20 28 3e 20   rank).  (if (> 
3a80: 72 61 6e 6b 20 31 30 29 0a 20 20 20 20 20 20 28  rank 10).      (
3a90: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 28 64  begin.        (d
3aa0: 69 73 70 6c 61 79 20 60 28 77 61 72 6e 69 6e 67  isplay `(warning
3ab0: 3a 20 75 6e 63 68 65 63 6b 65 64 20 64 65 70 74  : unchecked dept
3ac0: 68 20 69 6e 20 73 68 61 72 65 3a 0a 20 20 20 20  h in share:.    
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 2c 72 61 6e 6b 20 73 75          ,rank su
3af0: 62 64 69 6d 65 6e 73 69 6f 6e 73 29 29 0a 20 20  bdimensions)).  
3b00: 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 0a        (newline).
3b10: 20 20 20 20 20 20 20 20 23 74 29 0a 20 20 20 20          #t).    
3b20: 20 20 23 66 29 29 0a 0a 3b 3b 3b 20 28 61 72 72    #f))..;;; (arr
3b30: 61 79 3a 63 68 65 63 6b 2d 69 6e 64 69 63 65 73  ay:check-indices
3b40: 20 63 61 6c 6c 65 72 20 69 6e 64 69 63 65 73 20   caller indices 
3b50: 73 68 61 70 65 2d 76 65 63 74 6f 72 29 0a 3b 3b  shape-vector).;;
3b60: 3b 20 28 61 72 72 61 79 3a 63 68 65 63 6b 2d 69  ; (array:check-i
3b70: 6e 64 69 63 65 73 2e 6f 20 63 61 6c 6c 65 72 20  ndices.o caller 
3b80: 69 6e 64 69 63 65 73 20 73 68 61 70 65 2d 76 65  indices shape-ve
3b90: 63 74 6f 72 29 0a 3b 3b 3b 20 28 61 72 72 61 79  ctor).;;; (array
3ba0: 3a 63 68 65 63 6b 2d 69 6e 64 65 78 2d 76 65 63  :check-index-vec
3bb0: 74 6f 72 20 63 61 6c 6c 65 72 20 69 6e 64 65 78  tor caller index
3bc0: 2d 76 65 63 74 6f 72 20 73 68 61 70 65 2d 76 65  -vector shape-ve
3bd0: 63 74 6f 72 29 0a 3b 3b 3b 20 72 65 74 75 72 6e  ctor).;;; return
3be0: 20 69 66 20 74 68 65 20 69 6e 64 65 78 20 69 73   if the index is
3bf0: 20 69 6e 20 62 6f 75 6e 64 73 2c 20 65 6c 73 65   in bounds, else
3c00: 20 73 69 67 6e 61 6c 20 65 72 72 6f 72 2e 0a 3b   signal error..;
3c10: 3b 3b 0a 3b 3b 3b 20 53 68 61 70 65 2d 76 65 63  ;;.;;; Shape-vec
3c20: 74 6f 72 20 69 73 20 74 68 65 20 69 6e 74 65 72  tor is the inter
3c30: 6e 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69  nal representati
3c40: 6f 6e 2c 20 77 69 74 68 0a 3b 3b 3b 20 62 20 61  on, with.;;; b a
3c50: 6e 64 20 65 20 66 6f 72 20 64 69 6d 65 6e 73 69  nd e for dimensi
3c60: 6f 6e 20 6b 20 61 74 20 32 6b 20 61 6e 64 20 32  on k at 2k and 2
3c70: 6b 20 2b 20 31 2e 0a 0a 28 64 65 66 69 6e 65 20  k + 1...(define 
3c80: 28 61 72 72 61 79 3a 63 68 65 63 6b 2d 69 6e 64  (array:check-ind
3c90: 69 63 65 73 20 77 68 6f 20 6b 73 20 73 68 76 29  ices who ks shv)
3ca0: 0a 20 20 28 6f 72 20 28 61 72 72 61 79 3a 67 6f  .  (or (array:go
3cb0: 6f 64 2d 69 6e 64 69 63 65 73 3f 20 6b 73 20 73  od-indices? ks s
3cc0: 68 76 29 0a 20 20 20 20 20 20 28 65 72 72 6f 72  hv).      (error
3cd0: 20 28 61 72 72 61 79 3a 6e 6f 74 2d 69 6e 20 77   (array:not-in w
3ce0: 68 6f 20 6b 73 20 73 68 76 29 29 29 29 0a 0a 28  ho ks shv))))..(
3cf0: 64 65 66 69 6e 65 20 28 61 72 72 61 79 3a 63 68  define (array:ch
3d00: 65 63 6b 2d 69 6e 64 69 63 65 73 2e 6f 20 77 68  eck-indices.o wh
3d10: 6f 20 6b 73 20 73 68 76 29 0a 20 20 28 6f 72 20  o ks shv).  (or 
3d20: 28 61 72 72 61 79 3a 67 6f 6f 64 2d 69 6e 64 69  (array:good-indi
3d30: 63 65 73 2e 6f 3f 20 6b 73 20 73 68 76 29 0a 20  ces.o? ks shv). 
3d40: 20 20 20 20 20 28 65 72 72 6f 72 20 28 61 72 72       (error (arr
3d50: 61 79 3a 6e 6f 74 2d 69 6e 20 77 68 6f 20 28 72  ay:not-in who (r
3d60: 65 76 65 72 73 65 20 28 63 64 72 20 28 72 65 76  everse (cdr (rev
3d70: 65 72 73 65 20 6b 73 29 29 29 20 73 68 76 29 29  erse ks))) shv))
3d80: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 61 72 72  ))..(define (arr
3d90: 61 79 3a 63 68 65 63 6b 2d 69 6e 64 65 78 2d 76  ay:check-index-v
3da0: 65 63 74 6f 72 20 77 68 6f 20 6b 73 20 73 68 76  ector who ks shv
3db0: 29 0a 20 20 28 6f 72 20 28 61 72 72 61 79 3a 67  ).  (or (array:g
3dc0: 6f 6f 64 2d 69 6e 64 65 78 2d 76 65 63 74 6f 72  ood-index-vector
3dd0: 3f 20 6b 73 20 73 68 76 29 0a 20 20 20 20 20 20  ? ks shv).      
3de0: 28 65 72 72 6f 72 20 28 61 72 72 61 79 3a 6e 6f  (error (array:no
3df0: 74 2d 69 6e 20 77 68 6f 20 28 76 65 63 74 6f 72  t-in who (vector
3e00: 2d 3e 6c 69 73 74 20 6b 73 29 20 73 68 76 29 29  ->list ks) shv))
3e10: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 61 72 72  ))..(define (arr
3e20: 61 79 3a 63 68 65 63 6b 2d 69 6e 64 65 78 2d 61  ay:check-index-a
3e30: 63 74 6f 72 20 77 68 6f 20 6b 73 20 73 68 76 29  ctor who ks shv)
3e40: 0a 20 20 28 6c 65 74 20 28 28 73 68 61 70 65 20  .  (let ((shape 
3e50: 28 61 72 72 61 79 3a 73 68 61 70 65 20 6b 73 29  (array:shape ks)
3e60: 29 29 0a 20 20 20 20 28 6f 72 20 28 61 6e 64 20  )).    (or (and 
3e70: 28 3d 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74  (= (vector-lengt
3e80: 68 20 73 68 61 70 65 29 20 32 29 0a 20 20 20 20  h shape) 2).    
3e90: 20 20 20 20 20 20 20 20 20 28 3d 20 28 76 65 63           (= (vec
3ea0: 74 6f 72 2d 72 65 66 20 73 68 61 70 65 20 30 29  tor-ref shape 0)
3eb0: 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 65 72   0)).        (er
3ec0: 72 6f 72 20 22 6e 6f 74 20 61 6e 20 61 63 74 6f  ror "not an acto
3ed0: 72 22 29 29 0a 20 20 20 20 28 6f 72 20 28 61 72  r")).    (or (ar
3ee0: 72 61 79 3a 67 6f 6f 64 2d 69 6e 64 65 78 2d 61  ray:good-index-a
3ef0: 63 74 6f 72 3f 0a 20 20 20 20 20 20 20 20 20 28  ctor?.         (
3f00: 76 65 63 74 6f 72 2d 72 65 66 20 73 68 61 70 65  vector-ref shape
3f10: 20 31 29 0a 20 20 20 20 20 20 20 20 20 28 61 72   1).         (ar
3f20: 72 61 79 3a 76 65 63 74 6f 72 20 6b 73 29 0a 20  ray:vector ks). 
3f30: 20 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 69          (array:i
3f40: 6e 64 65 78 20 6b 73 29 0a 20 20 20 20 20 20 20  ndex ks).       
3f50: 20 20 73 68 76 29 0a 20 20 20 20 20 20 20 20 28    shv).        (
3f60: 61 72 72 61 79 3a 6e 6f 74 2d 69 6e 20 77 68 6f  array:not-in who
3f70: 20 28 64 6f 20 28 28 6b 20 28 76 65 63 74 6f 72   (do ((k (vector
3f80: 2d 72 65 66 20 73 68 61 70 65 20 31 29 20 28 2d  -ref shape 1) (-
3f90: 20 6b 20 31 29 29 0a 20 20 20 20 20 20 20 20 20   k 1)).         
3fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3fb0: 20 20 20 20 20 20 28 6d 20 27 28 29 20 28 63 6f        (m '() (co
3fc0: 6e 73 20 28 76 65 63 74 6f 72 2d 72 65 66 0a 20  ns (vector-ref. 
3fd0: 20 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 20 20                  
3ff0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72              (arr
4000: 61 79 3a 76 65 63 74 6f 72 20 6b 73 29 0a 20 20  ay:vector ks).  
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4030: 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61             (arra
4040: 79 3a 61 63 74 6f 72 2d 69 6e 64 65 78 0a 20 20  y:actor-index.  
4050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4070: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72 72              (arr
4080: 61 79 3a 69 6e 64 65 78 20 6b 73 29 0a 20 20 20  ay:index ks).   
4090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
40a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
40b0: 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 6b 20             (- k 
40c0: 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  1))).           
40d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
40e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
40f0: 20 6d 29 29 29 0a 20 20 20 20 20 20 20 20 20 20   m))).          
4100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4110: 20 20 28 28 3d 20 6b 20 30 29 20 6d 29 29 0a 20    ((= k 0) m)). 
4120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4130: 20 20 20 20 20 73 68 76 29 29 29 29 0a 0a 28 64       shv))))..(d
4140: 65 66 69 6e 65 20 28 61 72 72 61 79 3a 67 6f 6f  efine (array:goo
4150: 64 2d 69 6e 64 69 63 65 73 3f 20 6b 73 20 73 68  d-indices? ks sh
4160: 76 29 0a 20 20 20 28 6c 65 74 20 28 28 64 32 20  v).   (let ((d2 
4170: 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 73  (vector-length s
4180: 68 76 29 29 29 0a 20 20 20 20 20 20 28 64 6f 20  hv))).      (do 
4190: 28 28 6b 70 20 6b 73 20 28 69 66 20 28 70 61 69  ((kp ks (if (pai
41a0: 72 3f 20 6b 70 29 0a 20 20 20 20 20 20 20 20 20  r? kp).         
41b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64               (cd
41c0: 72 20 6b 70 29 29 29 0a 20 20 20 20 20 20 20 20  r kp))).        
41d0: 20 20 20 28 6b 20 30 20 28 2b 20 6b 20 32 29 29     (k 0 (+ k 2))
41e0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 74 72 75  .           (tru
41f0: 65 20 23 74 20 28 61 6e 64 20 74 72 75 65 20 28  e #t (and true (
4200: 70 61 69 72 3f 20 6b 70 29 0a 20 20 20 20 20 20  pair? kp).      
4210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4220: 20 20 20 28 61 72 72 61 79 3a 67 6f 6f 64 2d 69     (array:good-i
4230: 6e 64 65 78 3f 20 28 63 61 72 20 6b 70 29 20 73  ndex? (car kp) s
4240: 68 76 20 6b 29 29 29 29 0a 20 20 20 20 20 20 20  hv k)))).       
4250: 20 28 28 3d 20 6b 20 64 32 29 0a 20 20 20 20 20   ((= k d2).     
4260: 20 20 20 20 28 61 6e 64 20 74 72 75 65 20 28 6e      (and true (n
4270: 75 6c 6c 3f 20 6b 70 29 29 29 29 29 29 0a 0a 28  ull? kp))))))..(
4280: 64 65 66 69 6e 65 20 28 61 72 72 61 79 3a 67 6f  define (array:go
4290: 6f 64 2d 69 6e 64 69 63 65 73 2e 6f 3f 20 6b 73  od-indices.o? ks
42a0: 2e 6f 20 73 68 76 29 0a 20 20 20 28 6c 65 74 20  .o shv).   (let 
42b0: 28 28 64 32 20 28 76 65 63 74 6f 72 2d 6c 65 6e  ((d2 (vector-len
42c0: 67 74 68 20 73 68 76 29 29 29 0a 20 20 20 20 20  gth shv))).     
42d0: 28 64 6f 20 20 20 28 28 6b 70 20 6b 73 2e 6f 20  (do   ((kp ks.o 
42e0: 28 69 66 20 28 70 61 69 72 3f 20 6b 70 29 0a 20  (if (pair? kp). 
42f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4300: 20 20 20 20 20 20 20 20 28 63 64 72 20 6b 70 29          (cdr kp)
4310: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  )).            (
4320: 6b 20 30 20 28 2b 20 6b 20 32 29 29 0a 20 20 20  k 0 (+ k 2)).   
4330: 20 20 20 20 20 20 20 20 20 28 74 72 75 65 20 23           (true #
4340: 74 20 28 61 6e 64 20 74 72 75 65 20 28 70 61 69  t (and true (pai
4350: 72 3f 20 6b 70 29 0a 20 20 20 20 20 20 20 20 20  r? kp).         
4360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4370: 20 28 61 72 72 61 79 3a 67 6f 6f 64 2d 69 6e 64   (array:good-ind
4380: 65 78 3f 20 28 63 61 72 20 6b 70 29 20 73 68 76  ex? (car kp) shv
4390: 20 6b 29 29 29 29 0a 20 20 20 20 20 20 20 28 28   k)))).       ((
43a0: 3d 20 6b 20 64 32 29 0a 20 20 20 20 20 20 20 20  = k d2).        
43b0: 28 61 6e 64 20 74 72 75 65 20 28 70 61 69 72 3f  (and true (pair?
43c0: 20 6b 70 29 20 28 6e 75 6c 6c 3f 20 28 63 64 72   kp) (null? (cdr
43d0: 20 6b 70 29 29 29 29 29 29 29 0a 0a 28 64 65 66   kp)))))))..(def
43e0: 69 6e 65 20 28 61 72 72 61 79 3a 67 6f 6f 64 2d  ine (array:good-
43f0: 69 6e 64 65 78 2d 76 65 63 74 6f 72 3f 20 6b 73  index-vector? ks
4400: 20 73 68 76 29 0a 20 20 28 6c 65 74 20 28 28 72   shv).  (let ((r
4410: 32 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68  2 (vector-length
4420: 20 73 68 76 29 29 29 0a 20 20 20 20 28 61 6e 64   shv))).    (and
4430: 20 28 3d 20 28 2a 20 32 20 28 76 65 63 74 6f 72   (= (* 2 (vector
4440: 2d 6c 65 6e 67 74 68 20 6b 73 29 29 20 72 32 29  -length ks)) r2)
4450: 0a 20 20 20 20 20 20 20 20 20 28 64 6f 20 28 28  .         (do ((
4460: 6a 20 30 20 28 2b 20 6a 20 31 29 29 0a 20 20 20  j 0 (+ j 1)).   
4470: 20 20 20 20 20 20 20 20 20 20 20 28 6b 20 30 20             (k 0 
4480: 28 2b 20 6b 20 32 29 29 0a 20 20 20 20 20 20 20  (+ k 2)).       
4490: 20 20 20 20 20 20 20 28 74 72 75 65 20 23 74 20         (true #t 
44a0: 28 61 6e 64 20 74 72 75 65 0a 20 20 20 20 20 20  (and true.      
44b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
44c0: 20 20 20 20 20 20 28 61 72 72 61 79 3a 67 6f 6f        (array:goo
44d0: 64 2d 69 6e 64 65 78 3f 20 28 76 65 63 74 6f 72  d-index? (vector
44e0: 2d 72 65 66 20 6b 73 20 6a 29 20 73 68 76 20 6b  -ref ks j) shv k
44f0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  )))).           
4500: 28 28 3d 20 6b 20 72 32 29 20 74 72 75 65 29 29  ((= k r2) true))
4510: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 61 72  )))..(define (ar
4520: 72 61 79 3a 67 6f 6f 64 2d 69 6e 64 65 78 2d 61  ray:good-index-a
4530: 63 74 6f 72 3f 20 72 20 76 20 69 20 73 68 76 29  ctor? r v i shv)
4540: 0a 20 20 28 61 6e 64 20 28 3d 20 28 2a 20 32 20  .  (and (= (* 2 
4550: 72 29 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74  r) (vector-lengt
4560: 68 20 73 68 76 29 29 0a 20 20 20 20 20 20 20 28  h shv)).       (
4570: 64 6f 20 28 28 6a 20 30 20 28 2b 20 6a 20 31 29  do ((j 0 (+ j 1)
4580: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6b  ).            (k
4590: 20 30 20 28 2b 20 6b 20 32 29 29 0a 20 20 20 20   0 (+ k 2)).    
45a0: 20 20 20 20 20 20 20 20 28 74 72 75 65 20 23 74          (true #t
45b0: 20 28 61 6e 64 20 74 72 75 65 0a 20 20 20 20 20   (and true.     
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
45d0: 20 20 20 20 20 28 61 72 72 61 79 3a 67 6f 6f 64       (array:good
45e0: 2d 69 6e 64 65 78 3f 20 28 76 65 63 74 6f 72 2d  -index? (vector-
45f0: 72 65 66 0a 20 20 20 20 20 20 20 20 20 20 20 20  ref.            
4600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4620: 20 20 76 0a 20 20 20 20 20 20 20 20 20 20 20 20    v.            
4630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4650: 20 20 28 61 72 72 61 79 3a 61 63 74 6f 72 2d 69    (array:actor-i
4660: 6e 64 65 78 20 69 20 6a 29 29 0a 20 20 20 20 20  ndex i j)).     
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4690: 20 20 20 20 20 20 20 20 73 68 76 0a 20 20 20 20          shv.    
46a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
46b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
46c0: 20 20 20 20 20 20 20 20 20 6b 29 29 29 29 0a 20           k)))). 
46d0: 20 20 20 20 20 20 20 20 28 28 3d 20 6a 20 72 29          ((= j r)
46e0: 20 74 72 75 65 29 29 29 29 0a 0a 3b 3b 3b 20 28   true))))..;;; (
46f0: 61 72 72 61 79 3a 67 6f 6f 64 2d 69 6e 64 65 78  array:good-index
4700: 3f 20 69 6e 64 65 78 20 73 68 61 70 65 2d 76 65  ? index shape-ve
4710: 63 74 6f 72 20 32 64 29 0a 3b 3b 3b 20 72 65 74  ctor 2d).;;; ret
4720: 75 72 6e 73 20 74 72 75 65 20 69 66 20 69 6e 64  urns true if ind
4730: 65 78 20 69 73 20 77 69 74 68 69 6e 20 62 6f 75  ex is within bou
4740: 6e 64 73 20 66 6f 72 20 64 69 6d 65 6e 73 69 6f  nds for dimensio
4750: 6e 20 32 64 2f 32 2e 0a 0a 28 64 65 66 69 6e 65  n 2d/2...(define
4760: 20 28 61 72 72 61 79 3a 67 6f 6f 64 2d 69 6e 64   (array:good-ind
4770: 65 78 3f 20 77 20 73 68 76 20 6b 29 0a 20 20 28  ex? w shv k).  (
4780: 61 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 77 29  and (integer? w)
4790: 0a 20 20 20 20 20 20 20 28 65 78 61 63 74 3f 20  .       (exact? 
47a0: 77 29 0a 20 20 20 20 20 20 20 28 3c 3d 20 28 76  w).       (<= (v
47b0: 65 63 74 6f 72 2d 72 65 66 20 73 68 76 20 6b 29  ector-ref shv k)
47c0: 20 77 29 0a 20 20 20 20 20 20 20 28 3c 20 77 20   w).       (< w 
47d0: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 68 76 20  (vector-ref shv 
47e0: 28 2b 20 6b 20 31 29 29 29 29 29 0a 0a 28 64 65  (+ k 1)))))..(de
47f0: 66 69 6e 65 20 28 61 72 72 61 79 3a 6e 6f 74 2d  fine (array:not-
4800: 69 6e 20 77 68 6f 20 6b 73 20 73 68 76 29 0a 20  in who ks shv). 
4810: 20 28 6c 65 74 20 28 28 69 6e 64 65 78 20 28 61   (let ((index (a
4820: 72 72 61 79 3a 6c 69 73 74 2d 3e 73 74 72 69 6e  rray:list->strin
4830: 67 20 6b 73 29 29 0a 20 20 20 20 20 20 20 20 28  g ks)).        (
4840: 62 6f 75 6e 64 73 20 28 61 72 72 61 79 3a 73 68  bounds (array:sh
4850: 61 70 65 2d 76 65 63 74 6f 72 2d 3e 73 74 72 69  ape-vector->stri
4860: 6e 67 20 73 68 76 29 29 29 0a 20 20 20 20 28 65  ng shv))).    (e
4870: 72 72 6f 72 20 28 73 74 72 69 6e 67 2d 61 70 70  rror (string-app
4880: 65 6e 64 20 77 68 6f 0a 20 20 20 20 20 20 20 20  end who.        
4890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
48a0: 20 20 22 3a 20 69 6e 64 65 78 20 22 20 69 6e 64    ": index " ind
48b0: 65 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  ex.             
48c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 20 6e               " n
48d0: 6f 74 20 69 6e 20 62 6f 75 6e 64 73 20 22 20 62  ot in bounds " b
48e0: 6f 75 6e 64 73 29 29 29 29 0a 0a 28 64 65 66 69  ounds))))..(defi
48f0: 6e 65 20 28 61 72 72 61 79 3a 6c 69 73 74 2d 3e  ne (array:list->
4900: 73 74 72 69 6e 67 20 6b 73 29 0a 20 20 28 64 6f  string ks).  (do
4910: 20 28 28 69 6e 64 65 78 20 22 22 20 28 73 74 72   ((index "" (str
4920: 69 6e 67 2d 61 70 70 65 6e 64 20 69 6e 64 65 78  ing-append index
4930: 20 28 61 72 72 61 79 3a 74 68 69 6e 67 2d 3e 73   (array:thing->s
4940: 74 72 69 6e 67 20 28 63 61 72 20 6b 73 29 29 20  tring (car ks)) 
4950: 22 20 22 29 29 0a 20 20 20 20 20 20 20 28 6b 73  " ")).       (ks
4960: 20 6b 73 20 28 63 64 72 20 6b 73 29 29 29 0a 20   ks (cdr ks))). 
4970: 20 20 20 28 28 6e 75 6c 6c 3f 20 6b 73 29 20 69     ((null? ks) i
4980: 6e 64 65 78 29 29 29 0a 0a 28 64 65 66 69 6e 65  ndex)))..(define
4990: 20 28 61 72 72 61 79 3a 73 68 61 70 65 2d 76 65   (array:shape-ve
49a0: 63 74 6f 72 2d 3e 73 74 72 69 6e 67 20 73 68 76  ctor->string shv
49b0: 29 0a 20 20 28 64 6f 20 28 28 62 6f 75 6e 64 73  ).  (do ((bounds
49c0: 20 22 22 20 28 73 74 72 69 6e 67 2d 61 70 70 65   "" (string-appe
49d0: 6e 64 20 62 6f 75 6e 64 73 0a 20 20 20 20 20 20  nd bounds.      
49e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
49f0: 20 20 20 20 20 20 20 20 20 20 20 22 5b 22 0a 20             "[". 
4a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4a20: 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20  (number->string 
4a30: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 68 76 20  (vector-ref shv 
4a40: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  t)).            
4a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4a60: 20 20 20 20 20 22 2e 2e 22 0a 20 20 20 20 20 20       "..".      
4a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4a80: 20 20 20 20 20 20 20 20 20 20 20 28 6e 75 6d 62             (numb
4a90: 65 72 2d 3e 73 74 72 69 6e 67 20 28 76 65 63 74  er->string (vect
4aa0: 6f 72 2d 72 65 66 20 73 68 76 20 28 2b 20 74 20  or-ref shv (+ t 
4ab0: 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  1))).           
4ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4ad0: 20 20 20 20 20 20 22 29 22 0a 20 20 20 20 20 20        ")".      
4ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4af0: 20 20 20 20 20 20 20 20 20 20 20 22 20 22 29 29             " "))
4b00: 0a 20 20 20 20 20 20 20 28 74 20 30 20 28 2b 20  .       (t 0 (+ 
4b10: 74 20 32 29 29 29 0a 20 20 20 20 28 28 3d 20 74  t 2))).    ((= t
4b20: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20   (vector-length 
4b30: 73 68 76 29 29 20 62 6f 75 6e 64 73 29 29 29 0a  shv)) bounds))).
4b40: 0a 28 64 65 66 69 6e 65 20 28 61 72 72 61 79 3a  .(define (array:
4b50: 74 68 69 6e 67 2d 3e 73 74 72 69 6e 67 20 74 68  thing->string th
4b60: 69 6e 67 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20  ing).  (cond.   
4b70: 20 28 28 6e 75 6d 62 65 72 3f 20 74 68 69 6e 67   ((number? thing
4b80: 29 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e  ) (number->strin
4b90: 67 20 74 68 69 6e 67 29 29 0a 20 20 20 20 28 28  g thing)).    ((
4ba0: 73 79 6d 62 6f 6c 3f 20 74 68 69 6e 67 29 20 28  symbol? thing) (
4bb0: 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 22 23  string-append "#
4bc0: 3c 73 79 6d 62 6f 6c 3e 22 20 28 73 79 6d 62 6f  <symbol>" (symbo
4bd0: 6c 2d 3e 73 74 72 69 6e 67 20 74 68 69 6e 67 29  l->string thing)
4be0: 29 29 0a 20 20 20 20 28 28 63 68 61 72 3f 20 74  )).    ((char? t
4bf0: 68 69 6e 67 29 20 22 23 3c 63 68 61 72 3e 22 29  hing) "#<char>")
4c00: 0a 20 20 20 20 28 28 73 74 72 69 6e 67 3f 20 74  .    ((string? t
4c10: 68 69 6e 67 29 20 22 23 3c 73 74 72 69 6e 67 3e  hing) "#<string>
4c20: 22 29 0a 20 20 20 20 28 28 6c 69 73 74 3f 20 74  ").    ((list? t
4c30: 68 69 6e 67 29 20 28 73 74 72 69 6e 67 2d 61 70  hing) (string-ap
4c40: 70 65 6e 64 20 22 23 22 20 28 6e 75 6d 62 65 72  pend "#" (number
4c50: 2d 3e 73 74 72 69 6e 67 20 28 6c 65 6e 67 74 68  ->string (length
4c60: 20 74 68 69 6e 67 29 29 0a 20 20 20 20 20 20 20   thing)).       
4c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4c80: 20 20 20 20 20 20 20 20 20 20 20 22 3c 6c 69 73             "<lis
4c90: 74 3e 22 29 29 0a 20 20 20 20 20 20 20 20 20 20  t>")).          
4ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4cb0: 20 20 20 20 20 20 20 20 0a 20 20 20 20 28 28 70          .    ((p
4cc0: 61 69 72 3f 20 74 68 69 6e 67 29 20 22 23 3c 70  air? thing) "#<p
4cd0: 61 69 72 3e 22 29 0a 20 20 20 20 28 28 61 72 72  air>").    ((arr
4ce0: 61 79 3f 20 74 68 69 6e 67 29 20 22 23 3c 61 72  ay? thing) "#<ar
4cf0: 72 61 79 3e 22 29 0a 20 20 20 20 28 28 76 65 63  ray>").    ((vec
4d00: 74 6f 72 3f 20 74 68 69 6e 67 29 20 28 73 74 72  tor? thing) (str
4d10: 69 6e 67 2d 61 70 70 65 6e 64 20 22 23 22 20 28  ing-append "#" (
4d20: 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 0a 20  number->string. 
4d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4d50: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d          (vector-
4d60: 6c 65 6e 67 74 68 20 74 68 69 6e 67 29 29 0a 20  length thing)). 
4d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4d90: 20 20 20 22 3c 76 65 63 74 6f 72 3e 22 29 29 0a     "<vector>")).
4da0: 20 20 20 20 28 28 70 72 6f 63 65 64 75 72 65 3f      ((procedure?
4db0: 20 74 68 69 6e 67 29 20 22 23 3c 70 72 6f 63 65   thing) "#<proce
4dc0: 64 75 72 65 3e 22 29 0a 20 20 20 20 28 65 6c 73  dure>").    (els
4dd0: 65 0a 20 20 20 20 20 28 63 61 73 65 20 74 68 69  e.     (case thi
4de0: 6e 67 0a 20 20 20 20 20 20 20 28 28 28 29 29 20  ng.       ((()) 
4df0: 22 28 29 22 29 0a 20 20 20 20 20 20 20 28 28 23  "()").       ((#
4e00: 74 29 20 22 23 74 22 29 0a 20 20 20 20 20 20 20  t) "#t").       
4e10: 28 28 23 66 29 20 22 23 66 22 29 0a 20 20 20 20  ((#f) "#f").    
4e20: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20     (else.       
4e30: 20 22 23 3c 77 68 61 74 73 69 74 3e 22 29 29 29   "#<whatsit>")))
4e40: 29 29 0a 0a 3b 3b 3b 20 41 6e 64 20 74 6f 20 67  ))..;;; And to g
4e50: 72 6f 6b 20 61 6e 20 61 66 66 69 6e 65 20 6d 61  rok an affine ma
4e60: 70 2c 20 76 65 63 74 6f 72 2d 3e 76 65 63 74 6f  p, vector->vecto
4e70: 72 20 74 79 70 65 2e 20 43 6f 6c 75 6d 6e 20 6b  r type. Column k
4e80: 20 6f 66 20 61 72 72 0a 3b 3b 3b 20 77 69 6c 6c   of arr.;;; will
4e90: 20 63 6f 6e 74 61 69 6e 20 63 6f 65 66 66 69 63   contain coeffic
4ea0: 69 65 6e 74 73 20 6e 30 20 2e 2e 2e 20 6e 6d 20  ients n0 ... nm 
4eb0: 6f 66 20 31 20 6b 31 20 2e 2e 2e 20 6b 6d 20 66  of 1 k1 ... km f
4ec0: 6f 72 20 6b 74 68 20 76 61 6c 75 65 2e 0a 3b 3b  or kth value..;;
4ed0: 3b 20 0a 3b 3b 3b 20 54 68 65 73 65 20 61 72 65  ; .;;; These are
4ee0: 20 66 6f 72 20 74 68 65 20 65 72 72 6f 72 20 6d   for the error m
4ef0: 65 73 73 61 67 65 20 77 68 65 6e 20 73 68 61 72  essage when shar
4f00: 65 20 66 61 69 6c 73 2e 0a 0a 28 64 65 66 69 6e  e fails...(defin
4f10: 65 20 28 61 72 72 61 79 3a 69 6e 64 65 78 2d 72  e (array:index-r
4f20: 65 66 20 69 6e 64 20 6b 29 0a 20 20 28 69 66 20  ef ind k).  (if 
4f30: 28 76 65 63 74 6f 72 3f 20 69 6e 64 29 0a 20 20  (vector? ind).  
4f40: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20      (vector-ref 
4f50: 69 6e 64 20 6b 29 0a 20 20 20 20 20 20 28 76 65  ind k).      (ve
4f60: 63 74 6f 72 2d 72 65 66 0a 20 20 20 20 20 20 20  ctor-ref.       
4f70: 28 61 72 72 61 79 3a 76 65 63 74 6f 72 20 69 6e  (array:vector in
4f80: 64 29 0a 20 20 20 20 20 20 20 28 61 72 72 61 79  d).       (array
4f90: 3a 61 63 74 6f 72 2d 69 6e 64 65 78 20 28 61 72  :actor-index (ar
4fa0: 72 61 79 3a 69 6e 64 65 78 20 69 6e 64 29 20 6b  ray:index ind) k
4fb0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 61  ))))..(define (a
4fc0: 72 72 61 79 3a 69 6e 64 65 78 2d 73 65 74 21 20  rray:index-set! 
4fd0: 69 6e 64 20 6b 20 6f 29 0a 20 20 28 69 66 20 28  ind k o).  (if (
4fe0: 76 65 63 74 6f 72 3f 20 69 6e 64 29 0a 20 20 20  vector? ind).   
4ff0: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20     (vector-set! 
5000: 69 6e 64 20 6b 20 6f 29 0a 20 20 20 20 20 20 28  ind k o).      (
5010: 76 65 63 74 6f 72 2d 73 65 74 21 0a 20 20 20 20  vector-set!.    
5020: 20 20 20 28 61 72 72 61 79 3a 76 65 63 74 6f 72     (array:vector
5030: 20 69 6e 64 29 0a 20 20 20 20 20 20 20 28 61 72   ind).       (ar
5040: 72 61 79 3a 61 63 74 6f 72 2d 69 6e 64 65 78 20  ray:actor-index 
5050: 28 61 72 72 61 79 3a 69 6e 64 65 78 20 69 6e 64  (array:index ind
5060: 29 20 6b 29 0a 20 20 20 20 20 20 20 6f 29 29 29  ) k).       o)))
5070: 0a 0a 28 64 65 66 69 6e 65 20 28 61 72 72 61 79  ..(define (array
5080: 3a 69 6e 64 65 78 2d 6c 65 6e 67 74 68 20 69 6e  :index-length in
5090: 64 29 0a 20 20 28 69 66 20 28 76 65 63 74 6f 72  d).  (if (vector
50a0: 3f 20 69 6e 64 29 0a 20 20 20 20 20 20 28 76 65  ? ind).      (ve
50b0: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 69 6e 64 29  ctor-length ind)
50c0: 0a 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72  .      (vector-r
50d0: 65 66 20 28 61 72 72 61 79 3a 73 68 61 70 65 20  ef (array:shape 
50e0: 69 6e 64 29 20 31 29 29 29 0a 0a 28 64 65 66 69  ind) 1)))..(defi
50f0: 6e 65 20 28 61 72 72 61 79 3a 6d 61 70 2d 3e 73  ne (array:map->s
5100: 74 72 69 6e 67 20 70 72 6f 63 20 72 29 0a 20 20  tring proc r).  
5110: 28 6c 65 74 2a 20 28 28 6d 20 28 61 72 72 61 79  (let* ((m (array
5120: 3a 67 72 6f 6b 2f 61 72 67 75 6d 65 6e 74 73 20  :grok/arguments 
5130: 70 72 6f 63 20 72 29 29 0a 20 20 20 20 20 20 20  proc r)).       
5140: 20 20 28 73 20 28 76 65 63 74 6f 72 2d 72 65 66    (s (vector-ref
5150: 20 28 61 72 72 61 79 3a 73 68 61 70 65 20 6d 29   (array:shape m)
5160: 20 33 29 29 29 0a 20 20 20 20 28 64 6f 20 28 28   3))).    (do ((
5170: 69 20 22 22 20 28 73 74 72 69 6e 67 2d 61 70 70  i "" (string-app
5180: 65 6e 64 20 69 20 63 20 22 6b 22 20 28 6e 75 6d  end i c "k" (num
5190: 62 65 72 2d 3e 73 74 72 69 6e 67 20 6b 29 29 29  ber->string k)))
51a0: 0a 20 20 20 20 20 20 20 20 20 28 63 20 22 22 20  .         (c "" 
51b0: 22 2c 20 22 29 0a 20 20 20 20 20 20 20 20 20 28  ", ").         (
51c0: 6b 20 31 20 28 2b 20 6b 20 31 29 29 29 0a 20 20  k 1 (+ k 1))).  
51d0: 20 20 20 20 28 28 3c 20 72 20 6b 29 0a 20 20 20      ((< r k).   
51e0: 20 20 20 20 28 64 6f 20 28 28 6f 20 22 22 20 28      (do ((o "" (
51f0: 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 6f 20  string-append o 
5200: 63 20 28 61 72 72 61 79 3a 6d 61 70 2d 63 6f 6c  c (array:map-col
5210: 75 6d 6e 2d 3e 73 74 72 69 6e 67 20 6d 20 72 20  umn->string m r 
5220: 6b 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  k))).           
5230: 20 28 63 20 22 22 20 22 2c 20 22 29 0a 20 20 20   (c "" ", ").   
5240: 20 20 20 20 20 20 20 20 20 28 6b 20 30 20 28 2b           (k 0 (+
5250: 20 6b 20 31 29 29 29 0a 20 20 20 20 20 20 20 20   k 1))).        
5260: 20 28 28 3d 20 6b 20 73 29 0a 20 20 20 20 20 20   ((= k s).      
5270: 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65      (string-appe
5280: 6e 64 20 69 20 22 20 3d 3e 20 22 20 6f 29 29 29  nd i " => " o)))
5290: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 61  ))))..(define (a
52a0: 72 72 61 79 3a 6d 61 70 2d 63 6f 6c 75 6d 6e 2d  rray:map-column-
52b0: 3e 73 74 72 69 6e 67 20 6d 20 72 20 6b 29 0a 20  >string m r k). 
52c0: 20 28 6c 65 74 20 28 28 76 20 28 61 72 72 61 79   (let ((v (array
52d0: 3a 76 65 63 74 6f 72 20 6d 29 29 0a 20 20 20 20  :vector m)).    
52e0: 20 20 20 20 28 69 20 28 61 72 72 61 79 3a 69 6e      (i (array:in
52f0: 64 65 78 20 6d 29 29 29 0a 20 20 20 20 28 6c 65  dex m))).    (le
5300: 74 20 28 28 6e 30 20 28 76 65 63 74 6f 72 2d 72  t ((n0 (vector-r
5310: 65 66 20 76 20 28 61 72 72 61 79 3a 76 65 63 74  ef v (array:vect
5320: 6f 72 2d 69 6e 64 65 78 20 69 20 28 6c 69 73 74  or-index i (list
5330: 20 30 20 6b 29 29 29 29 29 0a 20 20 20 20 20 20   0 k))))).      
5340: 28 6c 65 74 20 77 6f 6b 20 28 28 6a 20 31 29 0a  (let wok ((j 1).
5350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5360: 28 65 20 28 69 66 20 28 3d 20 6e 30 20 30 29 20  (e (if (= n0 0) 
5370: 22 22 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69  "" (number->stri
5380: 6e 67 20 6e 30 29 29 29 29 0a 20 20 20 20 20 20  ng n0)))).      
5390: 20 20 28 69 66 20 28 3c 3d 20 6a 20 72 29 0a 20    (if (<= j r). 
53a0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20             (let 
53b0: 28 28 6e 6a 20 28 76 65 63 74 6f 72 2d 72 65 66  ((nj (vector-ref
53c0: 20 76 20 28 61 72 72 61 79 3a 76 65 63 74 6f 72   v (array:vector
53d0: 2d 69 6e 64 65 78 20 69 20 28 6c 69 73 74 20 6a  -index i (list j
53e0: 20 6b 29 29 29 29 29 0a 20 20 20 20 20 20 20 20   k))))).        
53f0: 20 20 20 20 20 20 28 69 66 20 28 3d 20 6e 6a 20        (if (= nj 
5400: 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  0).             
5410: 20 20 20 20 20 28 77 6f 6b 20 28 2b 20 6a 20 31       (wok (+ j 1
5420: 29 20 65 29 0a 20 20 20 20 20 20 20 20 20 20 20  ) e).           
5430: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6e         (let* ((n
5440: 6a 20 28 69 66 20 28 3d 20 6e 6a 20 31 29 20 22  j (if (= nj 1) "
5450: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ".              
5460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5470: 20 20 20 28 69 66 20 28 3d 20 6e 6a 20 2d 31 29     (if (= nj -1)
5480: 20 22 2d 22 0a 20 20 20 20 20 20 20 20 20 20 20   "-".           
5490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
54a0: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e            (strin
54b0: 67 2d 61 70 70 65 6e 64 20 28 6e 75 6d 62 65 72  g-append (number
54c0: 2d 3e 73 74 72 69 6e 67 20 6e 6a 29 0a 20 20 20  ->string nj).   
54d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
54e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
54f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5500: 20 22 20 22 29 29 29 29 0a 20 20 20 20 20 20 20   " ")))).       
5510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5520: 20 20 28 6e 6a 6b 6a 20 28 73 74 72 69 6e 67 2d    (njkj (string-
5530: 61 70 70 65 6e 64 20 6e 6a 20 22 6b 22 20 28 6e  append nj "k" (n
5540: 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 6a 29  umber->string j)
5550: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ))).            
5560: 20 20 20 20 20 20 20 20 28 69 66 20 28 73 74 72          (if (str
5570: 69 6e 67 3d 3f 20 65 20 22 22 29 0a 20 20 20 20  ing=? e "").    
5580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5590: 20 20 20 20 28 77 6f 6b 20 28 2b 20 6a 20 31 29      (wok (+ j 1)
55a0: 20 6e 6a 6b 6a 29 0a 20 20 20 20 20 20 20 20 20   njkj).         
55b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
55c0: 77 6f 6b 20 28 2b 20 6a 20 31 29 20 28 73 74 72  wok (+ j 1) (str
55d0: 69 6e 67 2d 61 70 70 65 6e 64 20 65 20 22 20 2b  ing-append e " +
55e0: 20 22 20 6e 6a 6b 6a 29 29 29 29 29 29 0a 20 20   " njkj)))))).  
55f0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73            (if (s
5600: 74 72 69 6e 67 3d 3f 20 65 20 22 22 29 20 22 30  tring=? e "") "0
5610: 22 20 65 29 29 29 29 29 29 0a 0a 28 64 65 66 69  " e))))))..(defi
5620: 6e 65 20 28 61 72 72 61 79 3a 67 72 6f 6b 2f 61  ne (array:grok/a
5630: 72 67 75 6d 65 6e 74 73 20 70 72 6f 63 20 72 29  rguments proc r)
5640: 0a 20 20 28 61 72 72 61 79 3a 67 72 6f 6b 2f 69  .  (array:grok/i
5650: 6e 64 65 78 21 0a 20 20 20 28 6c 61 6d 62 64 61  ndex!.   (lambda
5660: 20 28 76 65 63 29 0a 20 20 20 20 20 28 63 61 6c   (vec).     (cal
5670: 6c 2d 77 69 74 68 2d 76 61 6c 75 65 73 0a 20 20  l-with-values.  
5680: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20      (lambda (). 
5690: 20 20 20 20 20 20 20 28 61 72 72 61 79 3a 61 70         (array:ap
56a0: 70 6c 79 2d 74 6f 2d 76 65 63 74 6f 72 20 72 20  ply-to-vector r 
56b0: 70 72 6f 63 20 76 65 63 29 29 0a 20 20 20 20 20  proc vec)).     
56c0: 20 76 65 63 74 6f 72 29 29 0a 20 20 20 28 6d 61   vector)).   (ma
56d0: 6b 65 2d 76 65 63 74 6f 72 20 72 29 29 29 0a 0a  ke-vector r)))..
56e0: 28 64 65 66 69 6e 65 20 28 61 72 72 61 79 3a 67  (define (array:g
56f0: 72 6f 6b 2f 69 6e 64 65 78 21 20 70 72 6f 63 20  rok/index! proc 
5700: 69 6e 29 0a 20 20 28 6c 65 74 20 28 28 6d 20 28  in).  (let ((m (
5710: 61 72 72 61 79 3a 69 6e 64 65 78 2d 6c 65 6e 67  array:index-leng
5720: 74 68 20 69 6e 29 29 29 0a 20 20 20 20 28 64 6f  th in))).    (do
5730: 20 28 28 6b 20 30 20 28 2b 20 6b 20 31 29 29 29   ((k 0 (+ k 1)))
5740: 0a 20 20 20 20 20 20 28 28 3d 20 6b 20 6d 29 29  .      ((= k m))
5750: 0a 20 20 20 20 20 20 28 61 72 72 61 79 3a 69 6e  .      (array:in
5760: 64 65 78 2d 73 65 74 21 20 69 6e 20 6b 20 30 29  dex-set! in k 0)
5770: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 6e 30  ).    (let* ((n0
5780: 20 28 70 72 6f 63 20 69 6e 29 29 0a 20 20 20 20   (proc in)).    
5790: 20 20 20 20 20 20 20 28 6e 20 28 61 72 72 61 79         (n (array
57a0: 3a 69 6e 64 65 78 2d 6c 65 6e 67 74 68 20 6e 30  :index-length n0
57b0: 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28  ))).      (let (
57c0: 28 61 72 72 20 28 6d 61 6b 65 2d 61 72 72 61 79  (arr (make-array
57d0: 20 28 73 68 61 70 65 20 30 20 28 2b 20 6d 20 31   (shape 0 (+ m 1
57e0: 29 20 30 20 6e 29 29 29 29 20 20 3b 20 28 2a 29  ) 0 n))))  ; (*)
57f0: 0a 20 20 20 20 20 20 20 20 28 64 6f 20 28 28 6b  .        (do ((k
5800: 20 30 20 28 2b 20 6b 20 31 29 29 29 0a 20 20 20   0 (+ k 1))).   
5810: 20 20 20 20 20 20 20 28 28 3d 20 6b 20 6e 29 29         ((= k n))
5820: 0a 20 20 20 20 20 20 20 20 20 20 28 61 72 72 61  .          (arra
5830: 79 2d 73 65 74 21 20 61 72 72 20 30 20 6b 20 28  y-set! arr 0 k (
5840: 61 72 72 61 79 3a 69 6e 64 65 78 2d 72 65 66 20  array:index-ref 
5850: 6e 30 20 6b 29 29 29 20 3b 20 28 2a 2a 29 0a 20  n0 k))) ; (**). 
5860: 20 20 20 20 20 20 20 28 64 6f 20 28 28 6a 20 30         (do ((j 0
5870: 20 28 2b 20 6a 20 31 29 29 29 0a 20 20 20 20 20   (+ j 1))).     
5880: 20 20 20 20 20 28 28 3d 20 6a 20 6d 29 29 0a 20       ((= j m)). 
5890: 20 20 20 20 20 20 20 20 20 28 61 72 72 61 79 3a           (array:
58a0: 69 6e 64 65 78 2d 73 65 74 21 20 69 6e 20 6a 20  index-set! in j 
58b0: 31 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65  1).          (le
58c0: 74 20 28 28 6e 6a 20 28 70 72 6f 63 20 69 6e 29  t ((nj (proc in)
58d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  )).            (
58e0: 61 72 72 61 79 3a 69 6e 64 65 78 2d 73 65 74 21  array:index-set!
58f0: 20 69 6e 20 6a 20 30 29 0a 20 20 20 20 20 20 20   in j 0).       
5900: 20 20 20 20 20 28 64 6f 20 28 28 6b 20 30 20 28       (do ((k 0 (
5910: 2b 20 6b 20 31 29 29 29 0a 20 20 20 20 20 20 20  + k 1))).       
5920: 20 20 20 20 20 20 20 28 28 3d 20 6b 20 6e 29 29         ((= k n))
5930: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28  .              (
5940: 61 72 72 61 79 2d 73 65 74 21 20 61 72 72 20 28  array-set! arr (
5950: 2b 20 6a 20 31 29 20 6b 20 28 2d 20 28 61 72 72  + j 1) k (- (arr
5960: 61 79 3a 69 6e 64 65 78 2d 72 65 66 20 6e 6a 20  ay:index-ref nj 
5970: 6b 29 20 3b 20 28 2a 2a 29 0a 20 20 20 20 20 20  k) ; (**).      
5980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
59a0: 20 20 20 20 20 28 61 72 72 61 79 3a 69 6e 64 65       (array:inde
59b0: 78 2d 72 65 66 20 6e 30 20 6b 29 29 29 29 29 29  x-ref n0 k))))))
59c0: 0a 20 20 20 20 20 20 20 20 61 72 72 29 29 29 29  .        arr))))
59d0: 0a 3b 3b 20 28 2a 29 20 20 53 68 6f 75 6c 64 20  .;; (*)  Should 
59e0: 6e 6f 74 20 75 73 65 20 60 6d 61 6b 65 2d 61 72  not use `make-ar
59f0: 72 61 79 27 20 61 6e 64 20 60 73 68 61 70 65 27  ray' and `shape'
5a00: 20 68 65 72 65 0a 3b 3b 20 28 2a 2a 29 20 53 68   here.;; (**) Sh
5a10: 6f 75 6c 64 20 6e 6f 74 20 75 73 65 20 60 61 72  ould not use `ar
5a20: 72 61 79 2d 73 65 74 21 27 20 68 65 72 65 0a 3b  ray-set!' here.;
5a30: 3b 20 53 68 6f 75 6c 64 20 75 73 65 20 73 6f 6d  ; Should use som
5a40: 65 74 68 69 6e 67 20 69 6e 74 65 72 6e 61 6c 20  ething internal 
5a50: 74 6f 20 74 68 65 20 6c 69 62 72 61 72 79 20 69  to the library i
5a60: 6e 73 74 65 61 64 3a 20 65 69 74 68 65 72 20 6c  nstead: either l
5a70: 6f 77 65 72 0a 3b 3b 20 6c 65 76 65 6c 20 63 6f  ower.;; level co
5a80: 64 65 20 28 70 72 65 66 65 72 61 62 6c 65 20 62  de (preferable b
5a90: 75 74 20 63 6f 6d 70 6c 65 78 29 20 6f 72 20 61  ut complex) or a
5aa0: 6c 74 65 72 6e 61 74 69 76 65 20 6e 61 6d 65 73  lternative names
5ab0: 20 74 6f 20 74 68 65 73 65 20 73 61 6d 65 2e 0a   to these same..