Hex Artifact Content
Not logged in

Artifact e1221fada16e9b47a182348fb459784aebfef1cc:


0000: 23 21 72 36 72 73 0a 3b 3b 20 43 6f 70 79 72 69  #!r6rs.;; Copyri
0010: 67 68 74 20 28 63 29 20 32 30 30 39 20 44 65 72  ght (c) 2009 Der
0020: 69 63 6b 20 45 64 64 69 6e 67 74 6f 6e 2e 20 20  ick Eddington.  
0030: 41 6c 6c 20 72 69 67 68 74 73 20 72 65 73 65 72  All rights reser
0040: 76 65 64 2e 0a 3b 3b 20 4c 69 63 65 6e 73 65 64  ved..;; Licensed
0050: 20 75 6e 64 65 72 20 61 6e 20 4d 49 54 2d 73 74   under an MIT-st
0060: 79 6c 65 20 6c 69 63 65 6e 73 65 2e 20 20 4d 79  yle license.  My
0070: 20 6c 69 63 65 6e 73 65 20 69 73 20 69 6e 20 74   license is in t
0080: 68 65 20 66 69 6c 65 0a 3b 3b 20 6e 61 6d 65 64  he file.;; named
0090: 20 4c 49 43 45 4e 53 45 20 66 72 6f 6d 20 74 68   LICENSE from th
00a0: 65 20 6f 72 69 67 69 6e 61 6c 20 63 6f 6c 6c 65  e original colle
00b0: 63 74 69 6f 6e 20 74 68 69 73 20 66 69 6c 65 20  ction this file 
00c0: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 0a 3b  is distributed.;
00d0: 3b 20 77 69 74 68 2e 20 20 49 66 20 74 68 69 73  ; with.  If this
00e0: 20 66 69 6c 65 20 69 73 20 72 65 64 69 73 74 72   file is redistr
00f0: 69 62 75 74 65 64 20 77 69 74 68 20 73 6f 6d 65  ibuted with some
0100: 20 6f 74 68 65 72 20 63 6f 6c 6c 65 63 74 69 6f   other collectio
0110: 6e 2c 20 6d 79 0a 3b 3b 20 6c 69 63 65 6e 73 65  n, my.;; license
0120: 20 6d 75 73 74 20 61 6c 73 6f 20 62 65 20 69 6e   must also be in
0130: 63 6c 75 64 65 64 2e 0a 0a 28 6c 69 62 72 61 72  cluded...(librar
0140: 79 20 28 73 72 66 69 20 73 32 35 20 6d 75 6c 74  y (srfi s25 mult
0150: 69 2d 64 69 6d 65 6e 73 69 6f 6e 61 6c 2d 61 72  i-dimensional-ar
0160: 72 61 79 73 20 61 6c 6c 29 0a 20 20 28 65 78 70  rays all).  (exp
0170: 6f 72 74 0a 20 20 20 20 61 72 72 61 79 3a 6d 61  ort.    array:ma
0180: 6b 65 0a 20 20 20 20 61 72 72 61 79 3a 61 72 72  ke.    array:arr
0190: 61 79 3f 0a 20 20 20 20 61 72 72 61 79 3a 76 65  ay?.    array:ve
01a0: 63 74 6f 72 0a 20 20 20 20 61 72 72 61 79 3a 69  ctor.    array:i
01b0: 6e 64 65 78 0a 20 20 20 20 61 72 72 61 79 3a 73  ndex.    array:s
01c0: 68 61 70 65 0a 20 20 20 20 61 72 72 61 79 2d 72  hape.    array-r
01d0: 65 66 0a 20 20 20 20 61 72 72 61 79 2d 73 65 74  ef.    array-set
01e0: 21 0a 20 20 20 20 61 72 72 61 79 3a 6f 70 74 2d  !.    array:opt-
01f0: 61 72 67 73 0a 20 20 20 20 61 72 72 61 79 3a 6f  args.    array:o
0200: 70 74 69 6d 69 7a 65 0a 20 20 20 20 61 72 72 61  ptimize.    arra
0210: 79 3a 6f 70 74 69 6d 69 7a 65 2d 65 6d 70 74 79  y:optimize-empty
0220: 0a 20 20 20 20 61 72 72 61 79 3a 63 6f 65 66 66  .    array:coeff
0230: 69 63 69 65 6e 74 73 0a 20 20 20 20 61 72 72 61  icients.    arra
0240: 79 3a 76 65 63 74 6f 72 2d 69 6e 64 65 78 0a 20  y:vector-index. 
0250: 20 20 20 61 72 72 61 79 3a 73 68 61 70 65 2d 69     array:shape-i
0260: 6e 64 65 78 0a 20 20 20 20 61 72 72 61 79 3a 65  ndex.    array:e
0270: 6d 70 74 79 2d 73 68 61 70 65 2d 69 6e 64 65 78  mpty-shape-index
0280: 0a 20 20 20 20 61 72 72 61 79 3a 73 68 61 70 65  .    array:shape
0290: 2d 76 65 63 74 6f 72 2d 69 6e 64 65 78 0a 20 20  -vector-index.  
02a0: 20 20 61 72 72 61 79 3a 61 63 74 6f 72 2d 69 6e    array:actor-in
02b0: 64 65 78 0a 20 20 20 20 61 72 72 61 79 3a 30 0a  dex.    array:0.
02c0: 20 20 20 20 61 72 72 61 79 3a 31 0a 20 20 20 20      array:1.    
02d0: 61 72 72 61 79 3a 32 0a 20 20 20 20 61 72 72 61  array:2.    arra
02e0: 79 3a 33 0a 20 20 20 20 61 72 72 61 79 3a 6e 0a  y:3.    array:n.
02f0: 20 20 20 20 61 72 72 61 79 3a 6d 61 6b 65 72 0a      array:maker.
0300: 20 20 20 20 61 72 72 61 79 3a 69 6e 64 65 78 65      array:indexe
0310: 72 2f 76 65 63 74 6f 72 0a 20 20 20 20 61 72 72  r/vector.    arr
0320: 61 79 3a 69 6e 64 65 78 65 72 2f 61 72 72 61 79  ay:indexer/array
0330: 0a 20 20 20 20 61 72 72 61 79 3a 61 70 70 6c 69  .    array:appli
0340: 65 72 2d 74 6f 2d 76 65 63 74 6f 72 0a 20 20 20  er-to-vector.   
0350: 20 61 72 72 61 79 3a 61 70 70 6c 69 65 72 2d 74   array:applier-t
0360: 6f 2d 61 63 74 6f 72 0a 20 20 20 20 61 72 72 61  o-actor.    arra
0370: 79 3a 61 70 70 6c 69 65 72 2d 74 6f 2d 62 61 63  y:applier-to-bac
0380: 6b 69 6e 67 2d 76 65 63 74 6f 72 0a 20 20 20 20  king-vector.    
0390: 61 72 72 61 79 3a 69 6e 64 65 78 2f 76 65 63 74  array:index/vect
03a0: 6f 72 0a 20 20 20 20 61 72 72 61 79 3a 69 6e 64  or.    array:ind
03b0: 65 78 2f 61 72 72 61 79 0a 20 20 20 20 61 72 72  ex/array.    arr
03c0: 61 79 3a 61 70 70 6c 79 2d 74 6f 2d 76 65 63 74  ay:apply-to-vect
03d0: 6f 72 0a 20 20 20 20 61 72 72 61 79 3a 61 70 70  or.    array:app
03e0: 6c 79 2d 74 6f 2d 61 63 74 6f 72 0a 20 20 20 20  ly-to-actor.    
03f0: 61 72 72 61 79 3f 0a 20 20 20 20 6d 61 6b 65 2d  array?.    make-
0400: 61 72 72 61 79 0a 20 20 20 20 61 72 72 61 79 3a  array.    array:
0410: 6d 61 6b 65 2d 61 72 72 61 79 0a 20 20 20 20 73  make-array.    s
0420: 68 61 70 65 0a 20 20 20 20 61 72 72 61 79 0a 20  hape.    array. 
0430: 20 20 20 61 72 72 61 79 2d 72 61 6e 6b 0a 20 20     array-rank.  
0440: 20 20 61 72 72 61 79 2d 73 74 61 72 74 0a 20 20    array-start.  
0450: 20 20 61 72 72 61 79 2d 65 6e 64 0a 20 20 20 20    array-end.    
0460: 73 68 61 72 65 2d 61 72 72 61 79 0a 20 20 20 20  share-array.    
0470: 61 72 72 61 79 3a 73 68 61 72 65 2f 69 6e 64 65  array:share/inde
0480: 78 21 0a 20 20 20 20 61 72 72 61 79 3a 6f 70 74  x!.    array:opt
0490: 69 6d 69 7a 65 2f 76 65 63 74 6f 72 0a 20 20 20  imize/vector.   
04a0: 20 61 72 72 61 79 3a 6f 70 74 69 6d 69 7a 65 2f   array:optimize/
04b0: 61 63 74 6f 72 0a 20 20 20 20 61 72 72 61 79 3a  actor.    array:
04c0: 73 68 61 70 65 2d 3e 76 65 63 74 6f 72 0a 20 20  shape->vector.  
04d0: 20 20 61 72 72 61 79 3a 73 69 7a 65 0a 20 20 20    array:size.   
04e0: 20 61 72 72 61 79 3a 6d 61 6b 65 2d 69 6e 64 65   array:make-inde
04f0: 78 0a 20 20 20 20 61 72 72 61 79 3a 67 6f 6f 64  x.    array:good
0500: 2d 73 68 61 70 65 3f 0a 20 20 20 20 61 72 72 61  -shape?.    arra
0510: 79 3a 67 6f 6f 64 2d 73 68 61 72 65 3f 0a 20 20  y:good-share?.  
0520: 20 20 61 72 72 61 79 3a 75 6e 63 68 65 63 6b 65    array:unchecke
0530: 64 2d 73 68 61 72 65 2d 64 65 70 74 68 3f 0a 20  d-share-depth?. 
0540: 20 20 20 61 72 72 61 79 3a 63 68 65 63 6b 2d 69     array:check-i
0550: 6e 64 69 63 65 73 0a 20 20 20 20 61 72 72 61 79  ndices.    array
0560: 3a 63 68 65 63 6b 2d 69 6e 64 69 63 65 73 2e 6f  :check-indices.o
0570: 0a 20 20 20 20 61 72 72 61 79 3a 63 68 65 63 6b  .    array:check
0580: 2d 69 6e 64 65 78 2d 76 65 63 74 6f 72 0a 20 20  -index-vector.  
0590: 20 20 61 72 72 61 79 3a 63 68 65 63 6b 2d 69 6e    array:check-in
05a0: 64 65 78 2d 61 63 74 6f 72 0a 20 20 20 20 61 72  dex-actor.    ar
05b0: 72 61 79 3a 67 6f 6f 64 2d 69 6e 64 69 63 65 73  ray:good-indices
05c0: 3f 0a 20 20 20 20 61 72 72 61 79 3a 67 6f 6f 64  ?.    array:good
05d0: 2d 69 6e 64 69 63 65 73 2e 6f 3f 0a 20 20 20 20  -indices.o?.    
05e0: 61 72 72 61 79 3a 67 6f 6f 64 2d 69 6e 64 65 78  array:good-index
05f0: 2d 76 65 63 74 6f 72 3f 0a 20 20 20 20 61 72 72  -vector?.    arr
0600: 61 79 3a 67 6f 6f 64 2d 69 6e 64 65 78 2d 61 63  ay:good-index-ac
0610: 74 6f 72 3f 0a 20 20 20 20 61 72 72 61 79 3a 67  tor?.    array:g
0620: 6f 6f 64 2d 69 6e 64 65 78 3f 0a 20 20 20 20 61  ood-index?.    a
0630: 72 72 61 79 3a 6e 6f 74 2d 69 6e 0a 20 20 20 20  rray:not-in.    
0640: 61 72 72 61 79 3a 6c 69 73 74 2d 3e 73 74 72 69  array:list->stri
0650: 6e 67 0a 20 20 20 20 61 72 72 61 79 3a 73 68 61  ng.    array:sha
0660: 70 65 2d 76 65 63 74 6f 72 2d 3e 73 74 72 69 6e  pe-vector->strin
0670: 67 0a 20 20 20 20 61 72 72 61 79 3a 74 68 69 6e  g.    array:thin
0680: 67 2d 3e 73 74 72 69 6e 67 0a 20 20 20 20 61 72  g->string.    ar
0690: 72 61 79 3a 69 6e 64 65 78 2d 72 65 66 0a 20 20  ray:index-ref.  
06a0: 20 20 61 72 72 61 79 3a 69 6e 64 65 78 2d 73 65    array:index-se
06b0: 74 21 0a 20 20 20 20 61 72 72 61 79 3a 69 6e 64  t!.    array:ind
06c0: 65 78 2d 6c 65 6e 67 74 68 0a 20 20 20 20 61 72  ex-length.    ar
06d0: 72 61 79 3a 6d 61 70 2d 3e 73 74 72 69 6e 67 0a  ray:map->string.
06e0: 20 20 20 20 61 72 72 61 79 3a 6d 61 70 2d 63 6f      array:map-co
06f0: 6c 75 6d 6e 2d 3e 73 74 72 69 6e 67 0a 20 20 20  lumn->string.   
0700: 20 61 72 72 61 79 3a 67 72 6f 6b 2f 61 72 67 75   array:grok/argu
0710: 6d 65 6e 74 73 0a 20 20 20 20 61 72 72 61 79 3a  ments.    array:
0720: 67 72 6f 6b 2f 69 6e 64 65 78 21 29 0a 20 20 28  grok/index!).  (
0730: 69 6d 70 6f 72 74 0a 20 20 20 20 28 72 6e 72 73  import.    (rnrs
0740: 29 0a 20 20 20 20 28 72 6e 72 73 20 6d 75 74 61  ).    (rnrs muta
0750: 62 6c 65 2d 70 61 69 72 73 29 0a 20 20 20 20 28  ble-pairs).    (
0760: 72 6e 72 73 20 72 35 72 73 29 0a 20 20 20 20 28  rnrs r5rs).    (
0770: 73 72 66 69 20 73 32 33 20 65 72 72 6f 72 20 74  srfi s23 error t
0780: 72 69 63 6b 73 29 0a 20 20 20 20 28 73 72 66 69  ricks).    (srfi
0790: 20 70 72 69 76 61 74 65 20 69 6e 63 6c 75 64 65   private include
07a0: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 2d 72 65  ))..  (define-re
07b0: 63 6f 72 64 2d 74 79 70 65 20 28 61 72 72 61 79  cord-type (array
07c0: 2d 74 79 70 65 20 61 72 72 61 79 3a 6d 61 6b 65  -type array:make
07d0: 20 61 72 72 61 79 3a 61 72 72 61 79 3f 29 0a 20   array:array?). 
07e0: 20 20 20 28 66 69 65 6c 64 73 20 28 69 6d 6d 75     (fields (immu
07f0: 74 61 62 6c 65 20 76 65 63 20 61 72 72 61 79 3a  table vec array:
0800: 76 65 63 74 6f 72 29 0a 20 20 20 20 20 20 20 20  vector).        
0810: 20 20 20 20 28 69 6d 6d 75 74 61 62 6c 65 20 69      (immutable i
0820: 6e 64 20 61 72 72 61 79 3a 69 6e 64 65 78 29 0a  nd array:index).
0830: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 6d 6d              (imm
0840: 75 74 61 62 6c 65 20 73 68 70 20 61 72 72 61 79  utable shp array
0850: 3a 73 68 61 70 65 29 29 29 0a 0a 20 20 28 53 52  :shape)))..  (SR
0860: 46 49 2d 32 33 2d 65 72 72 6f 72 2d 3e 52 36 52  FI-23-error->R6R
0870: 53 20 22 28 6c 69 62 72 61 72 79 20 28 73 72 66  S "(library (srf
0880: 69 20 73 32 35 20 6d 75 6c 74 69 2d 64 69 6d 65  i s25 multi-dime
0890: 6e 73 69 6f 6e 61 6c 2d 61 72 72 61 79 73 29 29  nsional-arrays))
08a0: 22 0a 20 20 20 28 69 6e 63 6c 75 64 65 2f 72 65  ".   (include/re
08b0: 73 6f 6c 76 65 20 28 22 73 72 66 69 22 20 22 73  solve ("srfi" "s
08c0: 32 35 22 29 20 22 69 78 2d 63 74 6f 72 2e 73 63  25") "ix-ctor.sc
08d0: 6d 22 29 0a 20 20 20 28 69 6e 63 6c 75 64 65 2f  m").   (include/
08e0: 72 65 73 6f 6c 76 65 20 28 22 73 72 66 69 22 20  resolve ("srfi" 
08f0: 22 73 32 35 22 29 20 22 6f 70 2d 63 74 6f 72 2e  "s25") "op-ctor.
0900: 73 63 6d 22 29 0a 20 20 20 28 69 6e 63 6c 75 64  scm").   (includ
0910: 65 2f 72 65 73 6f 6c 76 65 20 28 22 73 72 66 69  e/resolve ("srfi
0920: 22 20 22 73 32 35 22 29 20 22 61 72 72 61 79 2e  " "s25") "array.
0930: 73 63 6d 22 29 29 0a 29 0a                       scm")).).