0000: 3b 3b 3b 3b 3b 3b 20 53 52 46 49 20 34 33 3a 20 ;;;;;; SRFI 43:
0010: 56 65 63 74 6f 72 20 6c 69 62 72 61 72 79 20 20 Vector library
0020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0030: 20 20 20 20 20 20 20 20 20 2d 2a 2d 20 53 63 68 -*- Sch
0040: 65 6d 65 20 2d 2a 2d 0a 3b 3b 3b 0a 3b 3b 3b 20 eme -*-.;;;.;;;
0050: 24 49 64 3a 20 76 65 63 74 6f 72 2d 6c 69 62 2e $Id: vector-lib.
0060: 73 63 6d 2c 76 20 31 2e 37 20 32 30 30 39 2f 30 scm,v 1.7 2009/0
0070: 33 2f 32 39 20 30 39 3a 34 36 3a 30 33 20 73 70 3/29 09:46:03 sp
0080: 65 72 62 65 72 20 45 78 70 20 24 0a 3b 3b 3b 0a erber Exp $.;;;.
0090: 3b 3b 3b 20 54 61 79 6c 6f 72 20 43 61 6d 70 62 ;;; Taylor Campb
00a0: 65 6c 6c 20 77 72 6f 74 65 20 74 68 69 73 20 63 ell wrote this c
00b0: 6f 64 65 3b 20 68 65 20 70 6c 61 63 65 73 20 69 ode; he places i
00c0: 74 20 69 6e 20 74 68 65 20 70 75 62 6c 69 63 20 t in the public
00d0: 64 6f 6d 61 69 6e 2e 0a 3b 3b 3b 20 57 69 6c 6c domain..;;; Will
00e0: 20 43 6c 69 6e 67 65 72 20 5b 77 64 63 5d 20 6d Clinger [wdc] m
00f0: 61 64 65 20 73 6f 6d 65 20 63 6f 72 72 65 63 74 ade some correct
0100: 69 6f 6e 73 2c 20 61 6c 73 6f 20 69 6e 20 74 68 ions, also in th
0110: 65 20 70 75 62 6c 69 63 20 64 6f 6d 61 69 6e 2e e public domain.
0120: 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ..;;; ----------
0130: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 45 ----------.;;; E
0140: 78 70 6f 72 74 65 64 20 70 72 6f 63 65 64 75 72 xported procedur
0150: 65 20 69 6e 64 65 78 0a 3b 3b 3b 0a 3b 3b 3b 20 e index.;;;.;;;
0160: 2a 20 43 6f 6e 73 74 72 75 63 74 6f 72 73 0a 3b * Constructors.;
0170: 3b 3b 20 6d 61 6b 65 2d 76 65 63 74 6f 72 20 76 ;; make-vector v
0180: 65 63 74 6f 72 0a 3b 3b 3b 20 76 65 63 74 6f 72 ector.;;; vector
0190: 2d 75 6e 66 6f 6c 64 20 20 20 20 20 20 20 20 20 -unfold
01a0: 20 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 vector
01b0: 2d 75 6e 66 6f 6c 64 2d 72 69 67 68 74 0a 3b 3b -unfold-right.;;
01c0: 3b 20 76 65 63 74 6f 72 2d 63 6f 70 79 20 20 20 ; vector-copy
01d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
01e0: 20 20 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 vector-reverse
01f0: 2d 63 6f 70 79 0a 3b 3b 3b 20 76 65 63 74 6f 72 -copy.;;; vector
0200: 2d 61 70 70 65 6e 64 20 20 20 20 20 20 20 20 20 -append
0210: 20 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 vector
0220: 2d 63 6f 6e 63 61 74 65 6e 61 74 65 0a 3b 3b 3b -concatenate.;;;
0230: 0a 3b 3b 3b 20 2a 20 50 72 65 64 69 63 61 74 65 .;;; * Predicate
0240: 73 0a 3b 3b 3b 20 76 65 63 74 6f 72 3f 0a 3b 3b s.;;; vector?.;;
0250: 3b 20 76 65 63 74 6f 72 2d 65 6d 70 74 79 3f 0a ; vector-empty?.
0260: 3b 3b 3b 20 76 65 63 74 6f 72 3d 0a 3b 3b 3b 0a ;;; vector=.;;;.
0270: 3b 3b 3b 20 2a 20 53 65 6c 65 63 74 6f 72 73 0a ;;; * Selectors.
0280: 3b 3b 3b 20 76 65 63 74 6f 72 2d 72 65 66 0a 3b ;;; vector-ref.;
0290: 3b 3b 20 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 ;; vector-length
02a0: 0a 3b 3b 3b 0a 3b 3b 3b 20 2a 20 49 74 65 72 61 .;;;.;;; * Itera
02b0: 74 69 6f 6e 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d tion.;;; vector-
02c0: 66 6f 6c 64 20 20 20 20 20 20 20 20 20 20 20 20 fold
02d0: 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d vector-
02e0: 66 6f 6c 64 2d 72 69 67 68 74 0a 3b 3b 3b 20 76 fold-right.;;; v
02f0: 65 63 74 6f 72 2d 6d 61 70 20 20 20 20 20 20 20 ector-map
0300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 v
0310: 65 63 74 6f 72 2d 6d 61 70 21 0a 3b 3b 3b 20 76 ector-map!.;;; v
0320: 65 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68 0a 3b ector-for-each.;
0330: 3b 3b 20 76 65 63 74 6f 72 2d 63 6f 75 6e 74 0a ;; vector-count.
0340: 3b 3b 3b 0a 3b 3b 3b 20 2a 20 53 65 61 72 63 68 ;;;.;;; * Search
0350: 69 6e 67 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 69 ing.;;; vector-i
0360: 6e 64 65 78 20 20 20 20 20 20 20 20 20 20 20 20 ndex
0370: 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d 73 vector-s
0380: 6b 69 70 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 69 kip.;;; vector-i
0390: 6e 64 65 78 2d 72 69 67 68 74 20 20 20 20 20 20 ndex-right
03a0: 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d 73 vector-s
03b0: 6b 69 70 2d 72 69 67 68 74 0a 3b 3b 3b 20 76 65 kip-right.;;; ve
03c0: 63 74 6f 72 2d 62 69 6e 61 72 79 2d 73 65 61 72 ctor-binary-sear
03d0: 63 68 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 61 6e ch.;;; vector-an
03e0: 79 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y
03f0: 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d 65 76 vector-ev
0400: 65 72 79 0a 3b 3b 3b 0a 3b 3b 3b 20 2a 20 4d 75 ery.;;;.;;; * Mu
0410: 74 61 74 6f 72 73 0a 3b 3b 3b 20 76 65 63 74 6f tators.;;; vecto
0420: 72 2d 73 65 74 21 0a 3b 3b 3b 20 76 65 63 74 6f r-set!.;;; vecto
0430: 72 2d 73 77 61 70 21 0a 3b 3b 3b 20 76 65 63 74 r-swap!.;;; vect
0440: 6f 72 2d 66 69 6c 6c 21 0a 3b 3b 3b 20 76 65 63 or-fill!.;;; vec
0450: 74 6f 72 2d 72 65 76 65 72 73 65 21 0a 3b 3b 3b tor-reverse!.;;;
0460: 20 76 65 63 74 6f 72 2d 63 6f 70 79 21 20 20 20 vector-copy!
0470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0480: 20 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 2d vector-reverse-
0490: 63 6f 70 79 21 0a 3b 3b 3b 20 76 65 63 74 6f 72 copy!.;;; vector
04a0: 2d 72 65 76 65 72 73 65 21 0a 3b 3b 3b 0a 3b 3b -reverse!.;;;.;;
04b0: 3b 20 2a 20 43 6f 6e 76 65 72 73 69 6f 6e 0a 3b ; * Conversion.;
04c0: 3b 3b 20 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 ;; vector->list
04d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04e0: 20 20 20 72 65 76 65 72 73 65 2d 76 65 63 74 6f reverse-vecto
04f0: 72 2d 3e 6c 69 73 74 0a 3b 3b 3b 20 6c 69 73 74 r->list.;;; list
0500: 2d 3e 76 65 63 74 6f 72 20 20 20 20 20 20 20 20 ->vector
0510: 20 20 20 20 20 20 20 20 20 20 20 20 72 65 76 65 reve
0520: 72 73 65 2d 6c 69 73 74 2d 3e 76 65 63 74 6f 72 rse-list->vector
0530: 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d .....;;; -------
0540: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b -------------.;;
0550: 3b 20 43 6f 6d 6d 65 6e 74 61 72 79 20 6f 6e 20 ; Commentary on
0560: 65 66 66 69 63 69 65 6e 63 79 20 6f 66 20 74 68 efficiency of th
0570: 65 20 63 6f 64 65 0a 0a 3b 3b 3b 20 54 68 69 73 e code..;;; This
0580: 20 63 6f 64 65 20 69 73 20 73 6f 6d 65 77 68 61 code is somewha
0590: 74 20 74 75 6e 65 64 20 66 6f 72 20 65 66 66 69 t tuned for effi
05a0: 63 69 65 6e 63 79 2e 20 20 54 68 65 72 65 20 61 ciency. There a
05b0: 72 65 20 73 65 76 65 72 61 6c 0a 3b 3b 3b 20 69 re several.;;; i
05c0: 6e 74 65 72 6e 61 6c 20 72 6f 75 74 69 6e 65 73 nternal routines
05d0: 20 74 68 61 74 20 63 61 6e 20 62 65 20 6f 70 74 that can be opt
05e0: 69 6d 69 7a 65 64 20 67 72 65 61 74 6c 79 20 74 imized greatly t
05f0: 6f 20 67 72 65 61 74 6c 79 20 69 6d 70 72 6f 76 o greatly improv
0600: 65 0a 3b 3b 3b 20 74 68 65 20 70 65 72 66 6f 72 e.;;; the perfor
0610: 6d 61 6e 63 65 20 6f 66 20 6d 75 63 68 20 6f 66 mance of much of
0620: 20 74 68 65 20 6c 69 62 72 61 72 79 2e 20 20 54 the library. T
0630: 68 65 73 65 20 69 6e 74 65 72 6e 61 6c 20 70 72 hese internal pr
0640: 6f 63 65 64 75 72 65 73 0a 3b 3b 3b 20 61 72 65 ocedures.;;; are
0650: 20 61 6c 72 65 61 64 79 20 63 61 72 65 66 75 6c already careful
0660: 6c 79 20 74 75 6e 65 64 20 66 6f 72 20 70 65 72 ly tuned for per
0670: 66 6f 72 6d 61 6e 63 65 2c 20 61 6e 64 20 6c 61 formance, and la
0680: 6d 62 64 61 2d 6c 69 66 74 65 64 20 62 79 0a 3b mbda-lifted by.;
0690: 3b 3b 20 68 61 6e 64 2e 20 20 53 6f 6d 65 20 6f ;; hand. Some o
06a0: 74 68 65 72 20 72 6f 75 74 69 6e 65 73 20 61 72 ther routines ar
06b0: 65 20 6c 61 6d 62 64 61 2d 6c 69 66 74 65 64 20 e lambda-lifted
06c0: 62 79 20 68 61 6e 64 2c 20 62 75 74 20 6f 6e 6c by hand, but onl
06d0: 79 20 74 68 65 0a 3b 3b 3b 20 6c 6f 6f 70 73 20 y the.;;; loops
06e0: 61 72 65 20 6c 61 6d 62 64 61 2d 6c 69 66 74 65 are lambda-lifte
06f0: 64 2c 20 61 6e 64 20 6f 6e 6c 79 20 69 66 20 73 d, and only if s
0700: 6f 6d 65 20 72 6f 75 74 69 6e 65 20 68 61 73 20 ome routine has
0710: 74 77 6f 20 70 6f 73 73 69 62 6c 65 0a 3b 3b 3b two possible.;;;
0720: 20 6c 6f 6f 70 73 20 2d 2d 20 61 20 66 61 73 74 loops -- a fast
0730: 20 70 61 74 68 20 61 6e 64 20 61 6e 20 6e 2d 61 path and an n-a
0740: 72 79 20 63 61 73 65 20 2d 2d 2c 20 77 68 65 72 ry case --, wher
0750: 65 61 73 20 5f 61 6c 6c 5f 20 6f 66 20 74 68 65 eas _all_ of the
0760: 0a 3b 3b 3b 20 69 6e 74 65 72 6e 61 6c 20 72 6f .;;; internal ro
0770: 75 74 69 6e 65 73 27 20 6c 6f 6f 70 73 20 61 72 utines' loops ar
0780: 65 20 6c 61 6d 62 64 61 2d 6c 69 66 74 65 64 20 e lambda-lifted
0790: 73 6f 20 61 73 20 74 6f 20 6e 65 76 65 72 20 63 so as to never c
07a0: 6f 6e 73 20 61 0a 3b 3b 3b 20 63 6c 6f 73 75 72 ons a.;;; closur
07b0: 65 20 69 6e 20 74 68 65 69 72 20 62 6f 64 79 20 e in their body
07c0: 28 56 45 43 54 4f 52 2d 50 41 52 53 45 2d 53 54 (VECTOR-PARSE-ST
07d0: 41 52 54 2b 45 4e 44 20 64 6f 65 73 6e 27 74 20 ART+END doesn't
07e0: 68 61 76 65 20 61 20 6c 6f 6f 70 29 2c 0a 3b 3b have a loop),.;;
07f0: 3b 20 65 76 65 6e 20 69 6e 20 53 63 68 65 6d 65 ; even in Scheme
0800: 20 73 79 73 74 65 6d 73 20 74 68 61 74 20 70 65 systems that pe
0810: 72 66 6f 72 6d 20 6e 6f 20 6c 6f 6f 70 20 6f 70 rform no loop op
0820: 74 69 6d 69 7a 61 74 69 6f 6e 20 28 77 68 69 63 timization (whic
0830: 68 20 69 73 0a 3b 3b 3b 20 6d 6f 73 74 20 6f 66 h is.;;; most of
0840: 20 74 68 65 6d 2c 20 75 6e 66 6f 72 74 75 6e 61 them, unfortuna
0850: 74 65 6c 79 29 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 46 tely)..;;;.;;; F
0860: 61 73 74 20 70 61 74 68 73 20 61 72 65 20 70 72 ast paths are pr
0870: 6f 76 69 64 65 64 20 66 6f 72 20 63 6f 6d 6d 6f ovided for commo
0880: 6e 20 63 61 73 65 73 20 69 6e 20 6d 6f 73 74 20 n cases in most
0890: 6f 66 20 74 68 65 20 6c 6f 6f 70 73 20 69 6e 0a of the loops in.
08a0: 3b 3b 3b 20 74 68 69 73 20 6c 69 62 72 61 72 79 ;;; this library
08b0: 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 41 6c 6c 20 63 61 ..;;;.;;; All ca
08c0: 6c 6c 73 20 74 6f 20 70 72 69 6d 69 74 69 76 65 lls to primitive
08d0: 20 76 65 63 74 6f 72 20 6f 70 65 72 61 74 69 6f vector operatio
08e0: 6e 73 20 61 72 65 20 70 72 6f 74 65 63 74 65 64 ns are protected
08f0: 20 62 79 20 61 20 70 72 69 6f 72 0a 3b 3b 3b 20 by a prior.;;;
0900: 74 79 70 65 20 63 68 65 63 6b 3b 20 74 68 65 79 type check; they
0910: 20 63 61 6e 20 62 65 20 73 61 66 65 6c 79 20 63 can be safely c
0920: 6f 6e 76 65 72 74 65 64 20 74 6f 20 75 73 65 20 onverted to use
0930: 75 6e 73 61 66 65 20 65 71 75 69 76 61 6c 65 6e unsafe equivalen
0940: 74 73 0a 3b 3b 3b 20 6f 66 20 74 68 65 20 6f 70 ts.;;; of the op
0950: 65 72 61 74 69 6f 6e 73 2c 20 69 66 20 61 76 61 erations, if ava
0960: 69 6c 61 62 6c 65 2e 20 20 49 64 65 61 6c 6c 79 ilable. Ideally
0970: 2c 20 74 68 65 20 63 6f 6d 70 69 6c 65 72 20 73 , the compiler s
0980: 68 6f 75 6c 64 20 62 65 0a 3b 3b 3b 20 61 62 6c hould be.;;; abl
0990: 65 20 74 6f 20 64 65 74 65 72 6d 69 6e 65 20 74 e to determine t
09a0: 68 69 73 2c 20 62 75 74 20 74 68 65 20 73 74 61 his, but the sta
09b0: 74 65 20 6f 66 20 53 63 68 65 6d 65 20 63 6f 6d te of Scheme com
09c0: 70 69 6c 65 72 73 20 74 6f 64 61 79 20 69 73 0a pilers today is.
09d0: 3b 3b 3b 20 6e 6f 74 20 61 20 68 61 70 70 79 20 ;;; not a happy
09e0: 6f 6e 65 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 45 66 66 one..;;;.;;; Eff
09f0: 69 63 69 65 6e 63 79 20 6f 66 20 74 68 65 20 61 iciency of the a
0a00: 63 74 75 61 6c 20 61 6c 67 6f 72 69 74 68 6d 73 ctual algorithms
0a10: 20 69 73 20 61 20 72 61 74 68 65 72 20 6d 75 6e is a rather mun
0a20: 64 61 6e 65 20 70 6f 69 6e 74 20 74 6f 0a 3b 3b dane point to.;;
0a30: 3b 20 6d 65 6e 74 69 6f 6e 3b 20 76 65 63 74 6f ; mention; vecto
0a40: 72 20 6f 70 65 72 61 74 69 6f 6e 73 20 61 72 65 r operations are
0a50: 20 72 61 72 65 6c 79 20 62 65 79 6f 6e 64 20 62 rarely beyond b
0a60: 65 69 6e 67 20 73 74 72 61 69 67 68 74 66 6f 72 eing straightfor
0a70: 77 61 72 64 2e 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d ward......;;; --
0a80: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0a90: 2d 2d 0a 3b 3b 3b 20 55 74 69 6c 69 74 69 65 73 --.;;; Utilities
0aa0: 0a 0a 3b 3b 3b 20 53 52 46 49 20 38 2c 20 74 6f ..;;; SRFI 8, to
0ab0: 6f 20 74 72 69 76 69 61 6c 20 74 6f 20 70 75 74 o trivial to put
0ac0: 20 69 6e 20 74 68 65 20 64 65 70 65 6e 64 65 6e in the dependen
0ad0: 63 69 65 73 20 6c 69 73 74 2e 0a 28 64 65 66 69 cies list..(defi
0ae0: 6e 65 2d 73 79 6e 74 61 78 20 72 65 63 65 69 76 ne-syntax receiv
0af0: 65 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 e. (syntax-rule
0b00: 73 20 28 29 0a 20 20 20 20 28 28 72 65 63 65 69 s (). ((recei
0b10: 76 65 20 3f 66 6f 72 6d 61 6c 73 20 3f 70 72 6f ve ?formals ?pro
0b20: 64 75 63 65 72 20 3f 62 6f 64 79 31 20 3f 62 6f ducer ?body1 ?bo
0b30: 64 79 32 20 2e 2e 2e 29 0a 20 20 20 20 20 28 63 dy2 ...). (c
0b40: 61 6c 6c 2d 77 69 74 68 2d 76 61 6c 75 65 73 20 all-with-values
0b50: 28 6c 61 6d 62 64 61 20 28 29 20 3f 70 72 6f 64 (lambda () ?prod
0b60: 75 63 65 72 29 0a 20 20 20 20 20 20 20 28 6c 61 ucer). (la
0b70: 6d 62 64 61 20 3f 66 6f 72 6d 61 6c 73 20 3f 62 mbda ?formals ?b
0b80: 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 ody1 ?body2 ...)
0b90: 29 29 29 29 0a 0a 3b 3b 3b 20 4e 6f 74 20 74 68 ))))..;;; Not th
0ba0: 65 20 62 65 73 74 20 4c 45 54 2a 2d 4f 50 54 49 e best LET*-OPTI
0bb0: 4f 4e 41 4c 53 2c 20 62 75 74 20 6e 6f 74 20 74 ONALS, but not t
0bc0: 68 65 20 77 6f 72 73 74 2c 20 65 69 74 68 65 72 he worst, either
0bd0: 2e 20 20 55 73 65 20 4f 6c 69 6e 27 73 0a 3b 3b . Use Olin's.;;
0be0: 3b 20 69 66 20 69 74 27 73 20 61 76 61 69 6c 61 ; if it's availa
0bf0: 62 6c 65 20 74 6f 20 79 6f 75 2e 0a 28 64 65 66 ble to you..(def
0c00: 69 6e 65 2d 73 79 6e 74 61 78 20 6c 65 74 2a 2d ine-syntax let*-
0c10: 6f 70 74 69 6f 6e 61 6c 73 0a 20 20 28 73 79 6e optionals. (syn
0c20: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 tax-rules ().
0c30: 20 28 28 6c 65 74 2a 2d 6f 70 74 69 6f 6e 61 6c ((let*-optional
0c40: 73 20 28 3f 78 20 2e 2e 2e 29 20 28 28 3f 76 61 s (?x ...) ((?va
0c50: 72 20 3f 64 65 66 61 75 6c 74 29 20 2e 2e 2e 29 r ?default) ...)
0c60: 20 3f 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e ?body1 ?body2 .
0c70: 2e 2e 29 0a 20 20 20 20 20 28 6c 65 74 20 28 28 ..). (let ((
0c80: 61 72 67 73 20 28 3f 78 20 2e 2e 2e 29 29 29 0a args (?x ...))).
0c90: 20 20 20 20 20 20 20 28 6c 65 74 2a 2d 6f 70 74 (let*-opt
0ca0: 69 6f 6e 61 6c 73 20 61 72 67 73 20 28 28 3f 76 ionals args ((?v
0cb0: 61 72 20 3f 64 65 66 61 75 6c 74 29 20 2e 2e 2e ar ?default) ...
0cc0: 29 20 3f 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 ) ?body1 ?body2
0cd0: 2e 2e 2e 29 29 29 0a 20 20 20 20 28 28 6c 65 74 ...))). ((let
0ce0: 2a 2d 6f 70 74 69 6f 6e 61 6c 73 20 3f 61 72 67 *-optionals ?arg
0cf0: 73 20 28 28 3f 76 61 72 20 3f 64 65 66 61 75 6c s ((?var ?defaul
0d00: 74 29 20 2e 2e 2e 29 20 3f 62 6f 64 79 31 20 3f t) ...) ?body1 ?
0d10: 62 6f 64 79 32 20 2e 2e 2e 29 0a 20 20 20 20 20 body2 ...).
0d20: 28 6c 65 74 2a 2d 6f 70 74 69 6f 6e 61 6c 73 3a (let*-optionals:
0d30: 61 75 78 20 3f 61 72 67 73 20 3f 61 72 67 73 20 aux ?args ?args
0d40: 28 28 3f 76 61 72 20 3f 64 65 66 61 75 6c 74 29 ((?var ?default)
0d50: 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 3f 62 6f ...). ?bo
0d60: 64 79 31 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 29 dy1 ?body2 ...))
0d70: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 ))..(define-synt
0d80: 61 78 20 6c 65 74 2a 2d 6f 70 74 69 6f 6e 61 6c ax let*-optional
0d90: 73 3a 61 75 78 0a 20 20 28 73 79 6e 74 61 78 2d s:aux. (syntax-
0da0: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 61 rules (). ((a
0db0: 75 78 20 3f 6f 72 69 67 2d 61 72 67 73 2d 76 61 ux ?orig-args-va
0dc0: 72 20 3f 61 72 67 73 2d 76 61 72 20 28 29 20 3f r ?args-var () ?
0dd0: 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e 2e 2e body1 ?body2 ...
0de0: 29 0a 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c ). (if (null
0df0: 3f 20 3f 61 72 67 73 2d 76 61 72 29 0a 20 20 20 ? ?args-var).
0e00: 20 20 20 20 20 20 28 6c 65 74 20 28 29 20 3f 62 (let () ?b
0e10: 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 ody1 ?body2 ...)
0e20: 0a 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 . (error
0e30: 20 22 74 6f 6f 20 6d 61 6e 79 20 61 72 67 75 6d "too many argum
0e40: 65 6e 74 73 22 20 28 6c 65 6e 67 74 68 20 3f 6f ents" (length ?o
0e50: 72 69 67 2d 61 72 67 73 2d 76 61 72 29 0a 20 20 rig-args-var).
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3f 6f ?o
0e70: 72 69 67 2d 61 72 67 73 2d 76 61 72 29 29 29 0a rig-args-var))).
0e80: 20 20 20 20 28 28 61 75 78 20 3f 6f 72 69 67 2d ((aux ?orig-
0e90: 61 72 67 73 2d 76 61 72 20 3f 61 72 67 73 2d 76 args-var ?args-v
0ea0: 61 72 0a 20 20 20 20 20 20 20 20 20 28 28 3f 76 ar. ((?v
0eb0: 61 72 20 3f 64 65 66 61 75 6c 74 29 20 3f 6d 6f ar ?default) ?mo
0ec0: 72 65 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 3f re ...). ?
0ed0: 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e 2e 2e body1 ?body2 ...
0ee0: 29 0a 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c ). (if (null
0ef0: 3f 20 3f 61 72 67 73 2d 76 61 72 29 0a 20 20 20 ? ?args-var).
0f00: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 3f 76 (let* ((?v
0f10: 61 72 20 3f 64 65 66 61 75 6c 74 29 20 3f 6d 6f ar ?default) ?mo
0f20: 72 65 20 2e 2e 2e 29 20 3f 62 6f 64 79 31 20 3f re ...) ?body1 ?
0f30: 62 6f 64 79 32 20 2e 2e 2e 29 0a 20 20 20 20 20 body2 ...).
0f40: 20 20 20 20 28 6c 65 74 20 28 28 3f 76 61 72 20 (let ((?var
0f50: 28 63 61 72 20 3f 61 72 67 73 2d 76 61 72 29 29 (car ?args-var))
0f60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0f70: 28 6e 65 77 2d 61 72 67 73 20 28 63 64 72 20 3f (new-args (cdr ?
0f80: 61 72 67 73 2d 76 61 72 29 29 29 0a 20 20 20 20 args-var))).
0f90: 20 20 20 20 20 20 20 28 6c 65 74 2a 2d 6f 70 74 (let*-opt
0fa0: 69 6f 6e 61 6c 73 3a 61 75 78 20 3f 6f 72 69 67 ionals:aux ?orig
0fb0: 2d 61 72 67 73 2d 76 61 72 20 6e 65 77 2d 61 72 -args-var new-ar
0fc0: 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 gs.
0fd0: 20 20 28 3f 6d 6f 72 65 20 2e 2e 2e 29 0a 20 20 (?more ...).
0fe0: 20 20 20 20 20 20 20 20 20 20 20 3f 62 6f 64 79 ?body
0ff0: 31 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 29 29 29 1 ?body2 ...))))
1000: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6e 6f 6e ))..(define (non
1010: 6e 65 67 2d 69 6e 74 3f 20 78 29 0a 20 20 28 61 neg-int? x). (a
1020: 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 78 29 0a nd (integer? x).
1030: 20 20 20 20 20 20 20 28 6e 6f 74 20 28 6e 65 67 (not (neg
1040: 61 74 69 76 65 3f 20 78 29 29 29 29 0a 0a 28 64 ative? x))))..(d
1050: 65 66 69 6e 65 20 28 62 65 74 77 65 65 6e 3f 20 efine (between?
1060: 78 20 79 20 7a 29 0a 20 20 28 61 6e 64 20 28 3c x y z). (and (<
1070: 20 20 78 20 79 29 0a 20 20 20 20 20 20 20 28 3c x y). (<
1080: 3d 20 79 20 7a 29 29 29 0a 0a 28 64 65 66 69 6e = y z)))..(defin
1090: 65 20 28 75 6e 73 70 65 63 69 66 69 65 64 2d 76 e (unspecified-v
10a0: 61 6c 75 65 29 20 28 69 66 20 23 66 20 23 66 29 alue) (if #f #f)
10b0: 29 0a 0a 3b 2b 2b 20 54 68 69 73 20 73 68 6f 75 )..;++ This shou
10c0: 6c 64 20 62 65 20 69 6d 70 6c 65 6d 65 6e 74 65 ld be implemente
10d0: 64 20 6d 6f 72 65 20 65 66 66 69 63 69 65 6e 74 d more efficient
10e0: 6c 79 2e 20 20 49 74 20 73 68 6f 75 6c 64 6e 27 ly. It shouldn'
10f0: 74 20 63 6f 6e 73 20 61 0a 3b 2b 2b 20 63 6c 6f t cons a.;++ clo
1100: 73 75 72 65 2c 20 61 6e 64 20 74 68 65 20 63 6f sure, and the co
1110: 6e 73 20 63 65 6c 6c 73 20 75 73 65 64 20 69 6e ns cells used in
1120: 20 74 68 65 20 6c 6f 6f 70 73 20 77 68 65 6e 20 the loops when
1130: 75 73 69 6e 67 20 74 68 69 73 20 63 6f 75 6c 64 using this could
1140: 0a 3b 2b 2b 20 62 65 20 72 65 75 73 65 64 2e 0a .;++ be reused..
1150: 28 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 73 (define (vectors
1160: 2d 72 65 66 20 76 65 63 74 6f 72 73 20 69 29 0a -ref vectors i).
1170: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
1180: 76 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 v) (vector-ref v
1190: 20 69 29 29 20 76 65 63 74 6f 72 73 29 29 0a 0a i)) vectors))..
11a0: 0c 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d ...;;; ---------
11b0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 -----------.;;;
11c0: 45 72 72 6f 72 20 63 68 65 63 6b 69 6e 67 0a 0a Error checking..
11d0: 3b 3b 3b 20 45 72 72 6f 72 20 73 69 67 6e 61 6c ;;; Error signal
11e0: 6c 69 6e 67 20 28 6e 6f 74 20 63 68 65 63 6b 69 ling (not checki
11f0: 6e 67 29 20 69 73 20 64 6f 6e 65 20 69 6e 20 61 ng) is done in a
1200: 20 77 61 79 20 74 68 61 74 20 74 72 69 65 73 20 way that tries
1210: 74 6f 20 62 65 0a 3b 3b 3b 20 61 73 20 68 65 6c to be.;;; as hel
1220: 70 66 75 6c 20 74 6f 20 74 68 65 20 70 65 72 73 pful to the pers
1230: 6f 6e 20 77 68 6f 20 67 65 74 73 20 74 68 65 20 on who gets the
1240: 64 65 62 75 67 67 69 6e 67 20 70 72 6f 6d 70 74 debugging prompt
1250: 20 61 73 20 70 6f 73 73 69 62 6c 65 2e 0a 3b 3b as possible..;;
1260: 3b 20 54 68 61 74 20 73 61 69 64 2c 20 65 72 72 ; That said, err
1270: 6f 72 20 5f 63 68 65 63 6b 69 6e 67 5f 20 74 72 or _checking_ tr
1280: 69 65 73 20 74 6f 20 62 65 20 61 73 20 75 6e 72 ies to be as unr
1290: 65 64 75 6e 64 61 6e 74 20 61 73 20 70 6f 73 73 edundant as poss
12a0: 69 62 6c 65 2e 0a 0a 3b 3b 3b 20 49 20 64 6f 6e ible...;;; I don
12b0: 27 74 20 75 73 65 20 61 6e 79 20 73 6f 72 74 20 't use any sort
12c0: 6f 66 20 67 65 6e 65 72 61 6c 20 63 6f 6e 64 69 of general condi
12d0: 74 69 6f 6e 20 6d 65 63 68 61 6e 69 73 6d 3b 20 tion mechanism;
12e0: 49 20 75 73 65 20 73 69 6d 70 6c 79 0a 3b 3b 3b I use simply.;;;
12f0: 20 53 52 46 49 20 32 33 27 73 20 45 52 52 4f 52 SRFI 23's ERROR
1300: 2c 20 65 76 65 6e 20 69 6e 20 63 61 73 65 73 20 , even in cases
1310: 77 68 65 72 65 20 69 74 20 6d 69 67 68 74 20 62 where it might b
1320: 65 20 62 65 74 74 65 72 20 74 6f 20 75 73 65 20 e better to use
1330: 73 75 63 68 0a 3b 3b 3b 20 61 20 67 65 6e 65 72 such.;;; a gener
1340: 61 6c 20 63 6f 6e 64 69 74 69 6f 6e 20 6d 65 63 al condition mec
1350: 68 61 6e 69 73 6d 2e 20 20 46 69 78 20 74 68 61 hanism. Fix tha
1360: 74 20 77 68 65 6e 20 70 6f 72 74 69 6e 67 20 74 t when porting t
1370: 68 69 73 20 74 6f 20 61 0a 3b 3b 3b 20 53 63 68 his to a.;;; Sch
1380: 65 6d 65 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 eme implementati
1390: 6f 6e 20 74 68 61 74 20 68 61 73 20 69 74 73 20 on that has its
13a0: 6f 77 6e 20 63 6f 6e 64 69 74 69 6f 6e 20 73 79 own condition sy
13b0: 73 74 65 6d 2e 0a 0a 3b 3b 3b 20 49 6e 20 61 72 stem...;;; In ar
13c0: 67 75 6d 65 6e 74 20 63 68 65 63 6b 73 2c 20 75 gument checks, u
13d0: 70 6f 6e 20 72 65 63 65 69 76 69 6e 67 20 61 6e pon receiving an
13e0: 20 69 6e 76 61 6c 69 64 20 61 72 67 75 6d 65 6e invalid argumen
13f0: 74 2c 20 74 68 65 20 63 68 65 63 6b 65 72 0a 3b t, the checker.;
1400: 3b 3b 20 70 72 6f 63 65 64 75 72 65 20 72 65 63 ;; procedure rec
1410: 75 72 73 69 76 65 6c 79 20 63 61 6c 6c 73 20 69 ursively calls i
1420: 74 73 65 6c 66 2c 20 62 75 74 20 69 6e 20 6f 6e tself, but in on
1430: 65 20 6f 66 20 74 68 65 20 61 72 67 75 6d 65 6e e of the argumen
1440: 74 73 20 74 6f 0a 3b 3b 3b 20 69 74 73 65 6c 66 ts to.;;; itself
1450: 20 69 73 20 61 20 63 61 6c 6c 20 74 6f 20 45 52 is a call to ER
1460: 52 4f 52 3b 20 74 68 69 73 20 6d 65 63 68 61 6e ROR; this mechan
1470: 69 73 6d 20 69 73 20 75 73 65 64 20 69 6e 20 74 ism is used in t
1480: 68 65 20 68 6f 70 65 73 20 74 68 61 74 0a 3b 3b he hopes that.;;
1490: 3b 20 74 68 65 20 75 73 65 72 20 6d 61 79 20 62 ; the user may b
14a0: 65 20 74 68 72 6f 77 6e 20 69 6e 74 6f 20 61 20 e thrown into a
14b0: 64 65 62 75 67 67 65 72 20 70 72 6f 6d 70 74 2c debugger prompt,
14c0: 20 70 72 6f 63 65 65 64 20 77 69 74 68 20 61 6e proceed with an
14d0: 6f 74 68 65 72 0a 3b 3b 3b 20 76 61 6c 75 65 2c other.;;; value,
14e0: 20 61 6e 64 20 6c 65 74 20 69 74 20 62 65 20 63 and let it be c
14f0: 68 65 63 6b 65 64 20 61 67 61 69 6e 2e 0a 0a 3b hecked again...;
1500: 3b 3b 20 54 79 70 65 20 63 68 65 63 6b 69 6e 67 ;; Type checking
1510: 20 69 73 20 70 72 65 74 74 79 20 62 61 73 69 63 is pretty basic
1520: 2c 20 62 75 74 20 65 61 73 69 6c 79 20 66 61 63 , but easily fac
1530: 74 6f 72 65 64 20 6f 75 74 20 61 6e 64 20 72 65 tored out and re
1540: 70 6c 61 63 65 64 0a 3b 3b 3b 20 77 69 74 68 20 placed.;;; with
1550: 77 68 61 74 65 76 65 72 20 79 6f 75 72 20 69 6d whatever your im
1560: 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 27 73 20 70 plementation's p
1570: 72 65 66 65 72 72 65 64 20 74 79 70 65 20 63 68 referred type ch
1580: 65 63 6b 69 6e 67 20 6d 65 74 68 6f 64 0a 3b 3b ecking method.;;
1590: 3b 20 69 73 2e 20 20 49 20 64 6f 75 62 74 20 74 ; is. I doubt t
15a0: 68 65 72 65 20 77 69 6c 6c 20 62 65 20 6d 61 6e here will be man
15b0: 79 20 6f 74 68 65 72 20 6d 65 74 68 6f 64 73 20 y other methods
15c0: 6f 66 20 69 6e 64 65 78 20 63 68 65 63 6b 69 6e of index checkin
15d0: 67 2c 0a 3b 3b 3b 20 74 68 6f 75 67 68 20 74 68 g,.;;; though th
15e0: 65 20 69 6e 64 65 78 20 63 68 65 63 6b 65 72 73 e index checkers
15f0: 20 6d 69 67 68 74 20 62 65 20 62 65 74 74 65 72 might be better
1600: 20 69 6d 70 6c 65 6d 65 6e 74 65 64 20 6e 61 74 implemented nat
1610: 69 76 65 6c 79 2e 0a 0a 3b 3b 3b 20 28 43 48 45 ively...;;; (CHE
1620: 43 4b 2d 54 59 50 45 20 3c 74 79 70 65 2d 70 72 CK-TYPE <type-pr
1630: 65 64 69 63 61 74 65 3f 3e 20 3c 76 61 6c 75 65 edicate?> <value
1640: 3e 20 3c 63 61 6c 6c 65 65 3e 29 20 2d 3e 20 76 > <callee>) -> v
1650: 61 6c 75 65 0a 3b 3b 3b 20 20 20 45 6e 73 75 72 alue.;;; Ensur
1660: 65 20 74 68 61 74 20 56 41 4c 55 45 20 73 61 74 e that VALUE sat
1670: 69 73 66 69 65 73 20 54 59 50 45 2d 50 52 45 44 isfies TYPE-PRED
1680: 49 43 41 54 45 3f 3b 20 69 66 20 6e 6f 74 2c 20 ICATE?; if not,
1690: 73 69 67 6e 61 6c 20 61 6e 0a 3b 3b 3b 20 20 20 signal an.;;;
16a0: 65 72 72 6f 72 20 73 74 61 74 69 6e 67 20 74 68 error stating th
16b0: 61 74 20 56 41 4c 55 45 20 64 69 64 20 6e 6f 74 at VALUE did not
16c0: 20 73 61 74 69 73 66 79 20 54 59 50 45 2d 50 52 satisfy TYPE-PR
16d0: 45 44 49 43 41 54 45 3f 2c 20 73 68 6f 77 69 6e EDICATE?, showin
16e0: 67 0a 3b 3b 3b 20 20 20 74 68 61 74 20 74 68 69 g.;;; that thi
16f0: 73 20 68 61 70 70 65 6e 65 64 20 77 68 69 6c 65 s happened while
1700: 20 63 61 6c 6c 69 6e 67 20 43 41 4c 4c 45 45 2e calling CALLEE.
1710: 20 20 52 65 74 75 72 6e 20 56 41 4c 55 45 20 69 Return VALUE i
1720: 66 20 6e 6f 0a 3b 3b 3b 20 20 20 65 72 72 6f 72 f no.;;; error
1730: 20 77 61 73 20 73 69 67 6e 61 6c 6c 65 64 2e 0a was signalled..
1740: 28 64 65 66 69 6e 65 20 28 63 68 65 63 6b 2d 74 (define (check-t
1750: 79 70 65 20 70 72 65 64 3f 20 76 61 6c 75 65 20 ype pred? value
1760: 63 61 6c 6c 65 65 29 0a 20 20 28 69 66 20 28 70 callee). (if (p
1770: 72 65 64 3f 20 76 61 6c 75 65 29 0a 20 20 20 20 red? value).
1780: 20 20 76 61 6c 75 65 0a 20 20 20 20 20 20 3b 3b value. ;;
1790: 20 52 65 63 75 72 3a 20 77 68 65 6e 20 28 6f 72 Recur: when (or
17a0: 20 69 66 29 20 74 68 65 20 75 73 65 72 20 67 65 if) the user ge
17b0: 74 73 20 61 20 64 65 62 75 67 67 65 72 20 70 72 ts a debugger pr
17c0: 6f 6d 70 74 2c 20 68 65 20 63 61 6e 0a 20 20 20 ompt, he can.
17d0: 20 20 20 3b 3b 20 70 72 6f 63 65 65 64 20 77 68 ;; proceed wh
17e0: 65 72 65 20 74 68 65 20 63 61 6c 6c 20 74 6f 20 ere the call to
17f0: 45 52 52 4f 52 20 77 61 73 20 77 69 74 68 20 74 ERROR was with t
1800: 68 65 20 63 6f 72 72 65 63 74 20 76 61 6c 75 65 he correct value
1810: 2e 0a 20 20 20 20 20 20 28 63 68 65 63 6b 2d 74 .. (check-t
1820: 79 70 65 20 70 72 65 64 3f 0a 20 20 20 20 20 20 ype pred?.
1830: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 (err
1840: 6f 72 20 22 65 72 72 6f 6e 65 6f 75 73 20 76 61 or "erroneous va
1850: 6c 75 65 22 0a 20 20 20 20 20 20 20 20 20 20 20 lue".
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1870: 69 73 74 20 70 72 65 64 3f 20 76 61 6c 75 65 29 ist pred? value)
1880: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1890: 20 20 20 20 20 20 20 20 20 20 60 28 77 68 69 6c `(whil
18a0: 65 20 63 61 6c 6c 69 6e 67 20 2c 63 61 6c 6c 65 e calling ,calle
18b0: 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e)).
18c0: 20 20 20 20 20 20 63 61 6c 6c 65 65 29 29 29 0a callee))).
18d0: 0a 3b 3b 3b 20 28 43 48 45 43 4b 2d 49 4e 44 45 .;;; (CHECK-INDE
18e0: 58 20 3c 76 65 63 74 6f 72 3e 20 3c 69 6e 64 65 X <vector> <inde
18f0: 78 3e 20 3c 63 61 6c 6c 65 65 3e 29 20 2d 3e 20 x> <callee>) ->
1900: 69 6e 64 65 78 0a 3b 3b 3b 20 20 20 45 6e 73 75 index.;;; Ensu
1910: 72 65 20 74 68 61 74 20 49 4e 44 45 58 20 69 73 re that INDEX is
1920: 20 61 20 76 61 6c 69 64 20 69 6e 64 65 78 20 69 a valid index i
1930: 6e 74 6f 20 56 45 43 54 4f 52 3b 20 69 66 20 6e nto VECTOR; if n
1940: 6f 74 2c 20 73 69 67 6e 61 6c 20 61 6e 0a 3b 3b ot, signal an.;;
1950: 3b 20 20 20 65 72 72 6f 72 20 73 74 61 74 69 6e ; error statin
1960: 67 20 74 68 61 74 20 69 74 20 69 73 20 6e 6f 74 g that it is not
1970: 20 61 6e 64 20 74 68 61 74 20 74 68 69 73 20 68 and that this h
1980: 61 70 70 65 6e 65 64 20 69 6e 20 61 20 63 61 6c appened in a cal
1990: 6c 20 74 6f 0a 3b 3b 3b 20 20 20 43 41 4c 4c 45 l to.;;; CALLE
19a0: 45 2e 20 20 52 65 74 75 72 6e 20 49 4e 44 45 58 E. Return INDEX
19b0: 20 77 68 65 6e 20 69 74 20 69 73 20 76 61 6c 69 when it is vali
19c0: 64 2e 20 20 28 4e 6f 74 65 20 74 68 61 74 20 74 d. (Note that t
19d0: 68 69 73 20 64 6f 65 73 20 4e 4f 54 0a 3b 3b 3b his does NOT.;;;
19e0: 20 20 20 63 68 65 63 6b 20 74 68 61 74 20 56 45 check that VE
19f0: 43 54 4f 52 20 69 73 20 69 6e 64 65 65 64 20 61 CTOR is indeed a
1a00: 20 76 65 63 74 6f 72 2e 29 0a 28 64 65 66 69 6e vector.).(defin
1a10: 65 20 28 63 68 65 63 6b 2d 69 6e 64 65 78 20 76 e (check-index v
1a20: 65 63 20 69 6e 64 65 78 20 63 61 6c 6c 65 65 29 ec index callee)
1a30: 0a 20 20 28 6c 65 74 20 28 28 69 6e 64 65 78 20 . (let ((index
1a40: 28 63 68 65 63 6b 2d 74 79 70 65 20 69 6e 74 65 (check-type inte
1a50: 67 65 72 3f 20 69 6e 64 65 78 20 63 61 6c 6c 65 ger? index calle
1a60: 65 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 20 28 e))). (cond (
1a70: 28 3c 20 69 6e 64 65 78 20 30 29 0a 20 20 20 20 (< index 0).
1a80: 20 20 20 20 20 20 20 28 63 68 65 63 6b 2d 69 6e (check-in
1a90: 64 65 78 20 76 65 63 0a 20 20 20 20 20 20 20 20 dex vec.
1aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ab0: 28 65 72 72 6f 72 20 22 76 65 63 74 6f 72 20 69 (error "vector i
1ac0: 6e 64 65 78 20 74 6f 6f 20 6c 6f 77 22 0a 20 20 ndex too low".
1ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 64 ind
1af0: 65 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ex.
1b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b10: 20 20 60 28 69 6e 74 6f 20 76 65 63 74 6f 72 20 `(into vector
1b20: 2c 76 65 63 29 0a 20 20 20 20 20 20 20 20 20 20 ,vec).
1b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b40: 20 20 20 20 20 60 28 77 68 69 6c 65 20 63 61 6c `(while cal
1b50: 6c 69 6e 67 20 2c 63 61 6c 6c 65 65 29 29 0a 20 ling ,callee)).
1b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b70: 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 29 0a callee)).
1b80: 20 20 20 20 20 20 20 20 20 20 28 28 3e 3d 20 69 ((>= i
1b90: 6e 64 65 78 20 28 76 65 63 74 6f 72 2d 6c 65 6e ndex (vector-len
1ba0: 67 74 68 20 76 65 63 29 29 0a 20 20 20 20 20 20 gth vec)).
1bb0: 20 20 20 20 20 28 63 68 65 63 6b 2d 69 6e 64 65 (check-inde
1bc0: 78 20 76 65 63 0a 20 20 20 20 20 20 20 20 20 20 x vec.
1bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
1be0: 72 72 6f 72 20 22 76 65 63 74 6f 72 20 69 6e 64 rror "vector ind
1bf0: 65 78 20 74 6f 6f 20 68 69 67 68 22 0a 20 20 20 ex too high".
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c10: 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 64 65 inde
1c20: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
1c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c40: 20 60 28 69 6e 74 6f 20 76 65 63 74 6f 72 20 2c `(into vector ,
1c50: 76 65 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 vec).
1c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c70: 20 20 20 20 60 28 77 68 69 6c 65 20 63 61 6c 6c `(while call
1c80: 69 6e 67 20 2c 63 61 6c 6c 65 65 29 29 0a 20 20 ing ,callee)).
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ca0: 20 20 20 20 20 20 63 61 6c 6c 65 65 29 29 0a 20 callee)).
1cb0: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 69 (else i
1cc0: 6e 64 65 78 29 29 29 29 0a 0a 3b 3b 3b 20 28 43 ndex))))..;;; (C
1cd0: 48 45 43 4b 2d 49 4e 44 49 43 45 53 20 3c 76 65 HECK-INDICES <ve
1ce0: 63 74 6f 72 3e 0a 3b 3b 3b 20 20 20 20 20 20 20 ctor>.;;;
1cf0: 20 20 20 20 20 20 20 20 20 3c 73 74 61 72 74 3e <start>
1d00: 20 3c 73 74 61 72 74 2d 6e 61 6d 65 3e 0a 3b 3b <start-name>.;;
1d10: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
1d20: 20 3c 65 6e 64 3e 20 3c 65 6e 64 2d 6e 61 6d 65 <end> <end-name
1d30: 3e 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 20 20 >.;;;
1d40: 20 20 20 20 20 3c 63 61 6c 6c 65 72 3e 29 20 2d <caller>) -
1d50: 3e 20 5b 73 74 61 72 74 20 65 6e 64 5d 0a 3b 3b > [start end].;;
1d60: 3b 20 20 20 45 6e 73 75 72 65 20 74 68 61 74 20 ; Ensure that
1d70: 53 54 41 52 54 20 61 6e 64 20 45 4e 44 20 61 72 START and END ar
1d80: 65 20 76 61 6c 69 64 20 62 6f 75 6e 64 73 20 6f e valid bounds o
1d90: 66 20 61 20 72 61 6e 67 65 20 77 69 74 68 69 6e f a range within
1da0: 0a 3b 3b 3b 20 20 20 56 45 43 54 4f 52 3b 20 69 .;;; VECTOR; i
1db0: 66 20 6e 6f 74 2c 20 73 69 67 6e 61 6c 20 61 6e f not, signal an
1dc0: 20 65 72 72 6f 72 20 73 74 61 74 69 6e 67 20 74 error stating t
1dd0: 68 61 74 20 74 68 65 79 20 61 72 65 20 6e 6f 74 hat they are not
1de0: 2c 20 77 69 74 68 0a 3b 3b 3b 20 20 20 74 68 65 , with.;;; the
1df0: 20 6d 65 73 73 61 67 65 20 62 65 69 6e 67 20 69 message being i
1e00: 6e 66 6f 72 6d 61 74 69 76 65 20 61 62 6f 75 74 nformative about
1e10: 20 77 68 61 74 20 74 68 65 20 61 72 67 75 6d 65 what the argume
1e20: 6e 74 20 6e 61 6d 65 73 20 77 65 72 65 0a 3b 3b nt names were.;;
1e30: 3b 20 20 20 63 61 6c 6c 65 64 20 2d 2d 20 62 79 ; called -- by
1e40: 20 75 73 69 6e 67 20 53 54 41 52 54 2d 4e 41 4d using START-NAM
1e50: 45 20 26 20 45 4e 44 2d 4e 41 4d 45 20 2d 2d 2c E & END-NAME --,
1e60: 20 61 6e 64 20 74 68 61 74 20 69 74 20 6f 63 63 and that it occ
1e70: 75 72 72 65 64 0a 3b 3b 3b 20 20 20 77 68 69 6c urred.;;; whil
1e80: 65 20 63 61 6c 6c 69 6e 67 20 43 41 4c 4c 45 45 e calling CALLEE
1e90: 2e 20 20 41 6c 73 6f 20 65 6e 73 75 72 65 20 74 . Also ensure t
1ea0: 68 61 74 20 56 45 43 20 69 73 20 69 6e 20 66 61 hat VEC is in fa
1eb0: 63 74 20 61 20 76 65 63 74 6f 72 2e 0a 3b 3b 3b ct a vector..;;;
1ec0: 20 20 20 52 65 74 75 72 6e 73 20 6e 6f 20 75 73 Returns no us
1ed0: 65 66 75 6c 20 76 61 6c 75 65 2e 0a 28 64 65 66 eful value..(def
1ee0: 69 6e 65 20 28 63 68 65 63 6b 2d 69 6e 64 69 63 ine (check-indic
1ef0: 65 73 20 76 65 63 20 73 74 61 72 74 20 73 74 61 es vec start sta
1f00: 72 74 2d 6e 61 6d 65 20 65 6e 64 20 65 6e 64 2d rt-name end end-
1f10: 6e 61 6d 65 20 63 61 6c 6c 65 65 29 0a 20 20 28 name callee). (
1f20: 6c 65 74 20 28 28 6c 6f 73 65 20 28 6c 61 6d 62 let ((lose (lamb
1f30: 64 61 20 74 68 69 6e 67 73 0a 20 20 20 20 20 20 da things.
1f40: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
1f50: 20 65 72 72 6f 72 20 22 76 65 63 74 6f 72 20 72 error "vector r
1f60: 61 6e 67 65 20 6f 75 74 20 6f 66 20 62 6f 75 6e ange out of boun
1f70: 64 73 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 ds".
1f80: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 65 (appe
1f90: 6e 64 20 74 68 69 6e 67 73 0a 20 20 20 20 20 20 nd things.
1fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fb0: 20 20 20 20 20 20 20 20 20 60 28 76 65 63 74 6f `(vecto
1fc0: 72 20 77 61 73 20 2c 76 65 63 29 0a 20 20 20 20 r was ,vec).
1fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fe0: 20 20 20 20 20 20 20 20 20 20 20 60 28 2c 73 74 `(,st
1ff0: 61 72 74 2d 6e 61 6d 65 20 77 61 73 20 2c 73 74 art-name was ,st
2000: 61 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 art).
2010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2020: 20 20 20 20 60 28 2c 65 6e 64 2d 6e 61 6d 65 20 `(,end-name
2030: 77 61 73 20 2c 65 6e 64 29 0a 20 20 20 20 20 20 was ,end).
2040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2050: 20 20 20 20 20 20 20 20 20 60 28 77 68 69 6c 65 `(while
2060: 20 63 61 6c 6c 69 6e 67 20 2c 63 61 6c 6c 65 65 calling ,callee
2070: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 73 ))))). (s
2080: 74 61 72 74 20 28 63 68 65 63 6b 2d 74 79 70 65 tart (check-type
2090: 20 69 6e 74 65 67 65 72 3f 20 73 74 61 72 74 20 integer? start
20a0: 63 61 6c 6c 65 65 29 29 0a 20 20 20 20 20 20 20 callee)).
20b0: 20 28 65 6e 64 20 20 20 28 63 68 65 63 6b 2d 74 (end (check-t
20c0: 79 70 65 20 69 6e 74 65 67 65 72 3f 20 65 6e 64 ype integer? end
20d0: 20 20 20 63 61 6c 6c 65 65 29 29 29 0a 20 20 20 callee))).
20e0: 20 28 63 6f 6e 64 20 28 28 3e 20 73 74 61 72 74 (cond ((> start
20f0: 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 end).
2100: 20 3b 3b 20 49 27 6d 20 6e 6f 74 20 73 75 72 65 ;; I'm not sure
2110: 20 68 6f 77 20 77 65 6c 6c 20 74 68 69 73 20 77 how well this w
2120: 69 6c 6c 20 77 6f 72 6b 2e 20 20 54 68 65 20 69 ill work. The i
2130: 6e 74 65 6e 74 20 69 73 20 74 68 61 74 0a 20 20 ntent is that.
2140: 20 20 20 20 20 20 20 20 20 3b 3b 20 74 68 65 20 ;; the
2150: 70 72 6f 67 72 61 6d 6d 65 72 20 74 65 6c 6c 73 programmer tells
2160: 20 74 68 65 20 64 65 62 75 67 67 65 72 20 74 6f the debugger to
2170: 20 70 72 6f 63 65 65 64 20 77 69 74 68 20 62 6f proceed with bo
2180: 74 68 20 61 0a 20 20 20 20 20 20 20 20 20 20 20 th a.
2190: 3b 3b 20 6e 65 77 20 53 54 41 52 54 20 26 20 61 ;; new START & a
21a0: 20 6e 65 77 20 45 4e 44 20 62 79 20 72 65 74 75 new END by retu
21b0: 72 6e 69 6e 67 20 6d 75 6c 74 69 70 6c 65 20 76 rning multiple v
21c0: 61 6c 75 65 73 0a 20 20 20 20 20 20 20 20 20 20 alues.
21d0: 20 3b 3b 20 73 6f 6d 65 77 68 65 72 65 2e 0a 20 ;; somewhere..
21e0: 20 20 20 20 20 20 20 20 20 20 28 72 65 63 65 69 (recei
21f0: 76 65 20 28 6e 65 77 2d 73 74 61 72 74 20 6e 65 ve (new-start ne
2200: 77 2d 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 w-end).
2210: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 73 65 (lose
2220: 20 60 28 2c 65 6e 64 2d 6e 61 6d 65 20 3c 20 2c `(,end-name < ,
2230: 73 74 61 72 74 2d 6e 61 6d 65 29 29 0a 20 20 20 start-name)).
2240: 20 20 20 20 20 20 20 20 20 20 28 63 68 65 63 6b (check
2250: 2d 69 6e 64 69 63 65 73 20 76 65 63 0a 20 20 20 -indices vec.
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 20 20 20 20 20 20 20 20 6e 65 77 2d 73 74 61 new-sta
2280: 72 74 20 73 74 61 72 74 2d 6e 61 6d 65 0a 20 20 rt start-name.
2290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22a0: 20 20 20 20 20 20 20 20 20 20 6e 65 77 2d 65 6e new-en
22b0: 64 20 65 6e 64 2d 6e 61 6d 65 0a 20 20 20 20 20 d end-name.
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22d0: 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 29 29 callee)))
22e0: 0a 20 20 20 20 20 20 20 20 20 20 28 28 3c 20 73 . ((< s
22f0: 74 61 72 74 20 30 29 0a 20 20 20 20 20 20 20 20 tart 0).
2300: 20 20 20 28 63 68 65 63 6b 2d 69 6e 64 69 63 65 (check-indice
2310: 73 20 76 65 63 0a 20 20 20 20 20 20 20 20 20 20 s vec.
2320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2330: 28 6c 6f 73 65 20 60 28 2c 73 74 61 72 74 2d 6e (lose `(,start-n
2340: 61 6d 65 20 3c 20 30 29 29 0a 20 20 20 20 20 20 ame < 0)).
2350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2360: 20 20 20 20 73 74 61 72 74 2d 6e 61 6d 65 0a 20 start-name.
2370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2380: 20 20 20 20 20 20 20 20 20 65 6e 64 20 65 6e 64 end end
2390: 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 -name.
23a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23b0: 63 61 6c 6c 65 65 29 29 0a 20 20 20 20 20 20 20 callee)).
23c0: 20 20 20 28 28 3e 3d 20 73 74 61 72 74 20 28 76 ((>= start (v
23d0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 ector-length vec
23e0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 )). (c
23f0: 68 65 63 6b 2d 69 6e 64 69 63 65 73 20 76 65 63 heck-indices vec
2400: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2410: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 73 65 (lose
2420: 20 60 28 2c 73 74 61 72 74 2d 6e 61 6d 65 20 3e `(,start-name >
2430: 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 len).
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2450: 20 20 20 20 20 20 60 28 6c 65 6e 20 77 61 73 20 `(len was
2460: 2c 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 ,(vector-length
2470: 76 65 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 vec))).
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2490: 20 73 74 61 72 74 2d 6e 61 6d 65 0a 20 20 20 20 start-name.
24a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24b0: 20 20 20 20 20 20 65 6e 64 20 65 6e 64 2d 6e 61 end end-na
24c0: 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 me.
24d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 61 6c cal
24e0: 6c 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 lee)).
24f0: 28 28 3e 20 65 6e 64 20 28 76 65 63 74 6f 72 2d ((> end (vector-
2500: 6c 65 6e 67 74 68 20 76 65 63 29 29 0a 20 20 20 length vec)).
2510: 20 20 20 20 20 20 20 20 28 63 68 65 63 6b 2d 69 (check-i
2520: 6e 64 69 63 65 73 20 76 65 63 0a 20 20 20 20 20 ndices vec.
2530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2540: 20 20 20 20 20 73 74 61 72 74 20 73 74 61 72 74 start start
2550: 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 -name.
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2570: 28 6c 6f 73 65 20 60 28 2c 65 6e 64 2d 6e 61 6d (lose `(,end-nam
2580: 65 20 3e 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 e > len).
2590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25a0: 20 20 20 20 20 20 20 20 20 60 28 6c 65 6e 20 77 `(len w
25b0: 61 73 20 2c 28 76 65 63 74 6f 72 2d 6c 65 6e 67 as ,(vector-leng
25c0: 74 68 20 76 65 63 29 29 29 0a 20 20 20 20 20 20 th vec))).
25d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25e0: 20 20 20 20 65 6e 64 2d 6e 61 6d 65 0a 20 20 20 end-name.
25f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2600: 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 29 0a callee)).
2610: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
2620: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu
2630: 65 73 20 73 74 61 72 74 20 65 6e 64 29 29 29 29 es start end))))
2640: 29 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d ).....;;; ------
2650: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b --------------.;
2660: 3b 3b 20 49 6e 74 65 72 6e 61 6c 20 72 6f 75 74 ;; Internal rout
2670: 69 6e 65 73 0a 0a 3b 3b 3b 20 54 68 65 73 65 20 ines..;;; These
2680: 73 68 6f 75 6c 64 20 61 6c 6c 20 62 65 20 69 6e should all be in
2690: 74 65 67 72 61 74 65 64 2c 20 6e 61 74 69 76 65 tegrated, native
26a0: 2c 20 6f 72 20 6f 74 68 65 72 77 69 73 65 20 6f , or otherwise o
26b0: 70 74 69 6d 69 7a 65 64 20 2d 2d 0a 3b 3b 3b 20 ptimized --.;;;
26c0: 74 68 65 79 27 72 65 20 75 73 65 64 20 61 20 5f they're used a _
26d0: 6c 6f 74 5f 20 2d 2d 2e 20 20 41 6c 6c 20 6f 66 lot_ --. All of
26e0: 20 74 68 65 20 6c 6f 6f 70 73 20 61 6e 64 20 4c the loops and L
26f0: 45 54 73 20 69 6e 73 69 64 65 20 6c 6f 6f 70 73 ETs inside loops
2700: 0a 3b 3b 3b 20 61 72 65 20 6c 61 6d 62 64 61 2d .;;; are lambda-
2710: 6c 69 66 74 65 64 20 62 79 20 68 61 6e 64 2c 20 lifted by hand,
2720: 6a 75 73 74 20 73 6f 20 61 73 20 6e 6f 74 20 74 just so as not t
2730: 6f 20 63 6f 6e 73 20 63 6c 6f 73 75 72 65 73 20 o cons closures
2740: 69 6e 20 74 68 65 0a 3b 3b 3b 20 6c 6f 6f 70 73 in the.;;; loops
2750: 2e 20 20 28 49 66 20 79 6f 75 72 20 63 6f 6d 70 . (If your comp
2760: 69 6c 65 72 20 63 61 6e 20 64 6f 20 62 65 74 74 iler can do bett
2770: 65 72 20 74 68 61 6e 20 74 68 61 74 20 69 66 20 er than that if
2780: 74 68 65 79 27 72 65 20 6e 6f 74 0a 3b 3b 3b 20 they're not.;;;
2790: 6c 61 6d 62 64 61 2d 6c 69 66 74 65 64 2c 20 74 lambda-lifted, t
27a0: 68 65 6e 20 6c 61 6d 62 64 61 2d 64 72 6f 70 20 hen lambda-drop
27b0: 28 3f 29 20 74 68 65 6d 2e 29 0a 0a 3b 3b 3b 20 (?) them.)..;;;
27c0: 28 56 45 43 54 4f 52 2d 50 41 52 53 45 2d 53 54 (VECTOR-PARSE-ST
27d0: 41 52 54 2b 45 4e 44 20 3c 76 65 63 74 6f 72 3e ART+END <vector>
27e0: 20 3c 61 72 67 75 6d 65 6e 74 73 3e 0a 3b 3b 3b <arguments>.;;;
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2800: 20 20 20 20 20 20 20 20 20 3c 73 74 61 72 74 2d <start-
2810: 6e 61 6d 65 3e 20 3c 65 6e 64 2d 6e 61 6d 65 3e name> <end-name>
2820: 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 .;;;
2830: 20 20 20 20 20 20 20 20 20 20 20 20 20 3c 63 61 <ca
2840: 6c 6c 65 65 3e 29 0a 3b 3b 3b 20 20 20 20 20 20 llee>).;;;
2850: 20 2d 3e 20 5b 73 74 61 72 74 20 65 6e 64 5d 0a -> [start end].
2860: 3b 3b 3b 20 20 20 52 65 74 75 72 6e 20 74 77 6f ;;; Return two
2870: 20 76 61 6c 75 65 73 2c 20 63 6f 6d 70 6f 73 69 values, composi
2880: 6e 67 20 61 20 76 61 6c 69 64 20 72 61 6e 67 65 ng a valid range
2890: 20 77 69 74 68 69 6e 20 56 45 43 54 4f 52 2c 20 within VECTOR,
28a0: 61 73 0a 3b 3b 3b 20 20 20 65 78 74 72 61 63 74 as.;;; extract
28b0: 65 64 20 66 72 6f 6d 20 41 52 47 55 4d 45 4e 54 ed from ARGUMENT
28c0: 53 20 6f 72 20 64 65 66 61 75 6c 74 65 64 20 66 S or defaulted f
28d0: 72 6f 6d 20 56 45 43 54 4f 52 20 2d 2d 20 30 20 rom VECTOR -- 0
28e0: 66 6f 72 20 53 54 41 52 54 0a 3b 3b 3b 20 20 20 for START.;;;
28f0: 61 6e 64 20 74 68 65 20 6c 65 6e 67 74 68 20 6f and the length o
2900: 66 20 56 45 43 54 4f 52 20 66 6f 72 20 45 4e 44 f VECTOR for END
2910: 20 2d 2d 3b 20 53 54 41 52 54 2d 4e 41 4d 45 20 --; START-NAME
2920: 61 6e 64 20 45 4e 44 2d 4e 41 4d 45 20 61 72 65 and END-NAME are
2930: 0a 3b 3b 3b 20 20 20 70 75 72 65 6c 79 20 66 6f .;;; purely fo
2940: 72 20 65 72 72 6f 72 20 63 68 65 63 6b 69 6e 67 r error checking
2950: 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 63 74 6f ..(define (vecto
2960: 72 2d 70 61 72 73 65 2d 73 74 61 72 74 2b 65 6e r-parse-start+en
2970: 64 20 76 65 63 20 61 72 67 73 20 73 74 61 72 74 d vec args start
2980: 2d 6e 61 6d 65 20 65 6e 64 2d 6e 61 6d 65 20 63 -name end-name c
2990: 61 6c 6c 65 65 29 0a 20 20 28 6c 65 74 20 28 28 allee). (let ((
29a0: 6c 65 6e 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 len (vector-leng
29b0: 74 68 20 76 65 63 29 29 29 0a 20 20 20 20 28 63 th vec))). (c
29c0: 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 61 72 67 73 ond ((null? args
29d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 76 61 ). (va
29e0: 6c 75 65 73 20 30 20 6c 65 6e 29 29 0a 20 20 20 lues 0 len)).
29f0: 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 ((null? (
2a00: 63 64 72 20 61 72 67 73 29 29 0a 20 20 20 20 20 cdr args)).
2a10: 20 20 20 20 20 20 28 63 68 65 63 6b 2d 69 6e 64 (check-ind
2a20: 69 63 65 73 20 76 65 63 0a 20 20 20 20 20 20 20 ices vec.
2a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a40: 20 20 20 28 63 61 72 20 61 72 67 73 29 20 73 74 (car args) st
2a50: 61 72 74 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 art-name.
2a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a70: 20 20 20 6c 65 6e 20 65 6e 64 2d 6e 61 6d 65 0a len end-name.
2a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a90: 20 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 callee
2aa0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e )). ((n
2ab0: 75 6c 6c 3f 20 28 63 64 64 72 20 61 72 67 73 29 ull? (cddr args)
2ac0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 68 ). (ch
2ad0: 65 63 6b 2d 69 6e 64 69 63 65 73 20 76 65 63 0a eck-indices vec.
2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2af0: 20 20 20 20 20 20 20 20 20 20 28 63 61 72 20 20 (car
2b00: 61 72 67 73 29 20 73 74 61 72 74 2d 6e 61 6d 65 args) start-name
2b10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2b20: 20 20 20 20 20 20 20 20 20 20 20 28 63 61 64 72 (cadr
2b30: 20 61 72 67 73 29 20 65 6e 64 2d 6e 61 6d 65 0a args) end-name.
2b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b50: 20 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 callee
2b60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c )). (el
2b70: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 se. (e
2b80: 72 72 6f 72 20 22 74 6f 6f 20 6d 61 6e 79 20 61 rror "too many a
2b90: 72 67 75 6d 65 6e 74 73 22 0a 20 20 20 20 20 20 rguments".
2ba0: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 65 78 `(ex
2bb0: 74 72 61 20 61 72 67 73 20 77 65 72 65 20 2c 28 tra args were ,(
2bc0: 63 64 64 72 20 61 72 67 73 29 29 0a 20 20 20 20 cddr args)).
2bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
2be0: 77 68 69 6c 65 20 63 61 6c 6c 69 6e 67 20 2c 63 while calling ,c
2bf0: 61 6c 6c 65 65 29 29 29 29 29 29 0a 0a 28 64 65 allee))))))..(de
2c00: 66 69 6e 65 2d 73 79 6e 74 61 78 20 6c 65 74 2d fine-syntax let-
2c10: 76 65 63 74 6f 72 2d 73 74 61 72 74 2b 65 6e 64 vector-start+end
2c20: 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 . (syntax-rules
2c30: 20 28 29 0a 20 20 20 20 28 28 6c 65 74 2d 76 65 (). ((let-ve
2c40: 63 74 6f 72 2d 73 74 61 72 74 2b 65 6e 64 20 3f ctor-start+end ?
2c50: 63 61 6c 6c 65 65 20 3f 76 65 63 20 3f 61 72 67 callee ?vec ?arg
2c60: 73 20 28 3f 73 74 61 72 74 20 3f 65 6e 64 29 0a s (?start ?end).
2c70: 20 20 20 20 20 20 20 3f 62 6f 64 79 31 20 3f 62 ?body1 ?b
2c80: 6f 64 79 32 20 2e 2e 2e 29 0a 20 20 20 20 20 28 ody2 ...). (
2c90: 6c 65 74 20 28 28 3f 76 65 63 20 28 63 68 65 63 let ((?vec (chec
2ca0: 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 3f k-type vector? ?
2cb0: 76 65 63 20 3f 63 61 6c 6c 65 65 29 29 29 0a 20 vec ?callee))).
2cc0: 20 20 20 20 20 20 28 72 65 63 65 69 76 65 20 28 (receive (
2cd0: 3f 73 74 61 72 74 20 3f 65 6e 64 29 0a 20 20 20 ?start ?end).
2ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
2cf0: 63 74 6f 72 2d 70 61 72 73 65 2d 73 74 61 72 74 ctor-parse-start
2d00: 2b 65 6e 64 20 3f 76 65 63 20 3f 61 72 67 73 20 +end ?vec ?args
2d10: 27 3f 73 74 61 72 74 20 27 3f 65 6e 64 0a 20 20 '?start '?end.
2d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d40: 20 20 20 20 20 20 3f 63 61 6c 6c 65 65 29 0a 20 ?callee).
2d50: 20 20 20 20 20 20 20 20 3f 62 6f 64 79 31 20 3f ?body1 ?
2d60: 62 6f 64 79 32 20 2e 2e 2e 29 29 29 29 29 0a 0a body2 ...)))))..
2d70: 3b 3b 3b 20 28 25 53 4d 41 4c 4c 45 53 54 2d 4c ;;; (%SMALLEST-L
2d80: 45 4e 47 54 48 20 3c 76 65 63 74 6f 72 2d 6c 69 ENGTH <vector-li
2d90: 73 74 3e 20 3c 64 65 66 61 75 6c 74 2d 6c 65 6e st> <default-len
2da0: 67 74 68 3e 20 3c 63 61 6c 6c 65 65 3e 29 0a 3b gth> <callee>).;
2db0: 3b 3b 20 20 20 20 20 20 20 2d 3e 20 65 78 61 63 ;; -> exac
2dc0: 74 2c 20 6e 6f 6e 6e 65 67 61 74 69 76 65 20 69 t, nonnegative i
2dd0: 6e 74 65 67 65 72 0a 3b 3b 3b 20 20 20 43 6f 6d nteger.;;; Com
2de0: 70 75 74 65 20 74 68 65 20 73 6d 61 6c 6c 65 73 pute the smalles
2df0: 74 20 6c 65 6e 67 74 68 20 6f 66 20 56 45 43 54 t length of VECT
2e00: 4f 52 2d 4c 49 53 54 2e 20 20 44 45 46 41 55 4c OR-LIST. DEFAUL
2e10: 54 2d 4c 45 4e 47 54 48 20 69 73 0a 3b 3b 3b 20 T-LENGTH is.;;;
2e20: 20 20 74 68 65 20 6c 65 6e 67 74 68 20 74 68 61 the length tha
2e30: 74 20 69 73 20 72 65 74 75 72 6e 65 64 20 69 66 t is returned if
2e40: 20 56 45 43 54 4f 52 2d 4c 49 53 54 20 69 73 20 VECTOR-LIST is
2e50: 65 6d 70 74 79 2e 20 20 43 6f 6d 6d 6f 6e 20 75 empty. Common u
2e60: 73 65 0a 3b 3b 3b 20 20 20 6f 66 20 74 68 69 73 se.;;; of this
2e70: 20 69 73 20 69 6e 20 6e 2d 61 72 79 20 76 65 63 is in n-ary vec
2e80: 74 6f 72 20 72 6f 75 74 69 6e 65 73 3a 0a 3b 3b tor routines:.;;
2e90: 3b 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 66 ; (define (f
2ea0: 20 76 65 63 20 2e 20 76 65 63 74 6f 72 73 29 0a vec . vectors).
2eb0: 3b 3b 3b 20 20 20 20 20 20 20 28 6c 65 74 20 28 ;;; (let (
2ec0: 28 76 65 63 20 28 63 68 65 63 6b 2d 74 79 70 65 (vec (check-type
2ed0: 20 76 65 63 74 6f 72 3f 20 76 65 63 20 66 29 29 vector? vec f))
2ee0: 29 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 2e 2e ).;;; ..
2ef0: 2e 28 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 6e 67 .(%smallest-leng
2f00: 74 68 20 76 65 63 74 6f 72 73 20 28 76 65 63 74 th vectors (vect
2f10: 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 20 66 or-length vec) f
2f20: 29 2e 2e 2e 29 29 0a 3b 3b 3b 20 20 20 25 53 4d )...)).;;; %SM
2f30: 41 4c 4c 45 53 54 2d 4c 45 4e 47 54 48 20 74 61 ALLEST-LENGTH ta
2f40: 6b 65 73 20 63 61 72 65 20 6f 66 20 74 68 65 20 kes care of the
2f50: 74 79 70 65 20 63 68 65 63 6b 69 6e 67 20 2d 2d type checking --
2f60: 20 77 68 69 63 68 20 69 73 20 77 68 61 74 0a 3b which is what.;
2f70: 3b 3b 20 20 20 74 68 65 20 43 41 4c 4c 45 45 20 ;; the CALLEE
2f80: 61 72 67 75 6d 65 6e 74 20 69 73 20 66 6f 72 20 argument is for
2f90: 2d 2d 3b 20 74 68 75 73 2c 20 74 68 65 20 64 65 --; thus, the de
2fa0: 73 69 67 6e 20 69 73 20 74 75 6e 65 64 20 66 6f sign is tuned fo
2fb0: 72 0a 3b 3b 3b 20 20 20 61 76 6f 69 64 69 6e 67 r.;;; avoiding
2fc0: 20 72 65 64 75 6e 64 61 6e 74 20 74 79 70 65 20 redundant type
2fd0: 63 68 65 63 6b 73 2e 0a 28 64 65 66 69 6e 65 20 checks..(define
2fe0: 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 6e 67 74 68 %smallest-length
2ff0: 0a 20 20 28 6c 65 74 72 65 63 20 28 28 6c 6f 6f . (letrec ((loo
3000: 70 20 28 6c 61 6d 62 64 61 20 28 76 65 63 74 6f p (lambda (vecto
3010: 72 2d 6c 69 73 74 20 6c 65 6e 67 74 68 20 63 61 r-list length ca
3020: 6c 6c 65 65 29 0a 20 20 20 20 20 20 20 20 20 20 llee).
3030: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
3040: 6c 6c 3f 20 76 65 63 74 6f 72 2d 6c 69 73 74 29 ll? vector-list)
3050: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3060: 20 20 20 20 20 20 20 20 6c 65 6e 67 74 68 0a 20 length.
3070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3080: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 (loop (cdr
3090: 20 76 65 63 74 6f 72 2d 6c 69 73 74 29 0a 20 20 vector-list).
30a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30b0: 20 20 20 20 20 20 20 20 20 20 20 28 6d 69 6e 20 (min
30c0: 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 0a 20 (vector-length.
30d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30f0: 20 20 28 63 68 65 63 6b 2d 74 79 70 65 20 76 65 (check-type ve
3100: 63 74 6f 72 3f 0a 20 20 20 20 20 20 20 20 20 20 ctor?.
3110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3130: 20 20 20 20 20 28 63 61 72 20 76 65 63 74 6f 72 (car vector
3140: 2d 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 -list).
3150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3170: 20 20 20 20 20 20 63 61 6c 6c 65 65 29 29 0a 20 callee)).
3180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31a0: 20 6c 65 6e 67 74 68 29 0a 20 20 20 20 20 20 20 length).
31b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31c0: 20 20 20 20 20 20 63 61 6c 6c 65 65 29 29 29 29 callee))))
31d0: 29 0a 20 20 20 20 6c 6f 6f 70 29 29 0a 0a 3b 3b ). loop))..;;
31e0: 3b 20 28 25 56 45 43 54 4f 52 2d 43 4f 50 59 21 ; (%VECTOR-COPY!
31f0: 20 3c 74 61 72 67 65 74 3e 20 3c 74 73 74 61 72 <target> <tstar
3200: 74 3e 20 3c 73 6f 75 72 63 65 3e 20 3c 73 73 74 t> <source> <sst
3210: 61 72 74 3e 20 3c 73 65 6e 64 3e 29 0a 3b 3b 3b art> <send>).;;;
3220: 20 20 20 43 6f 70 79 20 65 6c 65 6d 65 6e 74 73 Copy elements
3230: 20 61 74 20 6c 6f 63 61 74 69 6f 6e 73 20 53 53 at locations SS
3240: 54 41 52 54 20 74 6f 20 53 45 4e 44 20 66 72 6f TART to SEND fro
3250: 6d 20 53 4f 55 52 43 45 20 74 6f 20 54 41 52 47 m SOURCE to TARG
3260: 45 54 2c 0a 3b 3b 3b 20 20 20 73 74 61 72 74 69 ET,.;;; starti
3270: 6e 67 20 61 74 20 54 53 54 41 52 54 20 69 6e 20 ng at TSTART in
3280: 54 41 52 47 45 54 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 TARGET..;;;.;;;
3290: 4f 70 74 69 6d 69 7a 65 20 74 68 69 73 21 20 20 Optimize this!
32a0: 50 72 6f 62 61 62 6c 79 20 77 69 74 68 20 73 6f Probably with so
32b0: 6d 65 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 20 6f me combination o
32c0: 66 3a 0a 3b 3b 3b 20 20 20 2d 20 46 6f 72 63 65 f:.;;; - Force
32d0: 20 69 74 20 74 6f 20 62 65 20 69 6e 74 65 67 72 it to be integr
32e0: 61 74 65 64 2e 0a 3b 3b 3b 20 20 20 2d 20 4c 65 ated..;;; - Le
32f0: 74 20 69 74 20 75 73 65 20 75 6e 73 61 66 65 20 t it use unsafe
3300: 76 65 63 74 6f 72 20 65 6c 65 6d 65 6e 74 20 64 vector element d
3310: 65 72 65 66 65 72 65 6e 63 69 6e 67 20 72 6f 75 ereferencing rou
3320: 74 69 6e 65 73 3a 20 62 6f 75 6e 64 73 0a 3b 3b tines: bounds.;;
3330: 3b 20 20 20 20 20 63 68 65 63 6b 69 6e 67 20 61 ; checking a
3340: 6c 72 65 61 64 79 20 68 61 70 70 65 6e 73 20 6f lready happens o
3350: 75 74 73 69 64 65 20 6f 66 20 69 74 2e 20 20 28 utside of it. (
3360: 4f 72 20 75 73 65 20 61 20 63 6f 6d 70 69 6c 65 Or use a compile
3370: 72 0a 3b 3b 3b 20 20 20 20 20 74 68 61 74 20 66 r.;;; that f
3380: 69 67 75 72 65 73 20 74 68 69 73 20 6f 75 74 2c igures this out,
3390: 20 62 75 74 20 4f 6c 69 6e 20 53 68 69 76 65 72 but Olin Shiver
33a0: 73 27 20 50 68 44 20 74 68 65 73 69 73 20 73 65 s' PhD thesis se
33b0: 65 6d 73 20 74 6f 0a 3b 3b 3b 20 20 20 20 20 68 ems to.;;; h
33c0: 61 76 65 20 62 65 65 6e 20 6c 61 72 67 65 6c 79 ave been largely
33d0: 20 69 67 6e 6f 72 65 64 20 69 6e 20 61 63 74 75 ignored in actu
33e0: 61 6c 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f al implementatio
33f0: 6e 73 2e 2e 2e 29 0a 3b 3b 3b 20 20 20 2d 20 49 ns...).;;; - I
3400: 6d 70 6c 65 6d 65 6e 74 20 69 74 20 6e 61 74 69 mplement it nati
3410: 76 65 6c 79 20 61 73 20 61 20 56 4d 20 70 72 69 vely as a VM pri
3420: 6d 69 74 69 76 65 3a 20 74 68 65 20 56 4d 20 63 mitive: the VM c
3430: 61 6e 20 75 6e 64 6f 75 62 74 65 64 6c 79 0a 3b an undoubtedly.;
3440: 3b 3b 20 20 20 20 20 70 65 72 66 6f 72 6d 20 6d ;; perform m
3450: 75 63 68 20 66 61 73 74 65 72 20 74 68 61 6e 20 uch faster than
3460: 69 74 20 63 61 6e 20 6d 61 6b 65 20 53 63 68 65 it can make Sche
3470: 6d 65 20 70 65 72 66 6f 72 6d 2c 20 65 76 65 6e me perform, even
3480: 20 77 69 74 68 0a 3b 3b 3b 20 20 20 20 20 62 6f with.;;; bo
3490: 75 6e 64 73 20 63 68 65 63 6b 69 6e 67 2e 0a 3b unds checking..;
34a0: 3b 3b 20 20 20 2d 20 49 6d 70 6c 65 6d 65 6e 74 ;; - Implement
34b0: 20 69 74 20 69 6e 20 61 73 73 65 6d 62 6c 79 3a it in assembly:
34c0: 20 79 6f 75 20 5f 77 61 6e 74 5f 20 74 68 65 20 you _want_ the
34d0: 66 69 6e 65 20 63 6f 6e 74 72 6f 6c 20 74 68 61 fine control tha
34e0: 74 0a 3b 3b 3b 20 20 20 20 20 61 73 73 65 6d 62 t.;;; assemb
34f0: 6c 79 20 63 61 6e 20 67 69 76 65 20 79 6f 75 20 ly can give you
3500: 66 6f 72 20 74 68 69 73 2e 0a 3b 3b 3b 20 49 20 for this..;;; I
3510: 61 6c 72 65 61 64 79 20 6c 61 6d 62 64 61 2d 6c already lambda-l
3520: 69 66 74 20 69 74 20 62 79 20 68 61 6e 64 2c 20 ift it by hand,
3530: 62 75 74 20 79 6f 75 20 73 68 6f 75 6c 64 20 62 but you should b
3540: 65 20 61 62 6c 65 20 74 6f 20 6d 61 6b 65 20 69 e able to make i
3550: 74 0a 3b 3b 3b 20 65 76 65 6e 20 62 65 74 74 65 t.;;; even bette
3560: 72 20 74 68 61 6e 20 74 68 61 74 2e 0a 28 64 65 r than that..(de
3570: 66 69 6e 65 20 25 76 65 63 74 6f 72 2d 63 6f 70 fine %vector-cop
3580: 79 21 0a 20 20 28 6c 65 74 72 65 63 20 28 28 6c y!. (letrec ((l
3590: 6f 6f 70 2f 6c 2d 3e 72 20 28 6c 61 6d 62 64 61 oop/l->r (lambda
35a0: 20 28 74 61 72 67 65 74 20 73 6f 75 72 63 65 20 (target source
35b0: 73 65 6e 64 20 69 20 6a 29 0a 20 20 20 20 20 20 send i j).
35c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35d0: 20 20 28 63 6f 6e 64 20 28 28 3c 20 69 20 73 65 (cond ((< i se
35e0: 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
35f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3600: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
3610: 74 61 72 67 65 74 20 6a 0a 20 20 20 20 20 20 20 target j.
3620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3640: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
3650: 20 73 6f 75 72 63 65 20 69 29 29 0a 20 20 20 20 source i)).
3660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3670: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
3680: 2f 6c 2d 3e 72 20 74 61 72 67 65 74 20 73 6f 75 /l->r target sou
3690: 72 63 65 20 73 65 6e 64 0a 20 20 20 20 20 20 20 rce send.
36a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
36b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
36c0: 20 20 20 28 2b 20 69 20 31 29 20 28 2b 20 6a 20 (+ i 1) (+ j
36d0: 31 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 1)))))).
36e0: 20 20 20 28 6c 6f 6f 70 2f 72 2d 3e 6c 20 28 6c (loop/r->l (l
36f0: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 73 6f ambda (target so
3700: 75 72 63 65 20 73 73 74 61 72 74 20 69 20 6a 29 urce sstart i j)
3710: 0a 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 28 63 6f 6e 64 20 28 (cond (
3730: 28 3e 3d 20 69 20 73 73 74 61 72 74 29 0a 20 20 (>= i sstart).
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 28 76 65 (ve
3760: 63 74 6f 72 2d 73 65 74 21 20 74 61 72 67 65 74 ctor-set! target
3770: 20 6a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j.
3780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
37a0: 76 65 63 74 6f 72 2d 72 65 66 20 73 6f 75 72 63 vector-ref sourc
37b0: 65 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 e i)).
37c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
37d0: 20 20 20 20 20 28 6c 6f 6f 70 2f 72 2d 3e 6c 20 (loop/r->l
37e0: 74 61 72 67 65 74 20 73 6f 75 72 63 65 20 73 73 target source ss
37f0: 74 61 72 74 0a 20 20 20 20 20 20 20 20 20 20 20 tart.
3800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3820: 2d 20 69 20 31 29 20 28 2d 20 6a 20 31 29 29 29 - i 1) (- j 1)))
3830: 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 )))). (lambda
3840: 20 28 74 61 72 67 65 74 20 74 73 74 61 72 74 20 (target tstart
3850: 73 6f 75 72 63 65 20 73 73 74 61 72 74 20 73 65 source sstart se
3860: 6e 64 29 0a 20 20 20 20 20 20 28 69 66 20 28 3e nd). (if (>
3870: 20 73 73 74 61 72 74 20 74 73 74 61 72 74 29 20 sstart tstart)
3880: 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 4d 61 ; Ma
3890: 6b 65 20 73 75 72 65 20 77 65 20 64 6f 6e 27 74 ke sure we don't
38a0: 20 63 6f 70 79 20 6f 76 65 72 0a 20 20 20 20 20 copy over.
38b0: 20 20 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 3b 20 20 20 6f 75 72 73 65 6c 76 65 73 ; ourselves
38e0: 2e 0a 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f .. (loo
38f0: 70 2f 6c 2d 3e 72 20 74 61 72 67 65 74 20 73 6f p/l->r target so
3900: 75 72 63 65 20 73 65 6e 64 20 73 73 74 61 72 74 urce send sstart
3910: 20 74 73 74 61 72 74 29 0a 20 20 20 20 20 20 20 tstart).
3920: 20 20 20 28 6c 6f 6f 70 2f 72 2d 3e 6c 20 74 61 (loop/r->l ta
3930: 72 67 65 74 20 73 6f 75 72 63 65 20 73 73 74 61 rget source ssta
3940: 72 74 20 28 2d 20 73 65 6e 64 20 31 29 0a 20 20 rt (- send 1).
3950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3960: 20 20 20 28 2b 20 2d 31 20 74 73 74 61 72 74 20 (+ -1 tstart
3970: 73 65 6e 64 20 28 2d 20 73 73 74 61 72 74 29 29 send (- sstart))
3980: 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 25 56 45 43 )))))..;;; (%VEC
3990: 54 4f 52 2d 52 45 56 45 52 53 45 2d 43 4f 50 59 TOR-REVERSE-COPY
39a0: 21 20 3c 74 61 72 67 65 74 3e 20 3c 74 73 74 61 ! <target> <tsta
39b0: 72 74 3e 20 3c 73 6f 75 72 63 65 3e 20 3c 73 73 rt> <source> <ss
39c0: 74 61 72 74 3e 20 3c 73 65 6e 64 3e 29 0a 3b 3b tart> <send>).;;
39d0: 3b 20 20 20 43 6f 70 79 20 65 6c 65 6d 65 6e 74 ; Copy element
39e0: 73 20 66 72 6f 6d 20 53 53 54 41 52 54 20 74 6f s from SSTART to
39f0: 20 53 45 4e 44 20 66 72 6f 6d 20 53 4f 55 52 43 SEND from SOURC
3a00: 45 20 74 6f 20 54 41 52 47 45 54 2c 20 69 6e 20 E to TARGET, in
3a10: 74 68 65 0a 3b 3b 3b 20 20 20 72 65 76 65 72 73 the.;;; revers
3a20: 65 20 6f 72 64 65 72 2e 0a 28 64 65 66 69 6e 65 e order..(define
3a30: 20 25 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 %vector-reverse
3a40: 2d 63 6f 70 79 21 0a 20 20 28 6c 65 74 72 65 63 -copy!. (letrec
3a50: 20 28 28 6c 6f 6f 70 20 28 6c 61 6d 62 64 61 20 ((loop (lambda
3a60: 28 74 61 72 67 65 74 20 73 6f 75 72 63 65 20 73 (target source s
3a70: 73 74 61 72 74 20 69 20 6a 29 0a 20 20 20 20 20 start i j).
3a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
3a90: 6f 6e 64 20 28 28 3e 3d 20 69 20 73 73 74 61 72 ond ((>= i sstar
3aa0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
3ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
3ac0: 63 74 6f 72 2d 73 65 74 21 20 74 61 72 67 65 74 ctor-set! target
3ad0: 20 6a 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 j (vector-ref s
3ae0: 6f 75 72 63 65 20 69 29 29 0a 20 20 20 20 20 20 ource i)).
3af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b00: 20 20 20 20 28 6c 6f 6f 70 20 74 61 72 67 65 74 (loop target
3b10: 20 73 6f 75 72 63 65 20 73 73 74 61 72 74 0a 20 source sstart.
3b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3b40: 2d 20 69 20 31 29 0a 20 20 20 20 20 20 20 20 20 - i 1).
3b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b60: 20 20 20 20 20 20 20 28 2b 20 6a 20 31 29 29 29 (+ j 1)))
3b70: 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 )))). (lambda
3b80: 20 28 74 61 72 67 65 74 20 74 73 74 61 72 74 20 (target tstart
3b90: 73 6f 75 72 63 65 20 73 73 74 61 72 74 20 73 65 source sstart se
3ba0: 6e 64 29 0a 20 20 20 20 20 20 28 6c 6f 6f 70 20 nd). (loop
3bb0: 74 61 72 67 65 74 20 73 6f 75 72 63 65 20 73 73 target source ss
3bc0: 74 61 72 74 0a 20 20 20 20 20 20 20 20 20 20 20 tart.
3bd0: 20 28 2d 20 73 65 6e 64 20 31 29 0a 20 20 20 20 (- send 1).
3be0: 20 20 20 20 20 20 20 20 74 73 74 61 72 74 29 29 tstart))
3bf0: 29 29 0a 0a 3b 3b 3b 20 28 25 56 45 43 54 4f 52 ))..;;; (%VECTOR
3c00: 2d 52 45 56 45 52 53 45 21 20 3c 76 65 63 74 6f -REVERSE! <vecto
3c10: 72 3e 29 0a 28 64 65 66 69 6e 65 20 25 76 65 63 r>).(define %vec
3c20: 74 6f 72 2d 72 65 76 65 72 73 65 21 0a 20 20 28 tor-reverse!. (
3c30: 6c 65 74 72 65 63 20 28 28 6c 6f 6f 70 20 28 6c letrec ((loop (l
3c40: 61 6d 62 64 61 20 28 76 65 63 20 69 20 6a 29 0a ambda (vec i j).
3c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c60: 20 20 20 28 63 6f 6e 64 20 28 28 3c 3d 20 69 20 (cond ((<= i
3c70: 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j).
3c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
3c90: 74 20 28 28 76 20 28 76 65 63 74 6f 72 2d 72 65 t ((v (vector-re
3ca0: 66 20 76 65 63 20 69 29 29 29 0a 20 20 20 20 20 f vec i))).
3cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3cc0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 (vector-s
3cd0: 65 74 21 20 76 65 63 20 69 20 28 76 65 63 74 6f et! vec i (vecto
3ce0: 72 2d 72 65 66 20 76 65 63 20 6a 29 29 0a 20 20 r-ref vec j)).
3cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d00: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
3d10: 72 2d 73 65 74 21 20 76 65 63 20 6a 20 76 29 0a r-set! vec j v).
3d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d30: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
3d40: 70 20 76 65 63 20 28 2b 20 69 20 31 29 20 28 2d p vec (+ i 1) (-
3d50: 20 6a 20 31 29 29 29 29 29 29 29 29 0a 20 20 20 j 1)))))))).
3d60: 20 28 6c 61 6d 62 64 61 20 28 76 65 63 20 73 74 (lambda (vec st
3d70: 61 72 74 20 65 6e 64 29 0a 20 20 20 20 20 20 28 art end). (
3d80: 6c 6f 6f 70 20 76 65 63 20 73 74 61 72 74 20 28 loop vec start (
3d90: 2d 20 65 6e 64 20 31 29 29 29 29 29 0a 0a 3b 3b - end 1)))))..;;
3da0: 3b 20 28 25 56 45 43 54 4f 52 2d 46 4f 4c 44 31 ; (%VECTOR-FOLD1
3db0: 20 3c 6b 6f 6e 73 3e 20 3c 6b 6e 69 6c 3e 20 3c <kons> <knil> <
3dc0: 76 65 63 74 6f 72 3e 29 20 2d 3e 20 6b 6e 69 6c vector>) -> knil
3dd0: 27 0a 3b 3b 3b 20 20 20 20 20 28 4b 4f 4e 53 20 '.;;; (KONS
3de0: 3c 69 6e 64 65 78 3e 20 3c 6b 6e 69 6c 3e 20 3c <index> <knil> <
3df0: 65 6c 74 3e 29 20 2d 3e 20 6b 6e 69 6c 27 0a 28 elt>) -> knil'.(
3e00: 64 65 66 69 6e 65 20 25 76 65 63 74 6f 72 2d 66 define %vector-f
3e10: 6f 6c 64 31 0a 20 20 28 6c 65 74 72 65 63 20 28 old1. (letrec (
3e20: 28 6c 6f 6f 70 20 28 6c 61 6d 62 64 61 20 28 6b (loop (lambda (k
3e30: 6f 6e 73 20 6b 6e 69 6c 20 6c 65 6e 20 76 65 63 ons knil len vec
3e40: 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i).
3e50: 20 20 20 20 20 20 20 28 69 66 20 28 3d 20 69 20 (if (= i
3e60: 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 len).
3e70: 20 20 20 20 20 20 20 20 20 20 20 20 6b 6e 69 6c knil
3e80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3e90: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 6b 6f (loop ko
3ea0: 6e 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ns.
3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ec0: 28 6b 6f 6e 73 20 69 20 6b 6e 69 6c 20 28 76 65 (kons i knil (ve
3ed0: 63 74 6f 72 2d 72 65 66 20 76 65 63 20 69 29 29 ctor-ref vec i))
3ee0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 65 le
3f00: 6e 20 76 65 63 20 28 2b 20 69 20 31 29 29 29 29 n vec (+ i 1))))
3f10: 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 )). (lambda (
3f20: 6b 6f 6e 73 20 6b 6e 69 6c 20 6c 65 6e 20 76 65 kons knil len ve
3f30: 63 29 0a 20 20 20 20 20 20 28 6c 6f 6f 70 20 6b c). (loop k
3f40: 6f 6e 73 20 6b 6e 69 6c 20 6c 65 6e 20 76 65 63 ons knil len vec
3f50: 20 30 29 29 29 29 0a 0a 3b 3b 3b 20 28 25 56 45 0))))..;;; (%VE
3f60: 43 54 4f 52 2d 46 4f 4c 44 32 2b 20 3c 6b 6f 6e CTOR-FOLD2+ <kon
3f70: 73 3e 20 3c 6b 6e 69 6c 3e 20 3c 76 65 63 74 6f s> <knil> <vecto
3f80: 72 3e 20 2e 2e 2e 29 20 2d 3e 20 6b 6e 69 6c 27 r> ...) -> knil'
3f90: 0a 3b 3b 3b 20 20 20 20 20 28 4b 4f 4e 53 20 3c .;;; (KONS <
3fa0: 69 6e 64 65 78 3e 20 3c 6b 6e 69 6c 3e 20 3c 65 index> <knil> <e
3fb0: 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 6b 6e 69 6c lt> ...) -> knil
3fc0: 27 0a 28 64 65 66 69 6e 65 20 25 76 65 63 74 6f '.(define %vecto
3fd0: 72 2d 66 6f 6c 64 32 2b 0a 20 20 28 6c 65 74 72 r-fold2+. (letr
3fe0: 65 63 20 28 28 6c 6f 6f 70 20 28 6c 61 6d 62 64 ec ((loop (lambd
3ff0: 61 20 28 6b 6f 6e 73 20 6b 6e 69 6c 20 6c 65 6e a (kons knil len
4000: 20 76 65 63 74 6f 72 73 20 69 29 0a 20 20 20 20 vectors i).
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4020: 69 66 20 28 3d 20 69 20 6c 65 6e 29 0a 20 20 20 if (= i len).
4030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4040: 20 20 20 20 6b 6e 69 6c 0a 20 20 20 20 20 20 20 knil.
4050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4060: 28 6c 6f 6f 70 20 6b 6f 6e 73 0a 20 20 20 20 20 (loop kons.
4070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4080: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 6b (apply k
4090: 6f 6e 73 20 69 20 6b 6e 69 6c 0a 20 20 20 20 20 ons i knil.
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 20 20 20 20 28 (
40c0: 76 65 63 74 6f 72 73 2d 72 65 66 20 76 65 63 74 vectors-ref vect
40d0: 6f 72 73 20 69 29 29 0a 20 20 20 20 20 20 20 20 ors i)).
40e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40f0: 20 20 20 20 20 6c 65 6e 20 76 65 63 74 6f 72 73 len vectors
4100: 20 28 2b 20 69 20 31 29 29 29 29 29 29 0a 20 20 (+ i 1)))))).
4110: 20 20 28 6c 61 6d 62 64 61 20 28 6b 6f 6e 73 20 (lambda (kons
4120: 6b 6e 69 6c 20 6c 65 6e 20 76 65 63 74 6f 72 73 knil len vectors
4130: 29 0a 20 20 20 20 20 20 28 6c 6f 6f 70 20 6b 6f ). (loop ko
4140: 6e 73 20 6b 6e 69 6c 20 6c 65 6e 20 76 65 63 74 ns knil len vect
4150: 6f 72 73 20 30 29 29 29 29 0a 0a 3b 3b 3b 20 28 ors 0))))..;;; (
4160: 25 56 45 43 54 4f 52 2d 4d 41 50 21 20 3c 66 3e %VECTOR-MAP! <f>
4170: 20 3c 74 61 72 67 65 74 3e 20 3c 6c 65 6e 67 74 <target> <lengt
4180: 68 3e 20 3c 76 65 63 74 6f 72 3e 29 20 2d 3e 20 h> <vector>) ->
4190: 74 61 72 67 65 74 0a 3b 3b 3b 20 20 20 20 20 28 target.;;; (
41a0: 46 20 3c 69 6e 64 65 78 3e 20 3c 65 6c 74 3e 29 F <index> <elt>)
41b0: 20 2d 3e 20 65 6c 74 27 0a 28 64 65 66 69 6e 65 -> elt'.(define
41c0: 20 25 76 65 63 74 6f 72 2d 6d 61 70 31 21 0a 20 %vector-map1!.
41d0: 20 28 6c 65 74 72 65 63 20 28 28 6c 6f 6f 70 20 (letrec ((loop
41e0: 28 6c 61 6d 62 64 61 20 28 66 20 74 61 72 67 65 (lambda (f targe
41f0: 74 20 76 65 63 20 69 29 0a 20 20 20 20 20 20 20 t vec i).
4200: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
4210: 28 7a 65 72 6f 3f 20 69 29 0a 20 20 20 20 20 20 (zero? i).
4220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4230: 20 74 61 72 67 65 74 0a 20 20 20 20 20 20 20 20 target.
4240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4250: 6c 65 74 20 28 28 6a 20 28 2d 20 69 20 31 29 29 let ((j (- i 1))
4260: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4270: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
4280: 6f 72 2d 73 65 74 21 20 74 61 72 67 65 74 20 6a or-set! target j
4290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
42a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42b0: 20 20 20 20 20 20 20 28 66 20 6a 20 28 76 65 63 (f j (vec
42c0: 74 6f 72 2d 72 65 66 20 76 65 63 20 6a 29 29 29 tor-ref vec j)))
42d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
42e0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
42f0: 66 20 74 61 72 67 65 74 20 76 65 63 20 6a 29 29 f target vec j))
4300: 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 )))). (lambda
4310: 20 28 66 20 74 61 72 67 65 74 20 76 65 63 20 6c (f target vec l
4320: 65 6e 29 0a 20 20 20 20 20 20 28 6c 6f 6f 70 20 en). (loop
4330: 66 20 74 61 72 67 65 74 20 76 65 63 20 6c 65 6e f target vec len
4340: 29 29 29 29 0a 0a 3b 3b 3b 20 28 25 56 45 43 54 ))))..;;; (%VECT
4350: 4f 52 2d 4d 41 50 32 2b 21 20 3c 66 3e 20 3c 74 OR-MAP2+! <f> <t
4360: 61 72 67 65 74 3e 20 3c 76 65 63 74 6f 72 73 3e arget> <vectors>
4370: 20 3c 6c 65 6e 3e 29 20 2d 3e 20 74 61 72 67 65 <len>) -> targe
4380: 74 0a 3b 3b 3b 20 20 20 20 20 28 46 20 3c 69 6e t.;;; (F <in
4390: 64 65 78 3e 20 3c 65 6c 74 3e 20 2e 2e 2e 29 20 dex> <elt> ...)
43a0: 2d 3e 20 65 6c 74 27 0a 28 64 65 66 69 6e 65 20 -> elt'.(define
43b0: 25 76 65 63 74 6f 72 2d 6d 61 70 32 2b 21 0a 20 %vector-map2+!.
43c0: 20 28 6c 65 74 72 65 63 20 28 28 6c 6f 6f 70 20 (letrec ((loop
43d0: 28 6c 61 6d 62 64 61 20 28 66 20 74 61 72 67 65 (lambda (f targe
43e0: 74 20 76 65 63 74 6f 72 73 20 69 29 0a 20 20 20 t vectors i).
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4400: 28 69 66 20 28 7a 65 72 6f 3f 20 69 29 0a 20 20 (if (zero? i).
4410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4420: 20 20 20 20 20 74 61 72 67 65 74 0a 20 20 20 20 target.
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 20 20 20 28 6c 65 74 20 28 28 6a 20 28 2d 20 69 (let ((j (- i
4450: 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 1))).
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4470: 76 65 63 74 6f 72 2d 73 65 74 21 20 74 61 72 67 vector-set! targ
4480: 65 74 20 6a 0a 20 20 20 20 20 20 20 20 20 20 20 et j.
4490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44a0: 28 61 70 70 6c 79 20 66 20 6a 20 28 76 65 63 74 (apply f j (vect
44b0: 6f 72 73 2d 72 65 66 20 76 65 63 74 6f 72 73 20 ors-ref vectors
44c0: 6a 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 j))).
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
44e0: 6f 6f 70 20 66 20 74 61 72 67 65 74 20 76 65 63 oop f target vec
44f0: 74 6f 72 73 20 6a 29 29 29 29 29 29 0a 20 20 20 tors j)))))).
4500: 20 28 6c 61 6d 62 64 61 20 28 66 20 74 61 72 67 (lambda (f targ
4510: 65 74 20 76 65 63 74 6f 72 73 20 6c 65 6e 29 0a et vectors len).
4520: 20 20 20 20 20 20 28 6c 6f 6f 70 20 66 20 74 61 (loop f ta
4530: 72 67 65 74 20 76 65 63 74 6f 72 73 20 6c 65 6e rget vectors len
4540: 29 29 29 29 0a 0a 0c 0a 0a 3b 3b 3b 3b 3b 3b 3b )))).....;;;;;;;
4550: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4560: 3b 20 2a 2a 2a 2a 2a 20 76 65 63 74 6f 72 2d 6c ; ***** vector-l
4570: 69 62 20 2a 2a 2a 2a 2a 20 3b 3b 3b 3b 3b 3b 3b ib ***** ;;;;;;;
4580: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4590: 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ..;;; ----------
45a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 43 ----------.;;; C
45b0: 6f 6e 73 74 72 75 63 74 6f 72 73 0a 0a 3b 3b 3b onstructors..;;;
45c0: 20 28 4d 41 4b 45 2d 56 45 43 54 4f 52 20 3c 73 (MAKE-VECTOR <s
45d0: 69 7a 65 3e 20 5b 3c 66 69 6c 6c 3e 5d 29 20 2d ize> [<fill>]) -
45e0: 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 20 5b > vector.;;; [
45f0: 52 35 52 53 5d 20 43 72 65 61 74 65 20 61 20 76 R5RS] Create a v
4600: 65 63 74 6f 72 20 6f 66 20 6c 65 6e 67 74 68 20 ector of length
4610: 4c 45 4e 47 54 48 2e 20 20 49 66 20 46 49 4c 4c LENGTH. If FILL
4620: 20 69 73 20 70 72 65 73 65 6e 74 2c 0a 3b 3b 3b is present,.;;;
4630: 20 20 20 69 6e 69 74 69 61 6c 69 7a 65 20 65 61 initialize ea
4640: 63 68 20 73 6c 6f 74 20 69 6e 20 74 68 65 20 76 ch slot in the v
4650: 65 63 74 6f 72 20 77 69 74 68 20 69 74 3b 20 69 ector with it; i
4660: 66 20 6e 6f 74 2c 20 74 68 65 20 76 65 63 74 6f f not, the vecto
4670: 72 27 73 0a 3b 3b 3b 20 20 20 69 6e 69 74 69 61 r's.;;; initia
4680: 6c 20 63 6f 6e 74 65 6e 74 73 20 61 72 65 20 75 l contents are u
4690: 6e 73 70 65 63 69 66 69 65 64 2e 0a 28 64 65 66 nspecified..(def
46a0: 69 6e 65 20 6d 61 6b 65 2d 76 65 63 74 6f 72 20 ine make-vector
46b0: 6d 61 6b 65 2d 76 65 63 74 6f 72 29 0a 0a 3b 3b make-vector)..;;
46c0: 3b 20 28 56 45 43 54 4f 52 20 3c 65 6c 74 3e 20 ; (VECTOR <elt>
46d0: 2e 2e 2e 29 20 2d 3e 20 76 65 63 74 6f 72 0a 3b ...) -> vector.;
46e0: 3b 3b 20 20 20 5b 52 35 52 53 5d 20 43 72 65 61 ;; [R5RS] Crea
46f0: 74 65 20 61 20 76 65 63 74 6f 72 20 63 6f 6e 74 te a vector cont
4700: 61 69 6e 69 6e 67 20 45 4c 45 4d 45 4e 54 20 2e aining ELEMENT .
4710: 2e 2e 2c 20 69 6e 20 6f 72 64 65 72 2e 0a 28 64 .., in order..(d
4720: 65 66 69 6e 65 20 76 65 63 74 6f 72 20 76 65 63 efine vector vec
4730: 74 6f 72 29 0a 0a 3b 3b 3b 20 54 68 69 73 20 6f tor)..;;; This o
4740: 75 67 68 74 20 74 6f 20 62 65 20 61 62 6c 65 20 ught to be able
4750: 74 6f 20 62 65 20 69 6d 70 6c 65 6d 65 6e 74 65 to be implemente
4760: 64 20 6d 75 63 68 20 6d 6f 72 65 20 65 66 66 69 d much more effi
4770: 63 69 65 6e 74 6c 79 20 2d 2d 20 69 66 0a 3b 3b ciently -- if.;;
4780: 3b 20 77 65 20 68 61 76 65 20 74 68 65 20 6e 75 ; we have the nu
4790: 6d 62 65 72 20 6f 66 20 61 72 67 75 6d 65 6e 74 mber of argument
47a0: 73 20 61 76 61 69 6c 61 62 6c 65 20 74 6f 20 75 s available to u
47b0: 73 2c 20 77 65 20 63 61 6e 20 63 72 65 61 74 65 s, we can create
47c0: 20 74 68 65 0a 3b 3b 3b 20 76 65 63 74 6f 72 20 the.;;; vector
47d0: 77 69 74 68 6f 75 74 20 75 73 69 6e 67 20 4c 45 without using LE
47e0: 4e 47 54 48 20 74 6f 20 64 65 74 65 72 6d 69 6e NGTH to determin
47f0: 65 20 74 68 65 20 6e 75 6d 62 65 72 20 6f 66 20 e the number of
4800: 65 6c 65 6d 65 6e 74 73 20 69 74 0a 3b 3b 3b 20 elements it.;;;
4810: 73 68 6f 75 6c 64 20 68 61 76 65 2e 0a 3b 28 64 should have..;(d
4820: 65 66 69 6e 65 20 28 76 65 63 74 6f 72 20 2e 20 efine (vector .
4830: 65 6c 65 6d 65 6e 74 73 29 20 28 6c 69 73 74 2d elements) (list-
4840: 3e 76 65 63 74 6f 72 20 65 6c 65 6d 65 6e 74 73 >vector elements
4850: 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d ))..;;; (VECTOR-
4860: 55 4e 46 4f 4c 44 20 3c 66 3e 20 3c 6c 65 6e 67 UNFOLD <f> <leng
4870: 74 68 3e 20 3c 69 6e 69 74 69 61 6c 2d 73 65 65 th> <initial-see
4880: 64 3e 20 2e 2e 2e 29 20 2d 3e 20 76 65 63 74 6f d> ...) -> vecto
4890: 72 0a 3b 3b 3b 20 20 20 20 20 28 46 20 3c 69 6e r.;;; (F <in
48a0: 64 65 78 3e 20 3c 73 65 65 64 3e 20 2e 2e 2e 29 dex> <seed> ...)
48b0: 20 2d 3e 20 5b 65 6c 74 20 73 65 65 64 27 20 2e -> [elt seed' .
48c0: 2e 2e 5d 0a 3b 3b 3b 20 20 20 54 68 65 20 66 75 ..].;;; The fu
48d0: 6e 64 61 6d 65 6e 74 61 6c 20 76 65 63 74 6f 72 ndamental vector
48e0: 20 63 6f 6e 73 74 72 75 63 74 6f 72 2e 20 20 43 constructor. C
48f0: 72 65 61 74 65 73 20 61 20 76 65 63 74 6f 72 20 reates a vector
4900: 77 68 6f 73 65 0a 3b 3b 3b 20 20 20 6c 65 6e 67 whose.;;; leng
4910: 74 68 20 69 73 20 4c 45 4e 47 54 48 20 61 6e 64 th is LENGTH and
4920: 20 69 74 65 72 61 74 65 73 20 61 63 72 6f 73 73 iterates across
4930: 20 65 61 63 68 20 69 6e 64 65 78 20 4b 20 62 65 each index K be
4940: 74 77 65 65 6e 20 30 20 61 6e 64 0a 3b 3b 3b 20 tween 0 and.;;;
4950: 20 20 4c 45 4e 47 54 48 2c 20 61 70 70 6c 79 69 LENGTH, applyi
4960: 6e 67 20 46 20 61 74 20 65 61 63 68 20 69 74 65 ng F at each ite
4970: 72 61 74 69 6f 6e 20 74 6f 20 74 68 65 20 63 75 ration to the cu
4980: 72 72 65 6e 74 20 69 6e 64 65 78 20 61 6e 64 20 rrent index and
4990: 74 68 65 0a 3b 3b 3b 20 20 20 63 75 72 72 65 6e the.;;; curren
49a0: 74 20 73 65 65 64 73 20 74 6f 20 72 65 63 65 69 t seeds to recei
49b0: 76 65 20 4e 2b 31 20 76 61 6c 75 65 73 3a 20 66 ve N+1 values: f
49c0: 69 72 73 74 2c 20 74 68 65 20 65 6c 65 6d 65 6e irst, the elemen
49d0: 74 20 74 6f 20 70 75 74 20 69 6e 0a 3b 3b 3b 20 t to put in.;;;
49e0: 20 20 74 68 65 20 4b 74 68 20 73 6c 6f 74 20 61 the Kth slot a
49f0: 6e 64 20 74 68 65 6e 20 4e 20 6e 65 77 20 73 65 nd then N new se
4a00: 65 64 73 20 66 6f 72 20 74 68 65 20 6e 65 78 74 eds for the next
4a10: 20 69 74 65 72 61 74 69 6f 6e 2e 0a 28 64 65 66 iteration..(def
4a20: 69 6e 65 20 76 65 63 74 6f 72 2d 75 6e 66 6f 6c ine vector-unfol
4a30: 64 0a 20 20 28 6c 65 74 72 65 63 20 28 28 74 61 d. (letrec ((ta
4a40: 62 75 6c 61 74 65 21 20 20 20 20 20 20 20 20 20 bulate!
4a50: 20 20 20 20 20 20 20 20 20 20 3b 20 53 70 65 63 ; Spec
4a60: 69 61 6c 20 7a 65 72 6f 2d 73 65 65 64 20 63 61 ial zero-seed ca
4a70: 73 65 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 se..
4a80: 28 6c 61 6d 62 64 61 20 28 66 20 76 65 63 20 69 (lambda (f vec i
4a90: 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 len).
4aa0: 20 20 20 20 28 63 6f 6e 64 20 28 28 3c 20 69 20 (cond ((< i
4ab0: 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 len).
4ac0: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
4ad0: 72 2d 73 65 74 21 20 76 65 63 20 69 20 28 66 20 r-set! vec i (f
4ae0: 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i)).
4af0: 20 20 20 20 20 20 20 20 20 28 74 61 62 75 6c 61 (tabula
4b00: 74 65 21 20 66 20 76 65 63 20 28 2b 20 69 20 31 te! f vec (+ i 1
4b10: 29 20 6c 65 6e 29 29 29 29 29 0a 20 20 20 20 20 ) len))))).
4b20: 20 20 20 20 20 20 28 75 6e 66 6f 6c 64 31 21 20 (unfold1!
4b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b40: 20 20 20 3b 20 46 61 73 74 20 70 61 74 68 20 66 ; Fast path f
4b50: 6f 72 20 6f 6e 65 20 73 65 65 64 2e 0a 20 20 20 or one seed..
4b60: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
4b70: 20 28 66 20 76 65 63 20 69 20 6c 65 6e 20 73 65 (f vec i len se
4b80: 65 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ed).
4b90: 20 20 28 69 66 20 28 3c 20 69 20 6c 65 6e 29 0a (if (< i len).
4ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bb0: 20 20 28 72 65 63 65 69 76 65 20 28 65 6c 74 20 (receive (elt
4bc0: 6e 65 77 2d 73 65 65 64 29 0a 20 20 20 20 20 20 new-seed).
4bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4be0: 20 20 20 20 20 28 66 20 69 20 73 65 65 64 29 0a (f i seed).
4bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c00: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
4c10: 20 76 65 63 20 69 20 65 6c 74 29 0a 20 20 20 20 vec i elt).
4c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c30: 28 75 6e 66 6f 6c 64 31 21 20 66 20 76 65 63 20 (unfold1! f vec
4c40: 28 2b 20 69 20 31 29 20 6c 65 6e 20 6e 65 77 2d (+ i 1) len new-
4c50: 73 65 65 64 29 29 29 29 29 0a 20 20 20 20 20 20 seed))))).
4c60: 20 20 20 20 20 28 75 6e 66 6f 6c 64 32 2b 21 20 (unfold2+!
4c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c80: 20 20 3b 20 53 6c 6f 77 65 72 20 76 61 72 69 61 ; Slower varia
4c90: 6e 74 20 66 6f 72 20 4e 20 73 65 65 64 73 2e 0a nt for N seeds..
4ca0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
4cb0: 62 64 61 20 28 66 20 76 65 63 20 69 20 6c 65 6e bda (f vec i len
4cc0: 20 73 65 65 64 73 29 0a 20 20 20 20 20 20 20 20 seeds).
4cd0: 20 20 20 20 20 20 28 69 66 20 28 3c 20 69 20 6c (if (< i l
4ce0: 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 en).
4cf0: 20 20 20 20 20 20 28 72 65 63 65 69 76 65 20 28 (receive (
4d00: 65 6c 74 20 2e 20 6e 65 77 2d 73 65 65 64 73 29 elt . new-seeds)
4d10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4d20: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
4d30: 6c 79 20 66 20 69 20 73 65 65 64 73 29 0a 20 20 ly f i seeds).
4d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d50: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 (vector-set! v
4d60: 65 63 20 69 20 65 6c 74 29 0a 20 20 20 20 20 20 ec i elt).
4d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 75 (u
4d80: 6e 66 6f 6c 64 32 2b 21 20 66 20 76 65 63 20 28 nfold2+! f vec (
4d90: 2b 20 69 20 31 29 20 6c 65 6e 20 6e 65 77 2d 73 + i 1) len new-s
4da0: 65 65 64 73 29 29 29 29 29 29 0a 20 20 20 20 28 eeds)))))). (
4db0: 6c 61 6d 62 64 61 20 28 66 20 6c 65 6e 20 2e 20 lambda (f len .
4dc0: 69 6e 69 74 69 61 6c 2d 73 65 65 64 73 29 0a 20 initial-seeds).
4dd0: 20 20 20 20 20 28 6c 65 74 20 28 28 66 20 20 20 (let ((f
4de0: 28 63 68 65 63 6b 2d 74 79 70 65 20 70 72 6f 63 (check-type proc
4df0: 65 64 75 72 65 3f 20 20 66 20 20 20 76 65 63 74 edure? f vect
4e00: 6f 72 2d 75 6e 66 6f 6c 64 29 29 0a 20 20 20 20 or-unfold)).
4e10: 20 20 20 20 20 20 20 20 28 6c 65 6e 20 28 63 68 (len (ch
4e20: 65 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 67 2d eck-type nonneg-
4e30: 69 6e 74 3f 20 6c 65 6e 20 76 65 63 74 6f 72 2d int? len vector-
4e40: 75 6e 66 6f 6c 64 29 29 29 0a 20 20 20 20 20 20 unfold))).
4e50: 20 20 28 6c 65 74 20 28 28 76 65 63 20 28 6d 61 (let ((vec (ma
4e60: 6b 65 2d 76 65 63 74 6f 72 20 6c 65 6e 29 29 29 ke-vector len)))
4e70: 0a 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 . (cond
4e80: 20 28 28 6e 75 6c 6c 3f 20 69 6e 69 74 69 61 6c ((null? initial
4e90: 2d 73 65 65 64 73 29 0a 20 20 20 20 20 20 20 20 -seeds).
4ea0: 20 20 20 20 20 20 20 20 20 28 74 61 62 75 6c 61 (tabula
4eb0: 74 65 21 20 66 20 76 65 63 20 30 20 6c 65 6e 29 te! f vec 0 len)
4ec0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4ed0: 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 72 20 69 ((null? (cdr i
4ee0: 6e 69 74 69 61 6c 2d 73 65 65 64 73 29 29 0a 20 nitial-seeds)).
4ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f00: 28 75 6e 66 6f 6c 64 31 21 20 66 20 76 65 63 20 (unfold1! f vec
4f10: 30 20 6c 65 6e 20 28 63 61 72 20 69 6e 69 74 69 0 len (car initi
4f20: 61 6c 2d 73 65 65 64 73 29 29 29 0a 20 20 20 20 al-seeds))).
4f30: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
4f40: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
4f50: 20 20 20 28 75 6e 66 6f 6c 64 32 2b 21 20 66 20 (unfold2+! f
4f60: 76 65 63 20 30 20 6c 65 6e 20 69 6e 69 74 69 61 vec 0 len initia
4f70: 6c 2d 73 65 65 64 73 29 29 29 0a 20 20 20 20 20 l-seeds))).
4f80: 20 20 20 20 20 76 65 63 29 29 29 29 29 0a 0a 3b vec)))))..;
4f90: 3b 3b 20 28 56 45 43 54 4f 52 2d 55 4e 46 4f 4c ;; (VECTOR-UNFOL
4fa0: 44 2d 52 49 47 48 54 20 3c 66 3e 20 3c 6c 65 6e D-RIGHT <f> <len
4fb0: 67 74 68 3e 20 3c 69 6e 69 74 69 61 6c 2d 73 65 gth> <initial-se
4fc0: 65 64 3e 20 2e 2e 2e 29 20 2d 3e 20 76 65 63 74 ed> ...) -> vect
4fd0: 6f 72 0a 3b 3b 3b 20 20 20 20 20 28 46 20 3c 73 or.;;; (F <s
4fe0: 65 65 64 3e 20 2e 2e 2e 29 20 2d 3e 20 5b 73 65 eed> ...) -> [se
4ff0: 65 64 27 20 2e 2e 2e 5d 0a 3b 3b 3b 20 20 20 4c ed' ...].;;; L
5000: 69 6b 65 20 56 45 43 54 4f 52 2d 55 4e 46 4f 4c ike VECTOR-UNFOL
5010: 44 2c 20 62 75 74 20 69 74 20 67 65 6e 65 72 61 D, but it genera
5020: 74 65 73 20 65 6c 65 6d 65 6e 74 73 20 66 72 6f tes elements fro
5030: 6d 20 4c 45 4e 47 54 48 20 74 6f 20 30 0a 3b 3b m LENGTH to 0.;;
5040: 3b 20 20 20 28 73 74 69 6c 6c 20 65 78 63 6c 75 ; (still exclu
5050: 73 69 76 65 20 77 69 74 68 20 20 4c 45 4e 47 54 sive with LENGT
5060: 48 20 61 6e 64 20 69 6e 63 6c 75 73 69 76 65 20 H and inclusive
5070: 77 69 74 68 20 30 29 2c 20 6e 6f 74 20 30 20 74 with 0), not 0 t
5080: 6f 0a 3b 3b 3b 20 20 20 4c 45 4e 47 54 48 20 61 o.;;; LENGTH a
5090: 73 20 77 69 74 68 20 56 45 43 54 4f 52 2d 55 4e s with VECTOR-UN
50a0: 46 4f 4c 44 2e 0a 28 64 65 66 69 6e 65 20 76 65 FOLD..(define ve
50b0: 63 74 6f 72 2d 75 6e 66 6f 6c 64 2d 72 69 67 68 ctor-unfold-righ
50c0: 74 0a 20 20 28 6c 65 74 72 65 63 20 28 28 74 61 t. (letrec ((ta
50d0: 62 75 6c 61 74 65 21 0a 20 20 20 20 20 20 20 20 bulate!.
50e0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 20 76 (lambda (f v
50f0: 65 63 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 ec i).
5100: 20 20 20 20 28 63 6f 6e 64 20 28 28 3e 3d 20 69 (cond ((>= i
5110: 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0).
5120: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
5130: 2d 73 65 74 21 20 76 65 63 20 69 20 28 66 20 69 -set! vec i (f i
5140: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5150: 20 20 20 20 20 20 20 20 28 74 61 62 75 6c 61 74 (tabulat
5160: 65 21 20 66 20 76 65 63 20 28 2d 20 69 20 31 29 e! f vec (- i 1)
5170: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
5180: 20 28 75 6e 66 6f 6c 64 31 21 0a 20 20 20 20 20 (unfold1!.
5190: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
51a0: 66 20 76 65 63 20 69 20 73 65 65 64 29 0a 20 20 f vec i seed).
51b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
51c0: 28 3e 3d 20 69 20 30 29 0a 20 20 20 20 20 20 20 (>= i 0).
51d0: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 63 65 (rece
51e0: 69 76 65 20 28 65 6c 74 20 6e 65 77 2d 73 65 65 ive (elt new-see
51f0: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
5200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
5210: 20 69 20 73 65 65 64 29 0a 20 20 20 20 20 20 20 i seed).
5220: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
5230: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 69 20 ctor-set! vec i
5240: 65 6c 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 elt).
5250: 20 20 20 20 20 20 20 20 20 28 75 6e 66 6f 6c 64 (unfold
5260: 31 21 20 66 20 76 65 63 20 28 2d 20 69 20 31 29 1! f vec (- i 1)
5270: 20 6e 65 77 2d 73 65 65 64 29 29 29 29 29 0a 20 new-seed))))).
5280: 20 20 20 20 20 20 20 20 20 20 28 75 6e 66 6f 6c (unfol
5290: 64 32 2b 21 0a 20 20 20 20 20 20 20 20 20 20 20 d2+!.
52a0: 20 28 6c 61 6d 62 64 61 20 28 66 20 76 65 63 20 (lambda (f vec
52b0: 69 20 73 65 65 64 73 29 0a 20 20 20 20 20 20 20 i seeds).
52c0: 20 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 (if (>= i
52d0: 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0).
52e0: 20 20 20 20 20 20 28 72 65 63 65 69 76 65 20 28 (receive (
52f0: 65 6c 74 20 2e 20 6e 65 77 2d 73 65 65 64 73 29 elt . new-seeds)
5300: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5310: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
5320: 6c 79 20 66 20 69 20 73 65 65 64 73 29 0a 20 20 ly f i seeds).
5330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5340: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 (vector-set! v
5350: 65 63 20 69 20 65 6c 74 29 0a 20 20 20 20 20 20 ec i elt).
5360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 75 (u
5370: 6e 66 6f 6c 64 32 2b 21 20 66 20 76 65 63 20 28 nfold2+! f vec (
5380: 2d 20 69 20 31 29 20 6e 65 77 2d 73 65 65 64 73 - i 1) new-seeds
5390: 29 29 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 )))))). (lamb
53a0: 64 61 20 28 66 20 6c 65 6e 20 2e 20 69 6e 69 74 da (f len . init
53b0: 69 61 6c 2d 73 65 65 64 73 29 0a 20 20 20 20 20 ial-seeds).
53c0: 20 28 6c 65 74 20 28 28 66 20 20 20 28 63 68 65 (let ((f (che
53d0: 63 6b 2d 74 79 70 65 20 70 72 6f 63 65 64 75 72 ck-type procedur
53e0: 65 3f 20 20 66 20 20 20 76 65 63 74 6f 72 2d 75 e? f vector-u
53f0: 6e 66 6f 6c 64 2d 72 69 67 68 74 29 29 0a 20 20 nfold-right)).
5400: 20 20 20 20 20 20 20 20 20 20 28 6c 65 6e 20 28 (len (
5410: 63 68 65 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 check-type nonne
5420: 67 2d 69 6e 74 3f 20 6c 65 6e 20 76 65 63 74 6f g-int? len vecto
5430: 72 2d 75 6e 66 6f 6c 64 2d 72 69 67 68 74 29 29 r-unfold-right))
5440: 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 ). (let (
5450: 28 76 65 63 20 28 6d 61 6b 65 2d 76 65 63 74 6f (vec (make-vecto
5460: 72 20 6c 65 6e 29 29 0a 20 20 20 20 20 20 20 20 r len)).
5470: 20 20 20 20 20 20 28 69 20 28 2d 20 6c 65 6e 20 (i (- len
5480: 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 1))). (
5490: 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 69 6e 69 cond ((null? ini
54a0: 74 69 61 6c 2d 73 65 65 64 73 29 0a 20 20 20 20 tial-seeds).
54b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 61 (ta
54c0: 62 75 6c 61 74 65 21 20 66 20 76 65 63 20 69 29 bulate! f vec i)
54d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
54e0: 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 72 20 69 ((null? (cdr i
54f0: 6e 69 74 69 61 6c 2d 73 65 65 64 73 29 29 0a 20 nitial-seeds)).
5500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5510: 28 75 6e 66 6f 6c 64 31 21 20 20 66 20 76 65 63 (unfold1! f vec
5520: 20 69 20 28 63 61 72 20 69 6e 69 74 69 61 6c 2d i (car initial-
5530: 73 65 65 64 73 29 29 29 0a 20 20 20 20 20 20 20 seeds))).
5540: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
5550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5560: 28 75 6e 66 6f 6c 64 32 2b 21 20 66 20 76 65 63 (unfold2+! f vec
5570: 20 69 20 69 6e 69 74 69 61 6c 2d 73 65 65 64 73 i initial-seeds
5580: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 76 65 ))). ve
5590: 63 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 c)))))..;;; (VEC
55a0: 54 4f 52 2d 43 4f 50 59 20 3c 76 65 63 74 6f 72 TOR-COPY <vector
55b0: 3e 20 5b 3c 73 74 61 72 74 3e 20 3c 65 6e 64 3e > [<start> <end>
55c0: 20 3c 66 69 6c 6c 3e 5d 29 20 2d 3e 20 76 65 63 <fill>]) -> vec
55d0: 74 6f 72 0a 3b 3b 3b 20 20 20 43 72 65 61 74 65 tor.;;; Create
55e0: 20 61 20 6e 65 77 6c 79 20 61 6c 6c 6f 63 61 74 a newly allocat
55f0: 65 64 20 76 65 63 74 6f 72 20 63 6f 6e 74 61 69 ed vector contai
5600: 6e 69 6e 67 20 74 68 65 20 65 6c 65 6d 65 6e 74 ning the element
5610: 73 20 66 72 6f 6d 20 74 68 65 0a 3b 3b 3b 20 20 s from the.;;;
5620: 20 72 61 6e 67 65 20 5b 53 54 41 52 54 2c 45 4e range [START,EN
5630: 44 29 20 69 6e 20 56 45 43 54 4f 52 2e 20 20 53 D) in VECTOR. S
5640: 54 41 52 54 20 64 65 66 61 75 6c 74 73 20 74 6f TART defaults to
5650: 20 30 3b 20 45 4e 44 20 64 65 66 61 75 6c 74 73 0; END defaults
5660: 0a 3b 3b 3b 20 20 20 74 6f 20 74 68 65 20 6c 65 .;;; to the le
5670: 6e 67 74 68 20 6f 66 20 56 45 43 54 4f 52 2e 20 ngth of VECTOR.
5680: 20 45 4e 44 20 6d 61 79 20 62 65 20 67 72 65 61 END may be grea
5690: 74 65 72 20 74 68 61 6e 20 74 68 65 20 6c 65 6e ter than the len
56a0: 67 74 68 20 6f 66 0a 3b 3b 3b 20 20 20 56 45 43 gth of.;;; VEC
56b0: 54 4f 52 2c 20 69 6e 20 77 68 69 63 68 20 63 61 TOR, in which ca
56c0: 73 65 20 74 68 65 20 76 65 63 74 6f 72 20 69 73 se the vector is
56d0: 20 65 6e 6c 61 72 67 65 64 3b 20 69 66 20 46 49 enlarged; if FI
56e0: 4c 4c 20 69 73 20 70 61 73 73 65 64 2c 0a 3b 3b LL is passed,.;;
56f0: 3b 20 20 20 74 68 65 20 6e 65 77 20 6c 6f 63 61 ; the new loca
5700: 74 69 6f 6e 73 20 66 72 6f 6d 20 77 68 69 63 68 tions from which
5710: 20 74 68 65 72 65 20 69 73 20 6e 6f 20 72 65 73 there is no res
5720: 70 65 63 74 69 76 65 20 65 6c 65 6d 65 6e 74 20 pective element
5730: 69 6e 0a 3b 3b 3b 20 20 20 56 45 43 54 4f 52 20 in.;;; VECTOR
5740: 61 72 65 20 66 69 6c 6c 65 64 20 77 69 74 68 20 are filled with
5750: 46 49 4c 4c 2e 0a 28 64 65 66 69 6e 65 20 28 76 FILL..(define (v
5760: 65 63 74 6f 72 2d 63 6f 70 79 20 76 65 63 20 2e ector-copy vec .
5770: 20 61 72 67 73 29 0a 20 20 28 6c 65 74 20 28 28 args). (let ((
5780: 76 65 63 20 28 63 68 65 63 6b 2d 74 79 70 65 20 vec (check-type
5790: 76 65 63 74 6f 72 3f 20 76 65 63 20 76 65 63 74 vector? vec vect
57a0: 6f 72 2d 63 6f 70 79 29 29 29 0a 20 20 20 20 3b or-copy))). ;
57b0: 3b 20 57 65 20 63 61 6e 27 74 20 75 73 65 20 4c ; We can't use L
57c0: 45 54 2d 56 45 43 54 4f 52 2d 53 54 41 52 54 2b ET-VECTOR-START+
57d0: 45 4e 44 2c 20 62 65 63 61 75 73 65 20 77 65 20 END, because we
57e0: 68 61 76 65 20 6f 6e 65 20 6d 6f 72 65 0a 20 20 have one more.
57f0: 20 20 3b 3b 20 61 72 67 75 6d 65 6e 74 2c 20 61 ;; argument, a
5800: 6e 64 20 77 65 20 77 61 6e 74 20 66 69 6e 65 72 nd we want finer
5810: 20 63 6f 6e 74 72 6f 6c 2c 20 74 6f 6f 2e 0a 20 control, too..
5820: 20 20 20 3b 3b 0a 20 20 20 20 3b 3b 20 4f 6c 69 ;;. ;; Oli
5830: 6e 27 73 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 n's implementati
5840: 6f 6e 20 6f 66 20 4c 45 54 2a 2d 4f 50 54 49 4f on of LET*-OPTIO
5850: 4e 41 4c 53 20 77 6f 75 6c 64 20 70 72 6f 76 65 NALS would prove
5860: 20 75 73 65 66 75 6c 20 68 65 72 65 3a 0a 20 20 useful here:.
5870: 20 20 3b 3b 20 74 68 65 20 62 75 69 6c 74 2d 69 ;; the built-i
5880: 6e 20 61 72 67 75 6d 65 6e 74 2d 63 68 65 63 6b n argument-check
5890: 73 2d 61 73 2d 79 6f 75 2d 67 6f 2d 61 6c 6f 6e s-as-you-go-alon
58a0: 67 20 70 72 6f 64 75 63 65 73 20 61 6c 6d 6f 73 g produces almos
58b0: 74 0a 20 20 20 20 3b 3b 20 5f 65 78 61 63 74 6c t. ;; _exactl
58c0: 79 5f 20 74 68 65 20 73 61 6d 65 20 63 6f 64 65 y_ the same code
58d0: 20 61 73 20 56 45 43 54 4f 52 2d 43 4f 50 59 3a as VECTOR-COPY:
58e0: 50 41 52 53 45 2d 41 52 47 53 2e 0a 20 20 20 20 PARSE-ARGS..
58f0: 28 72 65 63 65 69 76 65 20 28 73 74 61 72 74 20 (receive (start
5900: 65 6e 64 20 66 69 6c 6c 29 0a 20 20 20 20 20 20 end fill).
5910: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 63 (vector-c
5920: 6f 70 79 3a 70 61 72 73 65 2d 61 72 67 73 20 76 opy:parse-args v
5930: 65 63 20 61 72 67 73 29 0a 20 20 20 20 20 20 28 ec args). (
5940: 6c 65 74 20 28 28 6e 65 77 2d 76 65 63 74 6f 72 let ((new-vector
5950: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 2d (make-vector (-
5960: 20 65 6e 64 20 73 74 61 72 74 29 20 66 69 6c 6c end start) fill
5970: 29 29 29 0a 20 20 20 20 20 20 20 20 28 25 76 65 ))). (%ve
5980: 63 74 6f 72 2d 63 6f 70 79 21 20 6e 65 77 2d 76 ctor-copy! new-v
5990: 65 63 74 6f 72 20 30 0a 20 20 20 20 20 20 20 20 ector 0.
59a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 v
59b0: 65 63 20 20 20 20 20 20 20 20 73 74 61 72 74 0a ec start.
59c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59d0: 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 65 6e (if (> en
59e0: 64 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 d (vector-length
59f0: 20 76 65 63 29 29 0a 20 20 20 20 20 20 20 20 20 vec)).
5a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a10: 20 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 (vector-length
5a20: 20 76 65 63 29 0a 20 20 20 20 20 20 20 20 20 20 vec).
5a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a40: 20 65 6e 64 29 29 0a 20 20 20 20 20 20 20 20 6e end)). n
5a50: 65 77 2d 76 65 63 74 6f 72 29 29 29 29 0a 0a 3b ew-vector))))..;
5a60: 3b 3b 20 41 75 78 69 6c 69 61 72 79 20 66 6f 72 ;; Auxiliary for
5a70: 20 56 45 43 54 4f 52 2d 43 4f 50 59 2e 0a 3b 3b VECTOR-COPY..;;
5a80: 3b 20 5b 77 64 63 5d 20 43 6f 72 72 65 63 74 65 ; [wdc] Correcte
5a90: 64 20 74 6f 20 61 6c 6c 6f 77 20 30 20 3c 3d 20 d to allow 0 <=
5aa0: 73 74 61 72 74 20 3c 3d 20 28 76 65 63 74 6f 72 start <= (vector
5ab0: 2d 6c 65 6e 67 74 68 20 76 65 63 29 2e 0a 28 64 -length vec)..(d
5ac0: 65 66 69 6e 65 20 28 76 65 63 74 6f 72 2d 63 6f efine (vector-co
5ad0: 70 79 3a 70 61 72 73 65 2d 61 72 67 73 20 76 65 py:parse-args ve
5ae0: 63 20 61 72 67 73 29 0a 20 20 28 64 65 66 69 6e c args). (defin
5af0: 65 20 28 70 61 72 73 65 2d 61 72 67 73 20 73 74 e (parse-args st
5b00: 61 72 74 20 65 6e 64 20 6e 20 66 69 6c 6c 29 0a art end n fill).
5b10: 20 20 20 20 28 6c 65 74 20 28 28 73 74 61 72 74 (let ((start
5b20: 20 28 63 68 65 63 6b 2d 74 79 70 65 20 6e 6f 6e (check-type non
5b30: 6e 65 67 2d 69 6e 74 3f 20 73 74 61 72 74 20 76 neg-int? start v
5b40: 65 63 74 6f 72 2d 63 6f 70 79 29 29 0a 20 20 20 ector-copy)).
5b50: 20 20 20 20 20 20 20 28 65 6e 64 20 20 20 28 63 (end (c
5b60: 68 65 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 67 heck-type nonneg
5b70: 2d 69 6e 74 3f 20 65 6e 64 20 76 65 63 74 6f 72 -int? end vector
5b80: 2d 63 6f 70 79 29 29 29 0a 20 20 20 20 20 20 28 -copy))). (
5b90: 63 6f 6e 64 20 28 28 61 6e 64 20 28 3c 3d 20 30 cond ((and (<= 0
5ba0: 20 73 74 61 72 74 20 65 6e 64 29 0a 20 20 20 20 start end).
5bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3c (<
5bc0: 3d 20 73 74 61 72 74 20 6e 29 29 0a 20 20 20 20 = start n)).
5bd0: 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 (values
5be0: 20 73 74 61 72 74 20 65 6e 64 20 66 69 6c 6c 29 start end fill)
5bf0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 65 ). (e
5c00: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
5c10: 20 28 65 72 72 6f 72 20 22 69 6c 6c 65 67 61 6c (error "illegal
5c20: 20 61 72 67 75 6d 65 6e 74 73 22 0a 20 20 20 20 arguments".
5c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c40: 60 28 77 68 69 6c 65 20 63 61 6c 6c 69 6e 67 20 `(while calling
5c50: 2c 76 65 63 74 6f 72 2d 63 6f 70 79 29 0a 20 20 ,vector-copy).
5c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c70: 20 20 60 28 73 74 61 72 74 20 77 61 73 20 2c 73 `(start was ,s
5c80: 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 tart).
5c90: 20 20 20 20 20 20 20 20 20 20 60 28 65 6e 64 20 `(end
5ca0: 77 61 73 20 2c 65 6e 64 29 0a 20 20 20 20 20 20 was ,end).
5cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
5cc0: 76 65 63 74 6f 72 20 77 61 73 20 2c 76 65 63 29 vector was ,vec)
5cd0: 29 29 29 29 29 0a 20 20 28 6c 65 74 20 28 28 6e ))))). (let ((n
5ce0: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
5cf0: 76 65 63 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 vec))). (cond
5d00: 20 28 28 6e 75 6c 6c 3f 20 61 72 67 73 29 0a 20 ((null? args).
5d10: 20 20 20 20 20 20 20 20 20 20 28 70 61 72 73 65 (parse
5d20: 2d 61 72 67 73 20 30 20 6e 20 6e 20 28 75 6e 73 -args 0 n n (uns
5d30: 70 65 63 69 66 69 65 64 2d 76 61 6c 75 65 29 29 pecified-value))
5d40: 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 ). ((nu
5d50: 6c 6c 3f 20 28 63 64 72 20 61 72 67 73 29 29 0a ll? (cdr args)).
5d60: 20 20 20 20 20 20 20 20 20 20 20 28 70 61 72 73 (pars
5d70: 65 2d 61 72 67 73 20 28 63 61 72 20 61 72 67 73 e-args (car args
5d80: 29 20 6e 20 6e 20 28 75 6e 73 70 65 63 69 66 69 ) n n (unspecifi
5d90: 65 64 2d 76 61 6c 75 65 29 29 29 0a 20 20 20 20 ed-value))).
5da0: 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 ((null? (c
5db0: 64 64 72 20 61 72 67 73 29 29 0a 20 20 20 20 20 ddr args)).
5dc0: 20 20 20 20 20 20 28 70 61 72 73 65 2d 61 72 67 (parse-arg
5dd0: 73 20 28 63 61 72 20 61 72 67 73 29 20 28 63 61 s (car args) (ca
5de0: 64 72 20 61 72 67 73 29 20 6e 20 28 75 6e 73 70 dr args) n (unsp
5df0: 65 63 69 66 69 65 64 2d 76 61 6c 75 65 29 29 29 ecified-value)))
5e00: 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c . ((nul
5e10: 6c 3f 20 28 63 64 64 64 72 20 61 72 67 73 29 29 l? (cdddr args))
5e20: 0a 20 20 20 20 20 20 20 20 20 20 20 28 70 61 72 . (par
5e30: 73 65 2d 61 72 67 73 20 28 63 61 72 20 61 72 67 se-args (car arg
5e40: 73 29 20 28 63 61 64 72 20 61 72 67 73 29 20 6e s) (cadr args) n
5e50: 20 28 63 61 64 64 72 20 61 72 67 73 29 29 29 0a (caddr args))).
5e60: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
5e70: 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f (erro
5e80: 72 20 22 74 6f 6f 20 6d 61 6e 79 20 61 72 67 75 r "too many argu
5e90: 6d 65 6e 74 73 22 0a 20 20 20 20 20 20 20 20 20 ments".
5ea0: 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d vector-
5eb0: 63 6f 70 79 0a 20 20 20 20 20 20 20 20 20 20 20 copy.
5ec0: 20 20 20 20 20 20 20 28 63 64 64 64 72 20 61 72 (cdddr ar
5ed0: 67 73 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 gs))))))..;;; (V
5ee0: 45 43 54 4f 52 2d 52 45 56 45 52 53 45 2d 43 4f ECTOR-REVERSE-CO
5ef0: 50 59 20 3c 76 65 63 74 6f 72 3e 20 5b 3c 73 74 PY <vector> [<st
5f00: 61 72 74 3e 20 3c 65 6e 64 3e 5d 29 20 2d 3e 20 art> <end>]) ->
5f10: 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 20 43 72 65 vector.;;; Cre
5f20: 61 74 65 20 61 20 6e 65 77 6c 79 20 61 6c 6c 6f ate a newly allo
5f30: 63 61 74 65 64 20 76 65 63 74 6f 72 20 77 68 6f cated vector who
5f40: 73 65 20 65 6c 65 6d 65 6e 74 73 20 61 72 65 20 se elements are
5f50: 74 68 65 20 72 65 76 65 72 73 65 64 0a 3b 3b 3b the reversed.;;;
5f60: 20 20 20 73 65 71 75 65 6e 63 65 20 6f 66 20 65 sequence of e
5f70: 6c 65 6d 65 6e 74 73 20 62 65 74 77 65 65 6e 20 lements between
5f80: 53 54 41 52 54 20 61 6e 64 20 45 4e 44 20 69 6e START and END in
5f90: 20 56 45 43 54 4f 52 2e 20 20 53 54 41 52 54 27 VECTOR. START'
5fa0: 73 0a 3b 3b 3b 20 20 20 64 65 66 61 75 6c 74 20 s.;;; default
5fb0: 69 73 20 30 3b 20 45 4e 44 27 73 20 64 65 66 61 is 0; END's defa
5fc0: 75 6c 74 20 69 73 20 74 68 65 20 6c 65 6e 67 74 ult is the lengt
5fd0: 68 20 6f 66 20 56 45 43 54 4f 52 2e 0a 28 64 65 h of VECTOR..(de
5fe0: 66 69 6e 65 20 28 76 65 63 74 6f 72 2d 72 65 76 fine (vector-rev
5ff0: 65 72 73 65 2d 63 6f 70 79 20 76 65 63 20 2e 20 erse-copy vec .
6000: 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e 64 29 maybe-start+end)
6010: 0a 20 20 28 6c 65 74 2d 76 65 63 74 6f 72 2d 73 . (let-vector-s
6020: 74 61 72 74 2b 65 6e 64 20 76 65 63 74 6f 72 2d tart+end vector-
6030: 72 65 76 65 72 73 65 2d 63 6f 70 79 20 76 65 63 reverse-copy vec
6040: 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e 64 maybe-start+end
6050: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6060: 20 20 20 20 20 20 20 20 20 28 73 74 61 72 74 20 (start
6070: 65 6e 64 29 0a 20 20 20 20 28 6c 65 74 20 28 28 end). (let ((
6080: 6e 65 77 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 new (make-vector
6090: 20 28 2d 20 65 6e 64 20 73 74 61 72 74 29 29 29 (- end start)))
60a0: 29 0a 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 ). (%vector
60b0: 2d 72 65 76 65 72 73 65 2d 63 6f 70 79 21 20 6e -reverse-copy! n
60c0: 65 77 20 30 20 76 65 63 20 73 74 61 72 74 20 65 ew 0 vec start e
60d0: 6e 64 29 0a 20 20 20 20 20 20 6e 65 77 29 29 29 nd). new)))
60e0: 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 41 50 ..;;; (VECTOR-AP
60f0: 50 45 4e 44 20 3c 76 65 63 74 6f 72 3e 20 2e 2e PEND <vector> ..
6100: 2e 29 20 2d 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b .) -> vector.;;;
6110: 20 20 20 41 70 70 65 6e 64 20 56 45 43 54 4f 52 Append VECTOR
6120: 20 2e 2e 2e 20 69 6e 74 6f 20 61 20 6e 65 77 6c ... into a newl
6130: 79 20 61 6c 6c 6f 63 61 74 65 64 20 76 65 63 74 y allocated vect
6140: 6f 72 20 61 6e 64 20 72 65 74 75 72 6e 20 74 68 or and return th
6150: 61 74 0a 3b 3b 3b 20 20 20 6e 65 77 20 76 65 63 at.;;; new vec
6160: 74 6f 72 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 tor..(define (ve
6170: 63 74 6f 72 2d 61 70 70 65 6e 64 20 2e 20 76 65 ctor-append . ve
6180: 63 74 6f 72 73 29 0a 20 20 28 76 65 63 74 6f 72 ctors). (vector
6190: 2d 63 6f 6e 63 61 74 65 6e 61 74 65 3a 61 75 78 -concatenate:aux
61a0: 20 76 65 63 74 6f 72 73 20 76 65 63 74 6f 72 2d vectors vector-
61b0: 61 70 70 65 6e 64 29 29 0a 0a 3b 3b 3b 20 28 56 append))..;;; (V
61c0: 45 43 54 4f 52 2d 43 4f 4e 43 41 54 45 4e 41 54 ECTOR-CONCATENAT
61d0: 45 20 3c 76 65 63 74 6f 72 2d 6c 69 73 74 3e 29 E <vector-list>)
61e0: 20 2d 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 -> vector.;;;
61f0: 20 43 6f 6e 63 61 74 65 6e 61 74 65 20 74 68 65 Concatenate the
6200: 20 76 65 63 74 6f 72 73 20 69 6e 20 56 45 43 54 vectors in VECT
6210: 4f 52 2d 4c 49 53 54 2e 20 20 54 68 69 73 20 69 OR-LIST. This i
6220: 73 20 65 71 75 69 76 61 6c 65 6e 74 20 74 6f 0a s equivalent to.
6230: 3b 3b 3b 20 20 20 20 20 28 61 70 70 6c 79 20 76 ;;; (apply v
6240: 65 63 74 6f 72 2d 61 70 70 65 6e 64 20 56 45 43 ector-append VEC
6250: 54 4f 52 2d 4c 49 53 54 29 0a 3b 3b 3b 20 20 20 TOR-LIST).;;;
6260: 62 75 74 20 56 45 43 54 4f 52 2d 41 50 50 45 4e but VECTOR-APPEN
6270: 44 20 74 65 6e 64 73 20 74 6f 20 62 65 20 69 6d D tends to be im
6280: 70 6c 65 6d 65 6e 74 65 64 20 69 6e 20 74 65 72 plemented in ter
6290: 6d 73 20 6f 66 0a 3b 3b 3b 20 20 20 56 45 43 54 ms of.;;; VECT
62a0: 4f 52 2d 43 4f 4e 43 41 54 45 4e 41 54 45 2c 20 OR-CONCATENATE,
62b0: 61 6e 64 20 73 6f 6d 65 20 53 63 68 65 6d 65 73 and some Schemes
62c0: 20 62 6f 72 6b 20 77 68 65 6e 20 74 68 65 20 6c bork when the l
62d0: 69 73 74 20 74 6f 20 61 70 70 6c 79 0a 3b 3b 3b ist to apply.;;;
62e0: 20 20 20 61 20 66 75 6e 63 74 69 6f 6e 20 74 6f a function to
62f0: 20 69 73 20 74 6f 6f 20 6c 6f 6e 67 2e 0a 3b 3b is too long..;;
6300: 3b 0a 3b 3b 3b 20 41 63 74 75 61 6c 6c 79 2c 20 ;.;;; Actually,
6310: 74 68 65 79 27 72 65 20 62 6f 74 68 20 69 6d 70 they're both imp
6320: 6c 65 6d 65 6e 74 65 64 20 69 6e 20 74 65 72 6d lemented in term
6330: 73 20 6f 66 20 61 6e 20 69 6e 74 65 72 6e 61 6c s of an internal
6340: 20 72 6f 75 74 69 6e 65 2e 0a 28 64 65 66 69 6e routine..(defin
6350: 65 20 28 76 65 63 74 6f 72 2d 63 6f 6e 63 61 74 e (vector-concat
6360: 65 6e 61 74 65 20 76 65 63 74 6f 72 2d 6c 69 73 enate vector-lis
6370: 74 29 0a 20 20 28 76 65 63 74 6f 72 2d 63 6f 6e t). (vector-con
6380: 63 61 74 65 6e 61 74 65 3a 61 75 78 20 76 65 63 catenate:aux vec
6390: 74 6f 72 2d 6c 69 73 74 20 76 65 63 74 6f 72 2d tor-list vector-
63a0: 63 6f 6e 63 61 74 65 6e 61 74 65 29 29 0a 0a 3b concatenate))..;
63b0: 3b 3b 20 41 75 78 69 6c 69 61 72 79 20 66 6f 72 ;; Auxiliary for
63c0: 20 56 45 43 54 4f 52 2d 41 50 50 45 4e 44 20 61 VECTOR-APPEND a
63d0: 6e 64 20 56 45 43 54 4f 52 2d 43 4f 4e 43 41 54 nd VECTOR-CONCAT
63e0: 45 4e 41 54 45 0a 28 64 65 66 69 6e 65 20 76 65 ENATE.(define ve
63f0: 63 74 6f 72 2d 63 6f 6e 63 61 74 65 6e 61 74 65 ctor-concatenate
6400: 3a 61 75 78 0a 20 20 28 6c 65 74 72 65 63 20 28 :aux. (letrec (
6410: 28 63 6f 6d 70 75 74 65 2d 6c 65 6e 67 74 68 0a (compute-length.
6420: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
6430: 62 64 61 20 28 76 65 63 74 6f 72 73 20 6c 65 6e bda (vectors len
6440: 20 63 61 6c 6c 65 65 29 0a 20 20 20 20 20 20 20 callee).
6450: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
6460: 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 20 20 20 ? vectors).
6470: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 65 6e len
6480: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6490: 20 20 20 28 6c 65 74 20 28 28 76 65 63 20 28 63 (let ((vec (c
64a0: 68 65 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 heck-type vector
64b0: 3f 20 28 63 61 72 20 76 65 63 74 6f 72 73 29 0a ? (car vectors).
64c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64e0: 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 callee)
64f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6500: 20 20 20 20 20 20 20 28 63 6f 6d 70 75 74 65 2d (compute-
6510: 6c 65 6e 67 74 68 20 28 63 64 72 20 76 65 63 74 length (cdr vect
6520: 6f 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ors).
6530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6540: 20 20 20 20 20 20 20 20 20 28 2b 20 28 76 65 63 (+ (vec
6550: 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 20 tor-length vec)
6560: 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 len).
6570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6580: 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 callee)
6590: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
65a0: 28 63 6f 6e 63 61 74 65 6e 61 74 65 21 0a 20 20 (concatenate!.
65b0: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
65c0: 61 20 28 76 65 63 74 6f 72 73 20 74 61 72 67 65 a (vectors targe
65d0: 74 20 74 6f 29 0a 20 20 20 20 20 20 20 20 20 20 t to).
65e0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 76 (if (null? v
65f0: 65 63 74 6f 72 73 29 0a 20 20 20 20 20 20 20 20 ectors).
6600: 20 20 20 20 20 20 20 20 20 20 74 61 72 67 65 74 target
6610: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6620: 20 20 20 28 6c 65 74 2a 20 28 28 76 65 63 31 20 (let* ((vec1
6630: 28 63 61 72 20 76 65 63 74 6f 72 73 29 29 0a 20 (car vectors)).
6640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6650: 20 20 20 20 20 20 20 20 28 6c 65 6e 20 28 76 65 (len (ve
6660: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 31 ctor-length vec1
6670: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
6680: 20 20 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 (%vector
6690: 2d 63 6f 70 79 21 20 74 61 72 67 65 74 20 74 6f -copy! target to
66a0: 20 76 65 63 31 20 30 20 6c 65 6e 29 0a 20 20 20 vec1 0 len).
66b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66c0: 20 28 63 6f 6e 63 61 74 65 6e 61 74 65 21 20 28 (concatenate! (
66d0: 63 64 72 20 76 65 63 74 6f 72 73 29 20 74 61 72 cdr vectors) tar
66e0: 67 65 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 get.
66f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6700: 20 20 20 20 20 20 28 2b 20 74 6f 20 6c 65 6e 29 (+ to len)
6710: 29 29 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 )))))). (lamb
6720: 64 61 20 28 76 65 63 74 6f 72 73 20 63 61 6c 6c da (vectors call
6730: 65 65 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 ee). (cond
6740: 28 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 ((null? vectors)
6750: 20 20 20 20 20 20 20 20 20 20 20 20 3b 2b 2b 2b ;+++
6760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d . (m
6770: 61 6b 65 2d 76 65 63 74 6f 72 20 30 29 29 0a 20 ake-vector 0)).
6780: 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c ((nul
6790: 6c 3f 20 28 63 64 72 20 76 65 63 74 6f 72 73 29 l? (cdr vectors)
67a0: 29 20 20 20 20 20 20 3b 2b 2b 2b 0a 20 20 20 20 ) ;+++.
67b0: 20 20 20 20 20 20 20 20 20 3b 3b 20 42 6c 65 63 ;; Blec
67c0: 68 2c 20 77 65 20 73 74 69 6c 6c 20 68 61 76 65 h, we still have
67d0: 20 74 6f 20 61 6c 6c 6f 63 61 74 65 20 61 20 6e to allocate a n
67e0: 65 77 20 6f 6e 65 2e 0a 20 20 20 20 20 20 20 20 ew one..
67f0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 76 65 63 (let* ((vec
6800: 20 28 63 68 65 63 6b 2d 74 79 70 65 20 76 65 63 (check-type vec
6810: 74 6f 72 3f 20 28 63 61 72 20 76 65 63 74 6f 72 tor? (car vector
6820: 73 29 20 63 61 6c 6c 65 65 29 29 0a 20 20 20 20 s) callee)).
6830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6840: 28 6c 65 6e 20 28 76 65 63 74 6f 72 2d 6c 65 6e (len (vector-len
6850: 67 74 68 20 76 65 63 29 29 0a 20 20 20 20 20 20 gth vec)).
6860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e (n
6870: 65 77 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 ew (make-vector
6880: 6c 65 6e 29 29 29 0a 20 20 20 20 20 20 20 20 20 len))).
6890: 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 2d 63 (%vector-c
68a0: 6f 70 79 21 20 6e 65 77 20 30 20 76 65 63 20 30 opy! new 0 vec 0
68b0: 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 len).
68c0: 20 20 20 20 20 6e 65 77 29 29 0a 20 20 20 20 20 new)).
68d0: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
68e0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
68f0: 28 6e 65 77 2d 76 65 63 74 6f 72 0a 20 20 20 20 (new-vector.
6900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6910: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 63 6f (make-vector (co
6920: 6d 70 75 74 65 2d 6c 65 6e 67 74 68 20 76 65 63 mpute-length vec
6930: 74 6f 72 73 20 30 20 63 61 6c 6c 65 65 29 29 29 tors 0 callee)))
6940: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6950: 20 28 63 6f 6e 63 61 74 65 6e 61 74 65 21 20 76 (concatenate! v
6960: 65 63 74 6f 72 73 20 6e 65 77 2d 76 65 63 74 6f ectors new-vecto
6970: 72 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 r 0).
6980: 20 20 20 20 6e 65 77 2d 76 65 63 74 6f 72 29 29 new-vector))
6990: 29 29 29 29 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d 2d )))).....;;; ---
69a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
69b0: 2d 0a 3b 3b 3b 20 50 72 65 64 69 63 61 74 65 73 -.;;; Predicates
69c0: 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 3f 20 3c ..;;; (VECTOR? <
69d0: 76 61 6c 75 65 3e 29 20 2d 3e 20 62 6f 6f 6c 65 value>) -> boole
69e0: 61 6e 0a 3b 3b 3b 20 20 20 5b 52 35 52 53 5d 20 an.;;; [R5RS]
69f0: 52 65 74 75 72 6e 20 23 54 20 69 66 20 56 41 4c Return #T if VAL
6a00: 55 45 20 69 73 20 61 20 76 65 63 74 6f 72 20 61 UE is a vector a
6a10: 6e 64 20 23 46 20 69 66 20 6e 6f 74 2e 0a 28 64 nd #F if not..(d
6a20: 65 66 69 6e 65 20 76 65 63 74 6f 72 3f 20 76 65 efine vector? ve
6a30: 63 74 6f 72 3f 29 0a 0a 3b 3b 3b 20 28 56 45 43 ctor?)..;;; (VEC
6a40: 54 4f 52 2d 45 4d 50 54 59 3f 20 3c 76 65 63 74 TOR-EMPTY? <vect
6a50: 6f 72 3e 29 20 2d 3e 20 62 6f 6f 6c 65 61 6e 0a or>) -> boolean.
6a60: 3b 3b 3b 20 20 20 52 65 74 75 72 6e 20 23 54 20 ;;; Return #T
6a70: 69 66 20 56 45 43 54 4f 52 20 68 61 73 20 7a 65 if VECTOR has ze
6a80: 72 6f 20 65 6c 65 6d 65 6e 74 73 20 69 6e 20 69 ro elements in i
6a90: 74 2c 20 69 2e 65 2e 20 56 45 43 54 4f 52 27 73 t, i.e. VECTOR's
6aa0: 20 6c 65 6e 67 74 68 0a 3b 3b 3b 20 20 20 69 73 length.;;; is
6ab0: 20 30 2c 20 61 6e 64 20 23 46 20 69 66 20 6e 6f 0, and #F if no
6ac0: 74 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 63 74 t..(define (vect
6ad0: 6f 72 2d 65 6d 70 74 79 3f 20 76 65 63 29 0a 20 or-empty? vec).
6ae0: 20 28 6c 65 74 20 28 28 76 65 63 20 28 63 68 65 (let ((vec (che
6af0: 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 ck-type vector?
6b00: 76 65 63 20 76 65 63 74 6f 72 2d 65 6d 70 74 79 vec vector-empty
6b10: 3f 29 29 29 0a 20 20 20 20 28 7a 65 72 6f 3f 20 ?))). (zero?
6b20: 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 (vector-length v
6b30: 65 63 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 ec))))..;;; (VEC
6b40: 54 4f 52 3d 20 3c 65 6c 74 3d 3f 3e 20 3c 76 65 TOR= <elt=?> <ve
6b50: 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d 3e 20 62 6f ctor> ...) -> bo
6b60: 6f 6c 65 61 6e 0a 3b 3b 3b 20 20 20 20 20 28 45 olean.;;; (E
6b70: 4c 54 3d 3f 20 3c 76 61 6c 75 65 3e 20 3c 76 61 LT=? <value> <va
6b80: 6c 75 65 3e 29 20 2d 3e 20 62 6f 6f 6c 65 61 6e lue>) -> boolean
6b90: 0a 3b 3b 3b 20 20 20 44 65 74 65 72 6d 69 6e 65 .;;; Determine
6ba0: 20 76 65 63 74 6f 72 20 65 71 75 61 6c 69 74 79 vector equality
6bb0: 20 67 65 6e 65 72 61 6c 69 7a 65 64 20 61 63 72 generalized acr
6bc0: 6f 73 73 20 65 6c 65 6d 65 6e 74 20 63 6f 6d 70 oss element comp
6bd0: 61 72 61 74 6f 72 73 2e 0a 3b 3b 3b 20 20 20 56 arators..;;; V
6be0: 65 63 74 6f 72 73 20 41 20 61 6e 64 20 42 20 61 ectors A and B a
6bf0: 72 65 20 65 71 75 61 6c 20 69 66 66 20 74 68 65 re equal iff the
6c00: 69 72 20 6c 65 6e 67 74 68 73 20 61 72 65 20 74 ir lengths are t
6c10: 68 65 20 73 61 6d 65 20 61 6e 64 20 66 6f 72 0a he same and for.
6c20: 3b 3b 3b 20 20 20 65 61 63 68 20 72 65 73 70 65 ;;; each respe
6c30: 63 74 69 76 65 20 65 6c 65 6d 65 6e 74 73 20 45 ctive elements E
6c40: 5f 61 20 61 6e 64 20 45 5f 62 20 28 65 6c 65 6d _a and E_b (elem
6c50: 65 6e 74 3d 3f 20 45 5f 61 20 45 5f 62 29 20 72 ent=? E_a E_b) r
6c60: 65 74 75 72 6e 73 0a 3b 3b 3b 20 20 20 61 20 74 eturns.;;; a t
6c70: 72 75 65 20 76 61 6c 75 65 2e 20 20 45 4c 54 3d rue value. ELT=
6c80: 3f 20 69 73 20 61 6c 77 61 79 73 20 61 70 70 6c ? is always appl
6c90: 69 65 64 20 74 6f 20 74 77 6f 20 61 72 67 75 6d ied to two argum
6ca0: 65 6e 74 73 2e 20 20 45 6c 65 6d 65 6e 74 0a 3b ents. Element.;
6cb0: 3b 3b 20 20 20 63 6f 6d 70 61 72 69 73 6f 6e 20 ;; comparison
6cc0: 6d 75 73 74 20 62 65 20 63 6f 6e 73 69 73 74 65 must be consiste
6cd0: 6e 74 20 77 74 69 68 20 45 51 3f 3b 20 74 68 61 nt wtih EQ?; tha
6ce0: 74 20 69 73 2c 20 69 66 20 28 65 71 3f 20 45 5f t is, if (eq? E_
6cf0: 61 20 45 5f 62 29 0a 3b 3b 3b 20 20 20 72 65 73 a E_b).;;; res
6d00: 75 6c 74 73 20 69 6e 20 61 20 74 72 75 65 20 76 ults in a true v
6d10: 61 6c 75 65 2c 20 74 68 65 6e 20 28 45 4c 45 4d alue, then (ELEM
6d20: 45 4e 54 3d 3f 20 45 5f 61 20 45 5f 62 29 20 6d ENT=? E_a E_b) m
6d30: 75 73 74 20 72 65 73 75 6c 74 20 69 6e 20 61 0a ust result in a.
6d40: 3b 3b 3b 20 20 20 74 72 75 65 20 76 61 6c 75 65 ;;; true value
6d50: 2e 20 20 54 68 69 73 20 6d 61 79 20 62 65 20 65 . This may be e
6d60: 78 70 6c 6f 69 74 65 64 20 74 6f 20 61 76 6f 69 xploited to avoi
6d70: 64 20 6d 75 6c 74 69 70 6c 65 20 75 6e 6e 65 63 d multiple unnec
6d80: 65 73 73 61 72 79 0a 3b 3b 3b 20 20 20 65 6c 65 essary.;;; ele
6d90: 6d 65 6e 74 20 63 6f 6d 70 61 72 69 73 6f 6e 73 ment comparisons
6da0: 2e 20 20 28 54 68 69 73 20 69 6d 70 6c 65 6d 65 . (This impleme
6db0: 6e 74 61 74 69 6f 6e 20 64 6f 65 73 2c 20 62 75 ntation does, bu
6dc0: 74 20 64 6f 65 73 20 6e 6f 74 20 64 65 61 6c 0a t does not deal.
6dd0: 3b 3b 3b 20 20 20 77 69 74 68 20 74 68 65 20 73 ;;; with the s
6de0: 69 74 75 61 74 69 6f 6e 20 74 68 61 74 20 45 4c ituation that EL
6df0: 45 4d 45 4e 54 3d 3f 20 69 73 20 45 51 3f 20 74 EMENT=? is EQ? t
6e00: 6f 20 61 76 6f 69 64 20 6d 6f 72 65 20 75 6e 6e o avoid more unn
6e10: 65 63 65 73 73 61 72 79 0a 3b 3b 3b 20 20 20 63 ecessary.;;; c
6e20: 6f 6d 70 61 72 69 73 6f 6e 73 2c 20 62 75 74 20 omparisons, but
6e30: 49 20 62 65 6c 69 65 76 65 20 74 68 69 73 20 6f I believe this o
6e40: 70 74 69 6d 69 7a 61 74 69 6f 6e 20 69 73 20 70 ptimization is p
6e50: 72 6f 62 61 62 6c 79 20 66 61 69 72 6c 79 0a 3b robably fairly.;
6e60: 3b 3b 20 20 20 69 6e 73 69 67 6e 69 66 69 63 61 ;; insignifica
6e70: 6e 74 2e 29 0a 3b 3b 3b 20 20 20 0a 3b 3b 3b 20 nt.).;;; .;;;
6e80: 20 20 49 66 20 74 68 65 20 6e 75 6d 62 65 72 20 If the number
6e90: 6f 66 20 76 65 63 74 6f 72 20 61 72 67 75 6d 65 of vector argume
6ea0: 6e 74 73 20 69 73 20 7a 65 72 6f 20 6f 72 20 6f nts is zero or o
6eb0: 6e 65 2c 20 74 68 65 6e 20 23 54 20 69 73 0a 3b ne, then #T is.;
6ec0: 3b 3b 20 20 20 61 75 74 6f 6d 61 74 69 63 61 6c ;; automatical
6ed0: 6c 79 20 72 65 74 75 72 6e 65 64 2e 20 20 49 66 ly returned. If
6ee0: 20 74 68 65 72 65 20 61 72 65 20 4e 20 76 65 63 there are N vec
6ef0: 74 6f 72 20 61 72 67 75 6d 65 6e 74 73 2c 0a 3b tor arguments,.;
6f00: 3b 3b 20 20 20 56 45 43 54 4f 52 5f 31 20 56 45 ;; VECTOR_1 VE
6f10: 43 54 4f 52 5f 32 20 2e 2e 2e 20 56 45 43 54 4f CTOR_2 ... VECTO
6f20: 52 5f 4e 2c 20 74 68 65 6e 20 56 45 43 54 4f 52 R_N, then VECTOR
6f30: 5f 31 20 26 20 56 45 43 54 4f 52 5f 32 20 61 72 _1 & VECTOR_2 ar
6f40: 65 0a 3b 3b 3b 20 20 20 63 6f 6d 70 61 72 65 64 e.;;; compared
6f50: 3b 20 69 66 20 74 68 65 79 20 61 72 65 20 65 71 ; if they are eq
6f60: 75 61 6c 2c 20 74 68 65 20 76 65 63 74 6f 72 73 ual, the vectors
6f70: 20 56 45 43 54 4f 52 5f 32 20 2e 2e 2e 20 56 45 VECTOR_2 ... VE
6f80: 43 54 4f 52 5f 4e 0a 3b 3b 3b 20 20 20 61 72 65 CTOR_N.;;; are
6f90: 20 63 6f 6d 70 61 72 65 64 2e 20 20 54 68 65 20 compared. The
6fa0: 70 72 65 63 69 73 65 20 6f 72 64 65 72 20 69 6e precise order in
6fb0: 20 77 68 69 63 68 20 45 4c 54 3d 3f 20 69 73 20 which ELT=? is
6fc0: 61 70 70 6c 69 65 64 20 69 73 20 6e 6f 74 0a 3b applied is not.;
6fd0: 3b 3b 20 20 20 73 70 65 63 69 66 69 65 64 2e 0a ;; specified..
6fe0: 28 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 3d (define (vector=
6ff0: 20 65 6c 74 3d 3f 20 2e 20 76 65 63 74 6f 72 73 elt=? . vectors
7000: 29 0a 20 20 28 6c 65 74 20 28 28 65 6c 74 3d 3f ). (let ((elt=?
7010: 20 28 63 68 65 63 6b 2d 74 79 70 65 20 70 72 6f (check-type pro
7020: 63 65 64 75 72 65 3f 20 65 6c 74 3d 3f 20 76 65 cedure? elt=? ve
7030: 63 74 6f 72 3d 29 29 29 0a 20 20 20 20 28 63 6f ctor=))). (co
7040: 6e 64 20 28 28 6e 75 6c 6c 3f 20 76 65 63 74 6f nd ((null? vecto
7050: 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 23 rs). #
7060: 74 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e t). ((n
7070: 75 6c 6c 3f 20 28 63 64 72 20 76 65 63 74 6f 72 ull? (cdr vector
7080: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 s)). (
7090: 63 68 65 63 6b 2d 74 79 70 65 20 76 65 63 74 6f check-type vecto
70a0: 72 3f 20 28 63 61 72 20 76 65 63 74 6f 72 73 29 r? (car vectors)
70b0: 20 76 65 63 74 6f 72 3d 29 0a 20 20 20 20 20 20 vector=).
70c0: 20 20 20 20 20 23 74 29 0a 20 20 20 20 20 20 20 #t).
70d0: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
70e0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
70f0: 76 65 63 73 20 76 65 63 74 6f 72 73 29 29 0a 20 vecs vectors)).
7100: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
7110: 20 28 28 76 65 63 31 20 28 63 68 65 63 6b 2d 74 ((vec1 (check-t
7120: 79 70 65 20 76 65 63 74 6f 72 3f 20 28 63 61 72 ype vector? (car
7130: 20 76 65 63 73 29 20 76 65 63 74 6f 72 3d 29 29 vecs) vector=))
7140: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7150: 20 20 20 20 28 76 65 63 32 2b 20 28 63 64 72 20 (vec2+ (cdr
7160: 76 65 63 73 29 29 29 0a 20 20 20 20 20 20 20 20 vecs))).
7170: 20 20 20 20 20 20 20 28 6f 72 20 28 6e 75 6c 6c (or (null
7180: 3f 20 76 65 63 32 2b 29 0a 20 20 20 20 20 20 20 ? vec2+).
7190: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
71a0: 20 28 62 69 6e 61 72 79 2d 76 65 63 74 6f 72 3d (binary-vector=
71b0: 20 65 6c 74 3d 3f 20 76 65 63 31 20 28 63 61 72 elt=? vec1 (car
71c0: 20 76 65 63 32 2b 29 29 0a 20 20 20 20 20 20 20 vec2+)).
71d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71e0: 20 28 6c 6f 6f 70 20 76 65 63 32 2b 29 29 29 29 (loop vec2+))))
71f0: 29 29 29 29 29 0a 28 64 65 66 69 6e 65 20 28 62 ))))).(define (b
7200: 69 6e 61 72 79 2d 76 65 63 74 6f 72 3d 20 65 6c inary-vector= el
7210: 74 3d 3f 20 76 65 63 74 6f 72 2d 61 20 76 65 63 t=? vector-a vec
7220: 74 6f 72 2d 62 29 0a 20 20 28 6f 72 20 28 65 71 tor-b). (or (eq
7230: 3f 20 76 65 63 74 6f 72 2d 61 20 76 65 63 74 6f ? vector-a vecto
7240: 72 2d 62 29 20 20 20 20 20 20 20 20 20 20 20 3b r-b) ;
7250: 2b 2b 2b 0a 20 20 20 20 20 20 28 6c 65 74 20 28 +++. (let (
7260: 28 6c 65 6e 67 74 68 2d 61 20 28 76 65 63 74 6f (length-a (vecto
7270: 72 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f 72 2d r-length vector-
7280: 61 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 a)).
7290: 28 6c 65 6e 67 74 68 2d 62 20 28 76 65 63 74 6f (length-b (vecto
72a0: 72 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f 72 2d r-length vector-
72b0: 62 29 29 29 0a 20 20 20 20 20 20 20 20 28 6c 65 b))). (le
72c0: 74 72 65 63 20 28 28 6c 6f 6f 70 20 28 6c 61 6d trec ((loop (lam
72d0: 62 64 61 20 28 69 29 0a 20 20 20 20 20 20 20 20 bda (i).
72e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72f0: 20 28 6f 72 20 28 3d 20 69 20 6c 65 6e 67 74 68 (or (= i length
7300: 2d 61 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 -a).
7310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7320: 20 28 61 6e 64 20 28 3c 20 69 20 6c 65 6e 67 74 (and (< i lengt
7330: 68 2d 62 29 0a 20 20 20 20 20 20 20 20 20 20 20 h-b).
7340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7350: 20 20 20 20 20 20 20 28 74 65 73 74 20 28 76 65 (test (ve
7360: 63 74 6f 72 2d 72 65 66 20 76 65 63 74 6f 72 2d ctor-ref vector-
7370: 61 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 a i).
7380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7390: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
73a0: 63 74 6f 72 2d 72 65 66 20 76 65 63 74 6f 72 2d ctor-ref vector-
73b0: 62 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 b i).
73c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 29 29 i))
73e0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
73f0: 20 20 20 20 20 28 74 65 73 74 20 28 6c 61 6d 62 (test (lamb
7400: 64 61 20 28 65 6c 74 2d 61 20 65 6c 74 2d 62 20 da (elt-a elt-b
7410: 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
7420: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
7430: 20 28 6f 72 20 28 65 71 3f 20 65 6c 74 2d 61 20 (or (eq? elt-a
7440: 65 6c 74 2d 62 29 20 3b 2b 2b 2b 0a 20 20 20 20 elt-b) ;+++.
7450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
7470: 6c 74 3d 3f 20 65 6c 74 2d 61 20 65 6c 74 2d 62 lt=? elt-a elt-b
7480: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
7490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74a0: 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 (loop (+ i 1)))
74b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 61 ))). (a
74c0: 6e 64 20 28 3d 20 6c 65 6e 67 74 68 2d 61 20 6c nd (= length-a l
74d0: 65 6e 67 74 68 2d 62 29 0a 20 20 20 20 20 20 20 ength-b).
74e0: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 30 29 (loop 0)
74f0: 29 29 29 29 29 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d ))))).....;;; --
7500: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
7510: 2d 2d 0a 3b 3b 3b 20 53 65 6c 65 63 74 6f 72 73 --.;;; Selectors
7520: 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 52 45 ..;;; (VECTOR-RE
7530: 46 20 3c 76 65 63 74 6f 72 3e 20 3c 69 6e 64 65 F <vector> <inde
7540: 78 3e 29 20 2d 3e 20 76 61 6c 75 65 0a 3b 3b 3b x>) -> value.;;;
7550: 20 20 20 5b 52 35 52 53 5d 20 52 65 74 75 72 6e [R5RS] Return
7560: 20 74 68 65 20 76 61 6c 75 65 20 74 68 61 74 20 the value that
7570: 74 68 65 20 6c 6f 63 61 74 69 6f 6e 20 69 6e 20 the location in
7580: 56 45 43 54 4f 52 20 61 74 20 49 4e 44 45 58 20 VECTOR at INDEX
7590: 69 73 0a 3b 3b 3b 20 20 20 6d 61 70 70 65 64 20 is.;;; mapped
75a0: 74 6f 20 69 6e 20 74 68 65 20 73 74 6f 72 65 2e to in the store.
75b0: 0a 28 64 65 66 69 6e 65 20 76 65 63 74 6f 72 2d .(define vector-
75c0: 72 65 66 20 76 65 63 74 6f 72 2d 72 65 66 29 0a ref vector-ref).
75d0: 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 4c 45 4e .;;; (VECTOR-LEN
75e0: 47 54 48 20 3c 76 65 63 74 6f 72 3e 29 20 2d 3e GTH <vector>) ->
75f0: 20 65 78 61 63 74 2c 20 6e 6f 6e 6e 65 67 61 74 exact, nonnegat
7600: 69 76 65 20 69 6e 74 65 67 65 72 0a 3b 3b 3b 20 ive integer.;;;
7610: 20 20 5b 52 35 52 53 5d 20 52 65 74 75 72 6e 20 [R5RS] Return
7620: 74 68 65 20 6c 65 6e 67 74 68 20 6f 66 20 56 45 the length of VE
7630: 43 54 4f 52 2e 0a 28 64 65 66 69 6e 65 20 76 65 CTOR..(define ve
7640: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 74 ctor-length vect
7650: 6f 72 2d 6c 65 6e 67 74 68 29 0a 0a 0c 0a 0a 3b or-length).....;
7660: 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ;; -------------
7670: 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 49 74 65 72 -------.;;; Iter
7680: 61 74 69 6f 6e 0a 0a 3b 3b 3b 20 28 56 45 43 54 ation..;;; (VECT
7690: 4f 52 2d 46 4f 4c 44 20 3c 6b 6f 6e 73 3e 20 3c OR-FOLD <kons> <
76a0: 69 6e 69 74 69 61 6c 2d 6b 6e 69 6c 3e 20 3c 76 initial-knil> <v
76b0: 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d 3e 20 6b ector> ...) -> k
76c0: 6e 69 6c 0a 3b 3b 3b 20 20 20 20 20 28 4b 4f 4e nil.;;; (KON
76d0: 53 20 3c 6b 6e 69 6c 3e 20 3c 65 6c 74 3e 20 2e S <knil> <elt> .
76e0: 2e 2e 29 20 2d 3e 20 6b 6e 69 6c 27 20 3b 20 4e ..) -> knil' ; N
76f0: 20 76 65 63 74 6f 72 73 20 2d 3e 20 4e 2b 31 20 vectors -> N+1
7700: 61 72 67 73 0a 3b 3b 3b 20 20 20 54 68 65 20 66 args.;;; The f
7710: 75 6e 64 61 6d 65 6e 74 61 6c 20 76 65 63 74 6f undamental vecto
7720: 72 20 69 74 65 72 61 74 6f 72 2e 20 20 4b 4f 4e r iterator. KON
7730: 53 20 69 73 20 69 74 65 72 61 74 65 64 20 6f 76 S is iterated ov
7740: 65 72 20 65 61 63 68 0a 3b 3b 3b 20 20 20 69 6e er each.;;; in
7750: 64 65 78 20 69 6e 20 61 6c 6c 20 6f 66 20 74 68 dex in all of th
7760: 65 20 76 65 63 74 6f 72 73 20 69 6e 20 70 61 72 e vectors in par
7770: 61 6c 6c 65 6c 2c 20 73 74 6f 70 70 69 6e 67 20 allel, stopping
7780: 61 74 20 74 68 65 20 65 6e 64 20 6f 66 0a 3b 3b at the end of.;;
7790: 3b 20 20 20 74 68 65 20 73 68 6f 72 74 65 73 74 ; the shortest
77a0: 3b 20 4b 4f 4e 53 20 69 73 20 61 70 70 6c 69 65 ; KONS is applie
77b0: 64 20 74 6f 20 61 6e 20 61 72 67 75 6d 65 6e 74 d to an argument
77c0: 20 6c 69 73 74 20 6f 66 20 28 6c 69 73 74 20 49 list of (list I
77d0: 0a 3b 3b 3b 20 20 20 53 54 41 54 45 20 28 76 65 .;;; STATE (ve
77e0: 63 74 6f 72 2d 72 65 66 20 56 45 43 20 49 29 20 ctor-ref VEC I)
77f0: 2e 2e 2e 29 2c 20 77 68 65 72 65 20 53 54 41 54 ...), where STAT
7800: 45 20 69 73 20 74 68 65 20 63 75 72 72 65 6e 74 E is the current
7810: 20 73 74 61 74 65 0a 3b 3b 3b 20 20 20 76 61 6c state.;;; val
7820: 75 65 20 2d 2d 20 74 68 65 20 73 74 61 74 65 20 ue -- the state
7830: 76 61 6c 75 65 20 62 65 67 69 6e 73 20 77 69 74 value begins wit
7840: 68 20 4b 4e 49 4c 20 61 6e 64 20 62 65 63 6f 6d h KNIL and becom
7850: 65 73 20 77 68 61 74 65 76 65 72 0a 3b 3b 3b 20 es whatever.;;;
7860: 20 20 4b 4f 4e 53 20 72 65 74 75 72 6e 65 64 20 KONS returned
7870: 61 74 20 74 68 65 20 72 65 73 70 65 63 74 69 76 at the respectiv
7880: 65 20 69 74 65 72 61 74 69 6f 6e 20 2d 2d 2c 20 e iteration --,
7890: 61 6e 64 20 49 20 69 73 20 74 68 65 0a 3b 3b 3b and I is the.;;;
78a0: 20 20 20 63 75 72 72 65 6e 74 20 69 6e 64 65 78 current index
78b0: 20 69 6e 20 74 68 65 20 69 74 65 72 61 74 69 6f in the iteratio
78c0: 6e 2e 20 20 54 68 65 20 69 74 65 72 61 74 69 6f n. The iteratio
78d0: 6e 20 69 73 20 73 74 72 69 63 74 6c 79 20 6c 65 n is strictly le
78e0: 66 74 2d 0a 3b 3b 3b 20 20 20 74 6f 2d 72 69 67 ft-.;;; to-rig
78f0: 68 74 2e 0a 3b 3b 3b 20 20 20 20 20 28 76 65 63 ht..;;; (vec
7900: 74 6f 72 2d 66 6f 6c 64 20 4b 4f 4e 53 20 4b 4e tor-fold KONS KN
7910: 49 4c 20 28 76 65 63 74 6f 72 20 45 5f 31 20 45 IL (vector E_1 E
7920: 5f 32 20 2e 2e 2e 20 45 5f 4e 29 29 0a 3b 3b 3b _2 ... E_N)).;;;
7930: 20 20 20 20 20 20 20 3c 3d 3e 0a 3b 3b 3b 20 20 <=>.;;;
7940: 20 20 20 28 4b 4f 4e 53 20 28 2e 2e 2e 20 28 4b (KONS (... (K
7950: 4f 4e 53 20 28 4b 4f 4e 53 20 4b 4e 49 4c 20 45 ONS (KONS KNIL E
7960: 5f 31 29 20 45 5f 32 29 20 2e 2e 2e 20 45 5f 4e _1) E_2) ... E_N
7970: 2d 31 29 20 45 5f 4e 29 0a 28 64 65 66 69 6e 65 -1) E_N).(define
7980: 20 28 76 65 63 74 6f 72 2d 66 6f 6c 64 20 6b 6f (vector-fold ko
7990: 6e 73 20 6b 6e 69 6c 20 76 65 63 20 2e 20 76 65 ns knil vec . ve
79a0: 63 74 6f 72 73 29 0a 20 20 28 6c 65 74 20 28 28 ctors). (let ((
79b0: 6b 6f 6e 73 20 28 63 68 65 63 6b 2d 74 79 70 65 kons (check-type
79c0: 20 70 72 6f 63 65 64 75 72 65 3f 20 6b 6f 6e 73 procedure? kons
79d0: 20 76 65 63 74 6f 72 2d 66 6f 6c 64 29 29 0a 20 vector-fold)).
79e0: 20 20 20 20 20 20 20 28 76 65 63 20 20 28 63 68 (vec (ch
79f0: 65 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f eck-type vector?
7a00: 20 20 20 20 76 65 63 20 20 76 65 63 74 6f 72 2d vec vector-
7a10: 66 6f 6c 64 29 29 29 0a 20 20 20 20 28 69 66 20 fold))). (if
7a20: 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 0a (null? vectors).
7a30: 20 20 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 (%vector
7a40: 2d 66 6f 6c 64 31 20 6b 6f 6e 73 20 6b 6e 69 6c -fold1 kons knil
7a50: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
7a60: 76 65 63 29 20 76 65 63 29 0a 20 20 20 20 20 20 vec) vec).
7a70: 20 20 28 25 76 65 63 74 6f 72 2d 66 6f 6c 64 32 (%vector-fold2
7a80: 2b 20 6b 6f 6e 73 20 6b 6e 69 6c 0a 20 20 20 20 + kons knil.
7a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7aa0: 20 20 20 20 28 25 73 6d 61 6c 6c 65 73 74 2d 6c (%smallest-l
7ab0: 65 6e 67 74 68 20 76 65 63 74 6f 72 73 0a 20 20 ength vectors.
7ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ae0: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
7af0: 6c 65 6e 67 74 68 20 76 65 63 29 0a 20 20 20 20 length vec).
7b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b20: 20 20 20 20 20 20 76 65 63 74 6f 72 2d 66 6f 6c vector-fol
7b30: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
7b40: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 (cons
7b50: 20 76 65 63 20 76 65 63 74 6f 72 73 29 29 29 29 vec vectors))))
7b60: 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 46 )..;;; (VECTOR-F
7b70: 4f 4c 44 2d 52 49 47 48 54 20 3c 6b 6f 6e 73 3e OLD-RIGHT <kons>
7b80: 20 3c 69 6e 69 74 69 61 6c 2d 6b 6e 69 6c 3e 20 <initial-knil>
7b90: 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d 3e <vector> ...) ->
7ba0: 20 6b 6e 69 6c 0a 3b 3b 3b 20 20 20 20 20 28 4b knil.;;; (K
7bb0: 4f 4e 53 20 3c 6b 6e 69 6c 3e 20 3c 65 6c 74 3e ONS <knil> <elt>
7bc0: 20 2e 2e 2e 29 20 2d 3e 20 6b 6e 69 6c 27 20 3b ...) -> knil' ;
7bd0: 20 4e 20 76 65 63 74 6f 72 73 20 3d 3e 20 4e 2b N vectors => N+
7be0: 31 20 61 72 67 73 0a 3b 3b 3b 20 20 20 54 68 65 1 args.;;; The
7bf0: 20 66 75 6e 64 61 6d 65 6e 74 61 6c 20 76 65 63 fundamental vec
7c00: 74 6f 72 20 72 65 63 75 72 73 6f 72 2e 20 20 49 tor recursor. I
7c10: 74 65 72 61 74 65 73 20 69 6e 20 70 61 72 61 6c terates in paral
7c20: 6c 65 6c 20 61 63 72 6f 73 73 0a 3b 3b 3b 20 20 lel across.;;;
7c30: 20 56 45 43 54 4f 52 20 2e 2e 2e 20 72 69 67 68 VECTOR ... righ
7c40: 74 20 74 6f 20 6c 65 66 74 2c 20 61 70 70 6c 79 t to left, apply
7c50: 69 6e 67 20 4b 4f 4e 53 20 74 6f 20 74 68 65 20 ing KONS to the
7c60: 65 6c 65 6d 65 6e 74 73 20 61 6e 64 20 74 68 65 elements and the
7c70: 0a 3b 3b 3b 20 20 20 63 75 72 72 65 6e 74 20 73 .;;; current s
7c80: 74 61 74 65 20 76 61 6c 75 65 3b 20 74 68 65 20 tate value; the
7c90: 73 74 61 74 65 20 76 61 6c 75 65 20 62 65 63 6f state value beco
7ca0: 6d 65 73 20 77 68 61 74 20 4b 4f 4e 53 20 72 65 mes what KONS re
7cb0: 74 75 72 6e 73 0a 3b 3b 3b 20 20 20 61 74 20 65 turns.;;; at e
7cc0: 61 63 68 20 6e 65 78 74 20 69 74 65 72 61 74 69 ach next iterati
7cd0: 6f 6e 2e 20 20 4b 4e 49 4c 20 69 73 20 74 68 65 on. KNIL is the
7ce0: 20 69 6e 69 74 69 61 6c 20 73 74 61 74 65 20 76 initial state v
7cf0: 61 6c 75 65 2e 0a 3b 3b 3b 20 20 20 20 20 28 76 alue..;;; (v
7d00: 65 63 74 6f 72 2d 66 6f 6c 64 2d 72 69 67 68 74 ector-fold-right
7d10: 20 4b 4f 4e 53 20 4b 4e 49 4c 20 28 76 65 63 74 KONS KNIL (vect
7d20: 6f 72 20 45 5f 31 20 45 5f 32 20 2e 2e 2e 20 45 or E_1 E_2 ... E
7d30: 5f 4e 29 29 0a 3b 3b 3b 20 20 20 20 20 20 20 3c _N)).;;; <
7d40: 3d 3e 0a 3b 3b 3b 20 20 20 20 20 28 4b 4f 4e 53 =>.;;; (KONS
7d50: 20 28 2e 2e 2e 20 28 4b 4f 4e 53 20 28 4b 4f 4e (... (KONS (KON
7d60: 53 20 4b 4e 49 4c 20 45 5f 4e 29 20 45 5f 4e 2d S KNIL E_N) E_N-
7d70: 31 29 20 2e 2e 2e 20 45 5f 32 29 20 45 5f 31 29 1) ... E_2) E_1)
7d80: 0a 3b 3b 3b 0a 3b 3b 3b 20 4e 6f 74 20 69 6d 70 .;;;.;;; Not imp
7d90: 6c 65 6d 65 6e 74 65 64 20 69 6e 20 74 65 72 6d lemented in term
7da0: 73 20 6f 66 20 61 20 6d 6f 72 65 20 70 72 69 6d s of a more prim
7db0: 69 74 69 76 65 20 6f 70 65 72 61 74 69 6f 6e 73 itive operations
7dc0: 20 74 68 61 74 20 6d 69 67 68 74 0a 3b 3b 3b 20 that might.;;;
7dd0: 63 61 6c 6c 65 64 20 25 56 45 43 54 4f 52 2d 46 called %VECTOR-F
7de0: 4f 4c 44 2d 52 49 47 48 54 20 64 75 65 20 74 6f OLD-RIGHT due to
7df0: 20 74 68 65 20 66 61 63 74 20 74 68 61 74 20 69 the fact that i
7e00: 74 20 77 6f 75 6c 64 6e 27 74 20 62 65 20 76 65 t wouldn't be ve
7e10: 72 79 0a 3b 3b 3b 20 75 73 65 66 75 6c 20 65 6c ry.;;; useful el
7e20: 73 65 77 68 65 72 65 2e 0a 28 64 65 66 69 6e 65 sewhere..(define
7e30: 20 76 65 63 74 6f 72 2d 66 6f 6c 64 2d 72 69 67 vector-fold-rig
7e40: 68 74 0a 20 20 28 6c 65 74 72 65 63 20 28 28 6c ht. (letrec ((l
7e50: 6f 6f 70 31 20 28 6c 61 6d 62 64 61 20 28 6b 6f oop1 (lambda (ko
7e60: 6e 73 20 6b 6e 69 6c 20 76 65 63 20 69 29 0a 20 ns knil vec i).
7e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e80: 20 20 20 28 69 66 20 28 6e 65 67 61 74 69 76 65 (if (negative
7e90: 3f 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 ? i).
7ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6b 6e 69 kni
7eb0: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l.
7ec0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 31 (loop1
7ed0: 20 6b 6f 6e 73 20 28 6b 6f 6e 73 20 69 20 6b 6e kons (kons i kn
7ee0: 69 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 il (vector-ref v
7ef0: 65 63 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 ec i)).
7f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f10: 20 20 20 20 20 20 76 65 63 0a 20 20 20 20 20 20 vec.
7f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f30: 20 20 20 20 20 20 20 20 20 28 2d 20 69 20 31 29 (- i 1)
7f40: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
7f50: 28 6c 6f 6f 70 32 2b 20 28 6c 61 6d 62 64 61 20 (loop2+ (lambda
7f60: 28 6b 6f 6e 73 20 6b 6e 69 6c 20 76 65 63 74 6f (kons knil vecto
7f70: 72 73 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 rs i).
7f80: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
7f90: 6e 65 67 61 74 69 76 65 3f 20 69 29 0a 20 20 20 negative? i).
7fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7fb0: 20 20 20 20 20 20 6b 6e 69 6c 0a 20 20 20 20 20 knil.
7fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7fd0: 20 20 20 20 28 6c 6f 6f 70 32 2b 20 6b 6f 6e 73 (loop2+ kons
7fe0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8000: 20 20 28 61 70 70 6c 79 20 6b 6f 6e 73 20 69 20 (apply kons i
8010: 6b 6e 69 6c 0a 20 20 20 20 20 20 20 20 20 20 20 knil.
8020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8030: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
8040: 63 74 6f 72 73 2d 72 65 66 20 76 65 63 74 6f 72 ctors-ref vector
8050: 73 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 s i)).
8060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8070: 20 20 20 20 20 20 20 76 65 63 74 6f 72 73 0a 20 vectors.
8080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
80a0: 28 2d 20 69 20 31 29 29 29 29 29 29 0a 20 20 20 (- i 1)))))).
80b0: 20 28 6c 61 6d 62 64 61 20 28 6b 6f 6e 73 20 6b (lambda (kons k
80c0: 6e 69 6c 20 76 65 63 20 2e 20 76 65 63 74 6f 72 nil vec . vector
80d0: 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 s). (let ((
80e0: 6b 6f 6e 73 20 28 63 68 65 63 6b 2d 74 79 70 65 kons (check-type
80f0: 20 70 72 6f 63 65 64 75 72 65 3f 20 6b 6f 6e 73 procedure? kons
8100: 20 76 65 63 74 6f 72 2d 66 6f 6c 64 2d 72 69 67 vector-fold-rig
8110: 68 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ht)).
8120: 20 28 76 65 63 20 20 28 63 68 65 63 6b 2d 74 79 (vec (check-ty
8130: 70 65 20 76 65 63 74 6f 72 3f 20 20 20 20 76 65 pe vector? ve
8140: 63 20 20 76 65 63 74 6f 72 2d 66 6f 6c 64 2d 72 c vector-fold-r
8150: 69 67 68 74 29 29 29 0a 20 20 20 20 20 20 20 20 ight))).
8160: 28 69 66 20 28 6e 75 6c 6c 3f 20 76 65 63 74 6f (if (null? vecto
8170: 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rs).
8180: 28 6c 6f 6f 70 31 20 20 6b 6f 6e 73 20 6b 6e 69 (loop1 kons kni
8190: 6c 20 76 65 63 20 28 2d 20 28 76 65 63 74 6f 72 l vec (- (vector
81a0: 2d 6c 65 6e 67 74 68 20 76 65 63 29 20 31 29 29 -length vec) 1))
81b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f . (lo
81c0: 6f 70 32 2b 20 6b 6f 6e 73 20 6b 6e 69 6c 20 28 op2+ kons knil (
81d0: 63 6f 6e 73 20 76 65 63 20 76 65 63 74 6f 72 73 cons vec vectors
81e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
81f0: 20 20 20 20 20 20 28 2d 20 28 25 73 6d 61 6c 6c (- (%small
8200: 65 73 74 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f est-length vecto
8210: 72 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 rs.
8220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8230: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec
8240: 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a tor-length vec).
8250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8270: 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d vector-
8280: 66 6f 6c 64 2d 72 69 67 68 74 29 0a 20 20 20 20 fold-right).
8290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
82a0: 20 20 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 1)))))))..;;;
82b0: 20 28 56 45 43 54 4f 52 2d 4d 41 50 20 3c 66 3e (VECTOR-MAP <f>
82c0: 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d <vector> ...) -
82d0: 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 20 20 > vector.;;;
82e0: 20 28 46 20 3c 65 6c 74 3e 20 2e 2e 2e 29 20 2d (F <elt> ...) -
82f0: 3e 20 76 61 6c 75 65 20 3b 20 4e 20 76 65 63 74 > value ; N vect
8300: 6f 72 73 20 2d 3e 20 4e 20 61 72 67 73 0a 3b 3b ors -> N args.;;
8310: 3b 20 20 20 43 6f 6e 73 74 72 75 63 74 73 20 61 ; Constructs a
8320: 20 6e 65 77 20 76 65 63 74 6f 72 20 6f 66 20 74 new vector of t
8330: 68 65 20 73 68 6f 72 74 65 73 74 20 6c 65 6e 67 he shortest leng
8340: 74 68 20 6f 66 20 74 68 65 20 76 65 63 74 6f 72 th of the vector
8350: 0a 3b 3b 3b 20 20 20 61 72 67 75 6d 65 6e 74 73 .;;; arguments
8360: 2e 20 20 45 61 63 68 20 65 6c 65 6d 65 6e 74 20 . Each element
8370: 61 74 20 69 6e 64 65 78 20 49 20 6f 66 20 74 68 at index I of th
8380: 65 20 6e 65 77 20 76 65 63 74 6f 72 20 69 73 20 e new vector is
8390: 6d 61 70 70 65 64 0a 3b 3b 3b 20 20 20 66 72 6f mapped.;;; fro
83a0: 6d 20 74 68 65 20 6f 6c 64 20 76 65 63 74 6f 72 m the old vector
83b0: 73 20 62 79 20 28 46 20 49 20 28 76 65 63 74 6f s by (F I (vecto
83c0: 72 2d 72 65 66 20 56 45 43 54 4f 52 20 49 29 20 r-ref VECTOR I)
83d0: 2e 2e 2e 29 2e 20 20 54 68 65 0a 3b 3b 3b 20 20 ...). The.;;;
83e0: 20 64 79 6e 61 6d 69 63 20 6f 72 64 65 72 20 6f dynamic order o
83f0: 66 20 61 70 70 6c 69 63 61 74 69 6f 6e 20 6f 66 f application of
8400: 20 46 20 69 73 20 75 6e 73 70 65 63 69 66 69 65 F is unspecifie
8410: 64 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 63 74 d..(define (vect
8420: 6f 72 2d 6d 61 70 20 66 20 76 65 63 20 2e 20 76 or-map f vec . v
8430: 65 63 74 6f 72 73 29 0a 20 20 28 6c 65 74 20 28 ectors). (let (
8440: 28 66 20 20 20 28 63 68 65 63 6b 2d 74 79 70 65 (f (check-type
8450: 20 70 72 6f 63 65 64 75 72 65 3f 20 66 20 20 20 procedure? f
8460: 76 65 63 74 6f 72 2d 6d 61 70 29 29 0a 20 20 20 vector-map)).
8470: 20 20 20 20 20 28 76 65 63 20 28 63 68 65 63 6b (vec (check
8480: 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 20 20 -type vector?
8490: 20 76 65 63 20 76 65 63 74 6f 72 2d 6d 61 70 29 vec vector-map)
84a0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null
84b0: 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 20 20 20 ? vectors).
84c0: 20 20 20 28 6c 65 74 20 28 28 6c 65 6e 20 28 76 (let ((len (v
84d0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 ector-length vec
84e0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 25 ))). (%
84f0: 76 65 63 74 6f 72 2d 6d 61 70 31 21 20 66 20 28 vector-map1! f (
8500: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6c 65 6e 29 make-vector len)
8510: 20 76 65 63 20 6c 65 6e 29 29 0a 20 20 20 20 20 vec len)).
8520: 20 20 20 28 6c 65 74 20 28 28 6c 65 6e 20 28 25 (let ((len (%
8530: 73 6d 61 6c 6c 65 73 74 2d 6c 65 6e 67 74 68 20 smallest-length
8540: 76 65 63 74 6f 72 73 0a 20 20 20 20 20 20 20 20 vectors.
8550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8560: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
8570: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 ctor-length vec)
8580: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
85a0: 20 20 20 20 20 20 76 65 63 74 6f 72 2d 6d 61 70 vector-map
85b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 25 ))). (%
85c0: 76 65 63 74 6f 72 2d 6d 61 70 32 2b 21 20 66 20 vector-map2+! f
85d0: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6c 65 6e (make-vector len
85e0: 29 20 28 63 6f 6e 73 20 76 65 63 20 76 65 63 74 ) (cons vec vect
85f0: 6f 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ors).
8600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c l
8610: 65 6e 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 en)))))..;;; (VE
8620: 43 54 4f 52 2d 4d 41 50 21 20 3c 66 3e 20 3c 76 CTOR-MAP! <f> <v
8630: 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d 3e 20 75 ector> ...) -> u
8640: 6e 73 70 65 63 69 66 69 65 64 0a 3b 3b 3b 20 20 nspecified.;;;
8650: 20 20 20 28 46 20 3c 65 6c 74 3e 20 2e 2e 2e 29 (F <elt> ...)
8660: 20 2d 3e 20 65 6c 65 6d 65 6e 74 27 20 3b 20 4e -> element' ; N
8670: 20 76 65 63 74 6f 72 73 20 2d 3e 20 4e 20 61 72 vectors -> N ar
8680: 67 73 0a 3b 3b 3b 20 20 20 53 69 6d 69 6c 61 72 gs.;;; Similar
8690: 20 74 6f 20 56 45 43 54 4f 52 2d 4d 41 50 2c 20 to VECTOR-MAP,
86a0: 62 75 74 20 72 61 74 68 65 72 20 74 68 61 6e 20 but rather than
86b0: 6d 61 70 70 69 6e 67 20 74 68 65 20 6e 65 77 20 mapping the new
86c0: 65 6c 65 6d 65 6e 74 73 0a 3b 3b 3b 20 20 20 69 elements.;;; i
86d0: 6e 74 6f 20 61 20 6e 65 77 20 76 65 63 74 6f 72 nto a new vector
86e0: 2c 20 74 68 65 20 6e 65 77 20 6d 61 70 70 65 64 , the new mapped
86f0: 20 65 6c 65 6d 65 6e 74 73 20 61 72 65 20 64 65 elements are de
8700: 73 74 72 75 63 74 69 76 65 6c 79 0a 3b 3b 3b 20 structively.;;;
8710: 20 20 69 6e 73 65 72 74 65 64 20 69 6e 74 6f 20 inserted into
8720: 74 68 65 20 66 69 72 73 74 20 76 65 63 74 6f 72 the first vector
8730: 2e 20 20 41 67 61 69 6e 2c 20 74 68 65 20 64 79 . Again, the dy
8740: 6e 61 6d 69 63 20 6f 72 64 65 72 20 6f 66 0a 3b namic order of.;
8750: 3b 3b 20 20 20 61 70 70 6c 69 63 61 74 69 6f 6e ;; application
8760: 20 6f 66 20 46 20 69 73 20 75 6e 73 70 65 63 69 of F is unspeci
8770: 66 69 65 64 2c 20 73 6f 20 69 74 20 69 73 20 64 fied, so it is d
8780: 61 6e 67 65 72 6f 75 73 20 66 6f 72 20 46 20 74 angerous for F t
8790: 6f 0a 3b 3b 3b 20 20 20 6d 61 6e 69 70 75 6c 61 o.;;; manipula
87a0: 74 65 20 74 68 65 20 66 69 72 73 74 20 56 45 43 te the first VEC
87b0: 54 4f 52 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 TOR..(define (ve
87c0: 63 74 6f 72 2d 6d 61 70 21 20 66 20 76 65 63 20 ctor-map! f vec
87d0: 2e 20 76 65 63 74 6f 72 73 29 0a 20 20 28 6c 65 . vectors). (le
87e0: 74 20 28 28 66 20 20 20 28 63 68 65 63 6b 2d 74 t ((f (check-t
87f0: 79 70 65 20 70 72 6f 63 65 64 75 72 65 3f 20 66 ype procedure? f
8800: 20 20 20 76 65 63 74 6f 72 2d 6d 61 70 21 29 29 vector-map!))
8810: 0a 20 20 20 20 20 20 20 20 28 76 65 63 20 28 63 . (vec (c
8820: 68 65 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 heck-type vector
8830: 3f 20 20 20 20 76 65 63 20 76 65 63 74 6f 72 2d ? vec vector-
8840: 6d 61 70 21 29 29 29 0a 20 20 20 20 28 69 66 20 map!))). (if
8850: 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 0a (null? vectors).
8860: 20 20 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 (%vector
8870: 2d 6d 61 70 31 21 20 20 66 20 76 65 63 20 76 65 -map1! f vec ve
8880: 63 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 c (vector-length
8890: 20 76 65 63 29 29 0a 20 20 20 20 20 20 20 20 28 vec)). (
88a0: 25 76 65 63 74 6f 72 2d 6d 61 70 32 2b 21 20 66 %vector-map2+! f
88b0: 20 76 65 63 20 28 63 6f 6e 73 20 76 65 63 20 76 vec (cons vec v
88c0: 65 63 74 6f 72 73 29 0a 20 20 20 20 20 20 20 20 ectors).
88d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
88e0: 28 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 6e 67 74 (%smallest-lengt
88f0: 68 20 76 65 63 74 6f 72 73 0a 20 20 20 20 20 20 h vectors.
8900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8920: 20 20 20 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 (vector-leng
8930: 74 68 20 76 65 63 29 0a 20 20 20 20 20 20 20 20 th vec).
8940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8960: 20 20 76 65 63 74 6f 72 2d 6d 61 70 21 29 29 29 vector-map!)))
8970: 0a 20 20 20 20 28 75 6e 73 70 65 63 69 66 69 65 . (unspecifie
8980: 64 2d 76 61 6c 75 65 29 29 29 0a 0a 3b 3b 3b 20 d-value)))..;;;
8990: 28 56 45 43 54 4f 52 2d 46 4f 52 2d 45 41 43 48 (VECTOR-FOR-EACH
89a0: 20 3c 66 3e 20 3c 76 65 63 74 6f 72 3e 20 2e 2e <f> <vector> ..
89b0: 2e 29 20 2d 3e 20 75 6e 73 70 65 63 69 66 69 65 .) -> unspecifie
89c0: 64 0a 3b 3b 3b 20 20 20 20 20 28 46 20 3c 65 6c d.;;; (F <el
89d0: 74 3e 20 2e 2e 2e 29 20 3b 20 4e 20 76 65 63 74 t> ...) ; N vect
89e0: 6f 72 73 20 2d 3e 20 4e 20 61 72 67 73 0a 3b 3b ors -> N args.;;
89f0: 3b 20 20 20 53 69 6d 70 6c 65 20 76 65 63 74 6f ; Simple vecto
8a00: 72 20 69 74 65 72 61 74 6f 72 3a 20 61 70 70 6c r iterator: appl
8a10: 69 65 73 20 46 20 74 6f 20 65 61 63 68 20 69 6e ies F to each in
8a20: 64 65 78 20 69 6e 20 74 68 65 20 72 61 6e 67 65 dex in the range
8a30: 20 5b 30 2c 0a 3b 3b 3b 20 20 20 4c 45 4e 47 54 [0,.;;; LENGT
8a40: 48 29 2c 20 77 68 65 72 65 20 4c 45 4e 47 54 48 H), where LENGTH
8a50: 20 69 73 20 74 68 65 20 6c 65 6e 67 74 68 20 6f is the length o
8a60: 66 20 74 68 65 20 73 6d 61 6c 6c 65 73 74 20 76 f the smallest v
8a70: 65 63 74 6f 72 0a 3b 3b 3b 20 20 20 61 72 67 75 ector.;;; argu
8a80: 6d 65 6e 74 20 70 61 73 73 65 64 2c 20 61 6e 64 ment passed, and
8a90: 20 74 68 65 20 72 65 73 70 65 63 74 69 76 65 20 the respective
8aa0: 65 6c 65 6d 65 6e 74 20 61 74 20 74 68 61 74 20 element at that
8ab0: 69 6e 64 65 78 2e 20 20 49 6e 0a 3b 3b 3b 20 20 index. In.;;;
8ac0: 20 63 6f 6e 74 72 61 73 74 20 77 69 74 68 20 56 contrast with V
8ad0: 45 43 54 4f 52 2d 4d 41 50 2c 20 46 20 69 73 20 ECTOR-MAP, F is
8ae0: 72 65 6c 69 61 62 6c 79 20 61 70 70 6c 69 65 64 reliably applied
8af0: 20 74 6f 20 65 61 63 68 0a 3b 3b 3b 20 20 20 73 to each.;;; s
8b00: 75 62 73 65 71 75 65 6e 74 20 65 6c 65 6d 65 6e ubsequent elemen
8b10: 74 73 2c 20 73 74 61 72 74 69 6e 67 20 61 74 20 ts, starting at
8b20: 69 6e 64 65 78 20 30 20 66 72 6f 6d 20 6c 65 66 index 0 from lef
8b30: 74 20 74 6f 20 72 69 67 68 74 2c 20 69 6e 0a 3b t to right, in.;
8b40: 3b 3b 20 20 20 74 68 65 20 76 65 63 74 6f 72 73 ;; the vectors
8b50: 2e 0a 28 64 65 66 69 6e 65 20 76 65 63 74 6f 72 ..(define vector
8b60: 2d 66 6f 72 2d 65 61 63 68 0a 20 20 28 6c 65 74 -for-each. (let
8b70: 72 65 63 20 28 28 66 6f 72 2d 65 61 63 68 31 0a rec ((for-each1.
8b80: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
8b90: 62 64 61 20 28 66 20 76 65 63 20 69 20 6c 65 6e bda (f vec i len
8ba0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8bb0: 28 63 6f 6e 64 20 28 28 3c 20 69 20 6c 65 6e 29 (cond ((< i len)
8bc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8bd0: 20 20 20 20 20 20 28 66 20 69 20 28 76 65 63 74 (f i (vect
8be0: 6f 72 2d 72 65 66 20 76 65 63 20 69 29 29 0a 20 or-ref vec i)).
8bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c00: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 31 20 66 (for-each1 f
8c10: 20 76 65 63 20 28 2b 20 69 20 31 29 20 6c 65 6e vec (+ i 1) len
8c20: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
8c30: 20 28 66 6f 72 2d 65 61 63 68 32 2b 0a 20 20 20 (for-each2+.
8c40: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
8c50: 20 28 66 20 76 65 63 73 20 69 20 6c 65 6e 29 0a (f vecs i len).
8c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
8c70: 6f 6e 64 20 28 28 3c 20 69 20 6c 65 6e 29 0a 20 ond ((< i len).
8c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c90: 20 20 20 20 28 61 70 70 6c 79 20 66 20 69 20 28 (apply f i (
8ca0: 76 65 63 74 6f 72 73 2d 72 65 66 20 76 65 63 73 vectors-ref vecs
8cb0: 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 i)).
8cc0: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 (for-e
8cd0: 61 63 68 32 2b 20 66 20 76 65 63 73 20 28 2b 20 ach2+ f vecs (+
8ce0: 69 20 31 29 20 6c 65 6e 29 29 29 29 29 29 0a 20 i 1) len)))))).
8cf0: 20 20 20 28 6c 61 6d 62 64 61 20 28 66 20 76 65 (lambda (f ve
8d00: 63 20 2e 20 76 65 63 74 6f 72 73 29 0a 20 20 20 c . vectors).
8d10: 20 20 20 28 6c 65 74 20 28 28 66 20 20 20 28 63 (let ((f (c
8d20: 68 65 63 6b 2d 74 79 70 65 20 70 72 6f 63 65 64 heck-type proced
8d30: 75 72 65 3f 20 66 20 20 20 76 65 63 74 6f 72 2d ure? f vector-
8d40: 66 6f 72 2d 65 61 63 68 29 29 0a 20 20 20 20 20 for-each)).
8d50: 20 20 20 20 20 20 20 28 76 65 63 20 28 63 68 65 (vec (che
8d60: 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 ck-type vector?
8d70: 20 20 20 76 65 63 20 76 65 63 74 6f 72 2d 66 6f vec vector-fo
8d80: 72 2d 65 61 63 68 29 29 29 0a 20 20 20 20 20 20 r-each))).
8d90: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 76 65 63 (if (null? vec
8da0: 74 6f 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 tors).
8db0: 20 20 28 66 6f 72 2d 65 61 63 68 31 20 66 20 76 (for-each1 f v
8dc0: 65 63 20 30 20 28 76 65 63 74 6f 72 2d 6c 65 6e ec 0 (vector-len
8dd0: 67 74 68 20 76 65 63 29 29 0a 20 20 20 20 20 20 gth vec)).
8de0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 32 (for-each2
8df0: 2b 20 66 20 28 63 6f 6e 73 20 76 65 63 20 76 65 + f (cons vec ve
8e00: 63 74 6f 72 73 29 20 30 0a 20 20 20 20 20 20 20 ctors) 0.
8e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e20: 20 28 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 6e 67 (%smallest-leng
8e30: 74 68 20 76 65 63 74 6f 72 73 0a 20 20 20 20 20 th vectors.
8e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e60: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 6c 65 6e (vector-len
8e70: 67 74 68 20 76 65 63 29 0a 20 20 20 20 20 20 20 gth vec).
8e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ea0: 20 20 20 76 65 63 74 6f 72 2d 66 6f 72 2d 65 61 vector-for-ea
8eb0: 63 68 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 ch)))))))..;;; (
8ec0: 56 45 43 54 4f 52 2d 43 4f 55 4e 54 20 3c 70 72 VECTOR-COUNT <pr
8ed0: 65 64 69 63 61 74 65 3f 3e 20 3c 76 65 63 74 6f edicate?> <vecto
8ee0: 72 3e 20 2e 2e 2e 29 0a 3b 3b 3b 20 20 20 20 20 r> ...).;;;
8ef0: 20 20 2d 3e 20 65 78 61 63 74 2c 20 6e 6f 6e 6e -> exact, nonn
8f00: 65 67 61 74 69 76 65 20 69 6e 74 65 67 65 72 0a egative integer.
8f10: 3b 3b 3b 20 20 20 20 20 28 50 52 45 44 49 43 41 ;;; (PREDICA
8f20: 54 45 3f 20 3c 69 6e 64 65 78 3e 20 3c 76 61 6c TE? <index> <val
8f30: 75 65 3e 20 2e 2e 2e 29 20 3b 20 4e 20 76 65 63 ue> ...) ; N vec
8f40: 74 6f 72 73 20 2d 3e 20 4e 2b 31 20 61 72 67 73 tors -> N+1 args
8f50: 0a 3b 3b 3b 20 20 20 50 52 45 44 49 43 41 54 45 .;;; PREDICATE
8f60: 3f 20 69 73 20 61 70 70 6c 69 65 64 20 65 6c 65 ? is applied ele
8f70: 6d 65 6e 74 2d 77 69 73 65 20 74 6f 20 74 68 65 ment-wise to the
8f80: 20 65 6c 65 6d 65 6e 74 73 20 6f 66 20 56 45 43 elements of VEC
8f90: 54 4f 52 20 2e 2e 2e 2c 0a 3b 3b 3b 20 20 20 61 TOR ...,.;;; a
8fa0: 6e 64 20 61 20 63 6f 75 6e 74 20 69 73 20 74 61 nd a count is ta
8fb0: 6c 6c 69 65 64 20 6f 66 20 74 68 65 20 6e 75 6d llied of the num
8fc0: 62 65 72 20 6f 66 20 65 6c 65 6d 65 6e 74 73 20 ber of elements
8fd0: 66 6f 72 20 77 68 69 63 68 20 61 0a 3b 3b 3b 20 for which a.;;;
8fe0: 20 20 74 72 75 65 20 76 61 6c 75 65 20 69 73 20 true value is
8ff0: 70 72 6f 64 75 63 65 64 20 62 79 20 50 52 45 44 produced by PRED
9000: 49 43 41 54 45 3f 2e 20 20 54 68 69 73 20 63 6f ICATE?. This co
9010: 75 6e 74 20 69 73 20 72 65 74 75 72 6e 65 64 2e unt is returned.
9020: 0a 28 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 .(define (vector
9030: 2d 63 6f 75 6e 74 20 70 72 65 64 3f 20 76 65 63 -count pred? vec
9040: 20 2e 20 76 65 63 74 6f 72 73 29 0a 20 20 28 6c . vectors). (l
9050: 65 74 20 28 28 70 72 65 64 3f 20 28 63 68 65 63 et ((pred? (chec
9060: 6b 2d 74 79 70 65 20 70 72 6f 63 65 64 75 72 65 k-type procedure
9070: 3f 20 70 72 65 64 3f 20 76 65 63 74 6f 72 2d 63 ? pred? vector-c
9080: 6f 75 6e 74 29 29 0a 20 20 20 20 20 20 20 20 28 ount)). (
9090: 76 65 63 20 20 20 28 63 68 65 63 6b 2d 74 79 70 vec (check-typ
90a0: 65 20 76 65 63 74 6f 72 3f 20 20 20 20 76 65 63 e vector? vec
90b0: 20 20 20 76 65 63 74 6f 72 2d 63 6f 75 6e 74 29 vector-count)
90c0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null
90d0: 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 20 20 20 ? vectors).
90e0: 20 20 20 28 25 76 65 63 74 6f 72 2d 66 6f 6c 64 (%vector-fold
90f0: 31 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 65 78 1 (lambda (index
9100: 20 63 6f 75 6e 74 20 65 6c 74 29 0a 20 20 20 20 count elt).
9110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9120: 20 20 20 20 20 28 69 66 20 28 70 72 65 64 3f 20 (if (pred?
9130: 69 6e 64 65 78 20 65 6c 74 29 0a 20 20 20 20 20 index elt).
9140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9150: 20 20 20 20 20 20 20 20 28 2b 20 63 6f 75 6e 74 (+ count
9160: 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 1).
9170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9180: 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 20 20 count)).
9190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91a0: 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
91b0: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
91c0: 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a 20 20 20 -length vec).
91d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91e0: 20 20 20 20 76 65 63 29 0a 20 20 20 20 20 20 20 vec).
91f0: 20 28 25 76 65 63 74 6f 72 2d 66 6f 6c 64 32 2b (%vector-fold2+
9200: 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 65 78 20 (lambda (index
9210: 63 6f 75 6e 74 20 2e 20 65 6c 74 73 29 0a 20 20 count . elts).
9220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9230: 20 20 20 20 20 20 20 20 28 69 66 20 28 61 70 70 (if (app
9240: 6c 79 20 70 72 65 64 3f 20 69 6e 64 65 78 20 65 ly pred? index e
9250: 6c 74 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 lts).
9260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9270: 20 20 20 28 2b 20 63 6f 75 6e 74 20 31 29 0a 20 (+ count 1).
9280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9290: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6f 75 cou
92a0: 6e 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 nt)).
92b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 30 0a 20 0.
92c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92d0: 20 20 20 20 20 20 20 28 25 73 6d 61 6c 6c 65 73 (%smalles
92e0: 74 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f 72 73 t-length vectors
92f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9310: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
9320: 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a 20 or-length vec).
9330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9350: 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d vector-
9360: 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 20 20 count).
9370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
9380: 63 6f 6e 73 20 76 65 63 20 76 65 63 74 6f 72 73 cons vec vectors
9390: 29 29 29 29 29 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d ))))).....;;; --
93a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
93b0: 2d 2d 0a 3b 3b 3b 20 53 65 61 72 63 68 69 6e 67 --.;;; Searching
93c0: 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 49 4e ..;;; (VECTOR-IN
93d0: 44 45 58 20 3c 70 72 65 64 69 63 61 74 65 3f 3e DEX <predicate?>
93e0: 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 0a 3b <vector> ...).;
93f0: 3b 3b 20 20 20 20 20 20 20 2d 3e 20 65 78 61 63 ;; -> exac
9400: 74 2c 20 6e 6f 6e 6e 65 67 61 74 69 76 65 20 69 t, nonnegative i
9410: 6e 74 65 67 65 72 20 6f 72 20 23 46 0a 3b 3b 3b nteger or #F.;;;
9420: 20 20 20 20 20 28 50 52 45 44 49 43 41 54 45 3f (PREDICATE?
9430: 20 3c 65 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 62 <elt> ...) -> b
9440: 6f 6f 6c 65 61 6e 20 3b 20 4e 20 76 65 63 74 6f oolean ; N vecto
9450: 72 73 20 2d 3e 20 4e 20 61 72 67 73 0a 3b 3b 3b rs -> N args.;;;
9460: 20 20 20 53 65 61 72 63 68 20 6c 65 66 74 2d 74 Search left-t
9470: 6f 2d 72 69 67 68 74 20 61 63 72 6f 73 73 20 56 o-right across V
9480: 45 43 54 4f 52 20 2e 2e 2e 20 69 6e 20 70 61 72 ECTOR ... in par
9490: 61 6c 6c 65 6c 2c 20 72 65 74 75 72 6e 69 6e 67 allel, returning
94a0: 20 74 68 65 0a 3b 3b 3b 20 20 20 69 6e 64 65 78 the.;;; index
94b0: 20 6f 66 20 74 68 65 20 66 69 72 73 74 20 73 65 of the first se
94c0: 74 20 6f 66 20 76 61 6c 75 65 73 20 56 41 4c 55 t of values VALU
94d0: 45 20 2e 2e 2e 20 73 75 63 68 20 74 68 61 74 20 E ... such that
94e0: 28 50 52 45 44 49 43 41 54 45 3f 0a 3b 3b 3b 20 (PREDICATE?.;;;
94f0: 20 20 56 41 4c 55 45 20 2e 2e 2e 29 20 72 65 74 VALUE ...) ret
9500: 75 72 6e 73 20 61 20 74 72 75 65 20 76 61 6c 75 urns a true valu
9510: 65 3b 20 69 66 20 6e 6f 20 73 75 63 68 20 73 65 e; if no such se
9520: 74 20 6f 66 20 65 6c 65 6d 65 6e 74 73 20 69 73 t of elements is
9530: 0a 3b 3b 3b 20 20 20 72 65 61 63 68 65 64 2c 20 .;;; reached,
9540: 72 65 74 75 72 6e 20 23 46 2e 0a 28 64 65 66 69 return #F..(defi
9550: 6e 65 20 28 76 65 63 74 6f 72 2d 69 6e 64 65 78 ne (vector-index
9560: 20 70 72 65 64 3f 20 76 65 63 20 2e 20 76 65 63 pred? vec . vec
9570: 74 6f 72 73 29 0a 20 20 28 76 65 63 74 6f 72 2d tors). (vector-
9580: 69 6e 64 65 78 2f 73 6b 69 70 20 70 72 65 64 3f index/skip pred?
9590: 20 76 65 63 20 76 65 63 74 6f 72 73 20 76 65 63 vec vectors vec
95a0: 74 6f 72 2d 69 6e 64 65 78 29 29 0a 0a 3b 3b 3b tor-index))..;;;
95b0: 20 28 56 45 43 54 4f 52 2d 53 4b 49 50 20 3c 70 (VECTOR-SKIP <p
95c0: 72 65 64 69 63 61 74 65 3f 3e 20 3c 76 65 63 74 redicate?> <vect
95d0: 6f 72 3e 20 2e 2e 2e 29 0a 3b 3b 3b 20 20 20 20 or> ...).;;;
95e0: 20 20 20 2d 3e 20 65 78 61 63 74 2c 20 6e 6f 6e -> exact, non
95f0: 6e 65 67 61 74 69 76 65 20 69 6e 74 65 67 65 72 negative integer
9600: 20 6f 72 20 23 46 0a 3b 3b 3b 20 20 20 20 20 28 or #F.;;; (
9610: 50 52 45 44 49 43 41 54 45 3f 20 3c 65 6c 74 3e PREDICATE? <elt>
9620: 20 2e 2e 2e 29 20 2d 3e 20 62 6f 6f 6c 65 61 6e ...) -> boolean
9630: 20 3b 20 4e 20 76 65 63 74 6f 72 73 20 2d 3e 20 ; N vectors ->
9640: 4e 20 61 72 67 73 0a 3b 3b 3b 20 20 20 28 76 65 N args.;;; (ve
9650: 63 74 6f 72 2d 69 6e 64 65 78 20 28 6c 61 6d 62 ctor-index (lamb
9660: 64 61 20 65 6c 74 73 20 28 6e 6f 74 20 28 61 70 da elts (not (ap
9670: 70 6c 79 20 50 52 45 44 49 43 41 54 45 3f 20 65 ply PREDICATE? e
9680: 6c 74 73 29 29 29 0a 3b 3b 3b 20 20 20 20 20 20 lts))).;;;
9690: 20 20 20 20 20 20 20 20 20 20 20 56 45 43 54 4f VECTO
96a0: 52 20 2e 2e 2e 29 0a 3b 3b 3b 20 20 20 4c 69 6b R ...).;;; Lik
96b0: 65 20 56 45 43 54 4f 52 2d 49 4e 44 45 58 2c 20 e VECTOR-INDEX,
96c0: 62 75 74 20 66 69 6e 64 20 74 68 65 20 69 6e 64 but find the ind
96d0: 65 78 20 6f 66 20 74 68 65 20 66 69 72 73 74 20 ex of the first
96e0: 73 65 74 20 6f 66 20 76 61 6c 75 65 73 0a 3b 3b set of values.;;
96f0: 3b 20 20 20 74 68 61 74 20 64 6f 20 5f 6e 6f 74 ; that do _not
9700: 5f 20 73 61 74 69 73 66 79 20 50 52 45 44 49 43 _ satisfy PREDIC
9710: 41 54 45 3f 2e 0a 28 64 65 66 69 6e 65 20 28 76 ATE?..(define (v
9720: 65 63 74 6f 72 2d 73 6b 69 70 20 70 72 65 64 3f ector-skip pred?
9730: 20 76 65 63 20 2e 20 76 65 63 74 6f 72 73 29 0a vec . vectors).
9740: 20 20 28 76 65 63 74 6f 72 2d 69 6e 64 65 78 2f (vector-index/
9750: 73 6b 69 70 20 28 6c 61 6d 62 64 61 20 65 6c 74 skip (lambda elt
9760: 73 20 28 6e 6f 74 20 28 61 70 70 6c 79 20 70 72 s (not (apply pr
9770: 65 64 3f 20 65 6c 74 73 29 29 29 0a 20 20 20 20 ed? elts))).
9780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9790: 20 76 65 63 20 76 65 63 74 6f 72 73 0a 20 20 20 vec vectors.
97a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
97b0: 20 20 76 65 63 74 6f 72 2d 73 6b 69 70 29 29 0a vector-skip)).
97c0: 0a 3b 3b 3b 20 41 75 78 69 6c 69 61 72 79 20 66 .;;; Auxiliary f
97d0: 6f 72 20 56 45 43 54 4f 52 2d 49 4e 44 45 58 20 or VECTOR-INDEX
97e0: 26 20 56 45 43 54 4f 52 2d 53 4b 49 50 0a 28 64 & VECTOR-SKIP.(d
97f0: 65 66 69 6e 65 20 76 65 63 74 6f 72 2d 69 6e 64 efine vector-ind
9800: 65 78 2f 73 6b 69 70 0a 20 20 28 6c 65 74 72 65 ex/skip. (letre
9810: 63 20 28 28 6c 6f 6f 70 31 20 20 28 6c 61 6d 62 c ((loop1 (lamb
9820: 64 61 20 28 70 72 65 64 3f 20 76 65 63 20 6c 65 da (pred? vec le
9830: 6e 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 n i).
9840: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 20 (cond
9850: 28 28 3d 20 69 20 6c 65 6e 29 20 23 66 29 0a 20 ((= i len) #f).
9860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9870: 20 20 20 20 20 20 20 20 20 20 28 28 70 72 65 64 ((pred
9880: 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 ? (vector-ref ve
9890: 63 20 69 29 29 20 69 29 0a 20 20 20 20 20 20 20 c i)) i).
98a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
98b0: 20 20 20 20 28 65 6c 73 65 20 28 6c 6f 6f 70 31 (else (loop1
98c0: 20 70 72 65 64 3f 20 76 65 63 20 6c 65 6e 20 28 pred? vec len (
98d0: 2b 20 69 20 31 29 29 29 29 29 29 0a 20 20 20 20 + i 1)))))).
98e0: 20 20 20 20 20 20 20 28 6c 6f 6f 70 32 2b 20 28 (loop2+ (
98f0: 6c 61 6d 62 64 61 20 28 70 72 65 64 3f 20 76 65 lambda (pred? ve
9900: 63 74 6f 72 73 20 6c 65 6e 20 69 29 0a 20 20 20 ctors len i).
9910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9920: 20 20 28 63 6f 6e 64 20 28 28 3d 20 69 20 6c 65 (cond ((= i le
9930: 6e 29 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 n) #f).
9940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9950: 20 20 28 28 61 70 70 6c 79 20 70 72 65 64 3f 20 ((apply pred?
9960: 28 76 65 63 74 6f 72 73 2d 72 65 66 20 76 65 63 (vectors-ref vec
9970: 74 6f 72 73 20 69 29 29 20 69 29 0a 20 20 20 20 tors i)) i).
9980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9990: 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 6c 6f (else (lo
99a0: 6f 70 32 2b 20 70 72 65 64 3f 20 76 65 63 74 6f op2+ pred? vecto
99b0: 72 73 20 6c 65 6e 0a 20 20 20 20 20 20 20 20 20 rs len.
99c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
99d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
99e0: 28 2b 20 69 20 31 29 29 29 29 29 29 29 0a 20 20 (+ i 1))))))).
99f0: 20 20 28 6c 61 6d 62 64 61 20 28 70 72 65 64 3f (lambda (pred?
9a00: 20 76 65 63 20 76 65 63 74 6f 72 73 20 63 61 6c vec vectors cal
9a10: 6c 65 65 29 0a 20 20 20 20 20 20 28 6c 65 74 20 lee). (let
9a20: 28 28 70 72 65 64 3f 20 28 63 68 65 63 6b 2d 74 ((pred? (check-t
9a30: 79 70 65 20 70 72 6f 63 65 64 75 72 65 3f 20 70 ype procedure? p
9a40: 72 65 64 3f 20 63 61 6c 6c 65 65 29 29 0a 20 20 red? callee)).
9a50: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 20 20 (vec
9a60: 20 28 63 68 65 63 6b 2d 74 79 70 65 20 76 65 63 (check-type vec
9a70: 74 6f 72 3f 20 20 20 20 76 65 63 20 20 20 63 61 tor? vec ca
9a80: 6c 6c 65 65 29 29 29 0a 20 20 20 20 20 20 20 20 llee))).
9a90: 28 69 66 20 28 6e 75 6c 6c 3f 20 76 65 63 74 6f (if (null? vecto
9aa0: 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rs).
9ab0: 28 6c 6f 6f 70 31 20 70 72 65 64 3f 20 76 65 63 (loop1 pred? vec
9ac0: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
9ad0: 76 65 63 29 20 30 29 0a 20 20 20 20 20 20 20 20 vec) 0).
9ae0: 20 20 20 20 28 6c 6f 6f 70 32 2b 20 70 72 65 64 (loop2+ pred
9af0: 3f 20 28 63 6f 6e 73 20 76 65 63 20 76 65 63 74 ? (cons vec vect
9b00: 6f 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ors).
9b10: 20 20 20 20 20 20 20 20 20 28 25 73 6d 61 6c 6c (%small
9b20: 65 73 74 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f est-length vecto
9b30: 72 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 rs.
9b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b50: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
9b60: 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a 20 20 20 -length vec).
9b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b90: 20 20 20 63 61 6c 6c 65 65 29 0a 20 20 20 20 20 callee).
9ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 30 0
9bb0: 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 ))))))..;;; (VEC
9bc0: 54 4f 52 2d 49 4e 44 45 58 2d 52 49 47 48 54 20 TOR-INDEX-RIGHT
9bd0: 3c 70 72 65 64 69 63 61 74 65 3f 3e 20 3c 76 65 <predicate?> <ve
9be0: 63 74 6f 72 3e 20 2e 2e 2e 29 0a 3b 3b 3b 20 20 ctor> ...).;;;
9bf0: 20 20 20 20 20 2d 3e 20 65 78 61 63 74 2c 20 6e -> exact, n
9c00: 6f 6e 6e 65 67 61 74 69 76 65 20 69 6e 74 65 67 onnegative integ
9c10: 65 72 20 6f 72 20 23 46 0a 3b 3b 3b 20 20 20 20 er or #F.;;;
9c20: 20 28 50 52 45 44 49 43 41 54 45 3f 20 3c 65 6c (PREDICATE? <el
9c30: 74 3e 20 2e 2e 2e 29 20 2d 3e 20 62 6f 6f 6c 65 t> ...) -> boole
9c40: 61 6e 20 3b 20 4e 20 76 65 63 74 6f 72 73 20 2d an ; N vectors -
9c50: 3e 20 4e 20 61 72 67 73 0a 3b 3b 3b 20 20 20 52 > N args.;;; R
9c60: 69 67 68 74 2d 74 6f 2d 6c 65 66 74 20 76 61 72 ight-to-left var
9c70: 69 61 6e 74 20 6f 66 20 56 45 43 54 4f 52 2d 49 iant of VECTOR-I
9c80: 4e 44 45 58 2e 0a 28 64 65 66 69 6e 65 20 28 76 NDEX..(define (v
9c90: 65 63 74 6f 72 2d 69 6e 64 65 78 2d 72 69 67 68 ector-index-righ
9ca0: 74 20 70 72 65 64 3f 20 76 65 63 20 2e 20 76 65 t pred? vec . ve
9cb0: 63 74 6f 72 73 29 0a 20 20 28 76 65 63 74 6f 72 ctors). (vector
9cc0: 2d 69 6e 64 65 78 2f 73 6b 69 70 2d 72 69 67 68 -index/skip-righ
9cd0: 74 20 70 72 65 64 3f 20 76 65 63 20 76 65 63 74 t pred? vec vect
9ce0: 6f 72 73 20 76 65 63 74 6f 72 2d 69 6e 64 65 78 ors vector-index
9cf0: 2d 72 69 67 68 74 29 29 0a 0a 3b 3b 3b 20 28 56 -right))..;;; (V
9d00: 45 43 54 4f 52 2d 53 4b 49 50 2d 52 49 47 48 54 ECTOR-SKIP-RIGHT
9d10: 20 3c 70 72 65 64 69 63 61 74 65 3f 3e 20 3c 76 <predicate?> <v
9d20: 65 63 74 6f 72 3e 20 2e 2e 2e 29 0a 3b 3b 3b 20 ector> ...).;;;
9d30: 20 20 20 20 20 20 2d 3e 20 65 78 61 63 74 2c 20 -> exact,
9d40: 6e 6f 6e 6e 65 67 61 74 69 76 65 20 69 6e 74 65 nonnegative inte
9d50: 67 65 72 20 6f 72 20 23 46 0a 3b 3b 3b 20 20 20 ger or #F.;;;
9d60: 20 20 28 50 52 45 44 49 43 41 54 45 3f 20 3c 65 (PREDICATE? <e
9d70: 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 62 6f 6f 6c lt> ...) -> bool
9d80: 65 61 6e 20 3b 20 4e 20 76 65 63 74 6f 72 73 20 ean ; N vectors
9d90: 2d 3e 20 4e 20 61 72 67 73 0a 3b 3b 3b 20 20 20 -> N args.;;;
9da0: 52 69 67 68 74 2d 74 6f 2d 6c 65 66 74 20 76 61 Right-to-left va
9db0: 72 69 61 6e 74 20 6f 66 20 56 45 43 54 4f 52 2d riant of VECTOR-
9dc0: 53 4b 49 50 2e 0a 28 64 65 66 69 6e 65 20 28 76 SKIP..(define (v
9dd0: 65 63 74 6f 72 2d 73 6b 69 70 2d 72 69 67 68 74 ector-skip-right
9de0: 20 70 72 65 64 3f 20 76 65 63 20 2e 20 76 65 63 pred? vec . vec
9df0: 74 6f 72 73 29 0a 20 20 28 76 65 63 74 6f 72 2d tors). (vector-
9e00: 69 6e 64 65 78 2f 73 6b 69 70 2d 72 69 67 68 74 index/skip-right
9e10: 20 28 6c 61 6d 62 64 61 20 65 6c 74 73 20 28 6e (lambda elts (n
9e20: 6f 74 20 28 61 70 70 6c 79 20 70 72 65 64 3f 20 ot (apply pred?
9e30: 65 6c 74 73 29 29 29 0a 20 20 20 20 20 20 20 20 elts))).
9e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9e50: 20 20 20 76 65 63 20 76 65 63 74 6f 72 73 0a 20 vec vectors.
9e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9e70: 20 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 vector
9e80: 2d 69 6e 64 65 78 2d 72 69 67 68 74 29 29 0a 0a -index-right))..
9e90: 28 64 65 66 69 6e 65 20 76 65 63 74 6f 72 2d 69 (define vector-i
9ea0: 6e 64 65 78 2f 73 6b 69 70 2d 72 69 67 68 74 0a ndex/skip-right.
9eb0: 20 20 28 6c 65 74 72 65 63 20 28 28 6c 6f 6f 70 (letrec ((loop
9ec0: 31 20 20 28 6c 61 6d 62 64 61 20 28 70 72 65 64 1 (lambda (pred
9ed0: 3f 20 76 65 63 20 69 29 0a 20 20 20 20 20 20 20 ? vec i).
9ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
9ef0: 6f 6e 64 20 28 28 6e 65 67 61 74 69 76 65 3f 20 ond ((negative?
9f00: 69 29 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 i) #f).
9f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f20: 20 20 28 28 70 72 65 64 3f 20 28 76 65 63 74 6f ((pred? (vecto
9f30: 72 2d 72 65 66 20 76 65 63 20 69 29 29 20 69 29 r-ref vec i)) i)
9f40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9f50: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
9f60: 65 20 28 6c 6f 6f 70 31 20 70 72 65 64 3f 20 76 e (loop1 pred? v
9f70: 65 63 20 28 2d 20 69 20 31 29 29 29 29 29 29 0a ec (- i 1)))))).
9f80: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
9f90: 32 2b 20 28 6c 61 6d 62 64 61 20 28 70 72 65 64 2+ (lambda (pred
9fa0: 3f 20 76 65 63 74 6f 72 73 20 69 29 0a 20 20 20 ? vectors i).
9fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9fc0: 20 20 28 63 6f 6e 64 20 28 28 6e 65 67 61 74 69 (cond ((negati
9fd0: 76 65 3f 20 69 29 20 23 66 29 0a 20 20 20 20 20 ve? i) #f).
9fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ff0: 20 20 20 20 20 20 28 28 61 70 70 6c 79 20 70 72 ((apply pr
a000: 65 64 3f 20 28 76 65 63 74 6f 72 73 2d 72 65 66 ed? (vectors-ref
a010: 20 76 65 63 74 6f 72 73 20 69 29 29 20 69 29 0a vectors i)) i).
a020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a030: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
a040: 20 28 6c 6f 6f 70 32 2b 20 70 72 65 64 3f 20 76 (loop2+ pred? v
a050: 65 63 74 6f 72 73 20 28 2d 20 69 20 31 29 29 29 ectors (- i 1)))
a060: 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 )))). (lambda
a070: 20 28 70 72 65 64 3f 20 76 65 63 20 76 65 63 74 (pred? vec vect
a080: 6f 72 73 20 63 61 6c 6c 65 65 29 0a 20 20 20 20 ors callee).
a090: 20 20 28 6c 65 74 20 28 28 70 72 65 64 3f 20 28 (let ((pred? (
a0a0: 63 68 65 63 6b 2d 74 79 70 65 20 70 72 6f 63 65 check-type proce
a0b0: 64 75 72 65 3f 20 70 72 65 64 3f 20 63 61 6c 6c dure? pred? call
a0c0: 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ee)).
a0d0: 20 28 76 65 63 20 20 20 28 63 68 65 63 6b 2d 74 (vec (check-t
a0e0: 79 70 65 20 76 65 63 74 6f 72 3f 20 20 20 20 76 ype vector? v
a0f0: 65 63 20 20 20 63 61 6c 6c 65 65 29 29 29 0a 20 ec callee))).
a100: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
a110: 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 20 20 20 ? vectors).
a120: 20 20 20 20 20 20 20 28 6c 6f 6f 70 31 20 70 72 (loop1 pr
a130: 65 64 3f 20 76 65 63 20 28 2d 20 28 76 65 63 74 ed? vec (- (vect
a140: 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 20 31 or-length vec) 1
a150: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
a160: 6c 6f 6f 70 32 2b 20 70 72 65 64 3f 20 28 63 6f loop2+ pred? (co
a170: 6e 73 20 76 65 63 20 76 65 63 74 6f 72 73 29 0a ns vec vectors).
a180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a190: 20 20 20 20 28 2d 20 28 25 73 6d 61 6c 6c 65 73 (- (%smalles
a1a0: 74 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f 72 73 t-length vectors
a1b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a1c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a1d0: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
a1e0: 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a 20 20 r-length vec).
a1f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a210: 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 0a 20 callee).
a220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a230: 20 20 20 20 20 20 31 29 29 29 29 29 29 29 0a 0a 1)))))))..
a240: 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 42 49 4e 41 ;;; (VECTOR-BINA
a250: 52 59 2d 53 45 41 52 43 48 20 3c 76 65 63 74 6f RY-SEARCH <vecto
a260: 72 3e 20 3c 76 61 6c 75 65 3e 20 3c 63 6d 70 3e r> <value> <cmp>
a270: 20 5b 3c 73 74 61 72 74 3e 20 3c 65 6e 64 3e 5d [<start> <end>]
a280: 29 0a 3b 3b 3b 20 20 20 20 20 20 20 2d 3e 20 65 ).;;; -> e
a290: 78 61 63 74 2c 20 6e 6f 6e 6e 65 67 61 74 69 76 xact, nonnegativ
a2a0: 65 20 69 6e 74 65 67 65 72 20 6f 72 20 23 46 0a e integer or #F.
a2b0: 3b 3b 3b 20 20 20 20 20 28 43 4d 50 20 3c 76 61 ;;; (CMP <va
a2c0: 6c 75 65 31 3e 20 3c 76 61 6c 75 65 32 3e 29 20 lue1> <value2>)
a2d0: 2d 3e 20 69 6e 74 65 67 65 72 0a 3b 3b 3b 20 20 -> integer.;;;
a2e0: 20 20 20 20 20 70 6f 73 69 74 69 76 65 20 2d 3e positive ->
a2f0: 20 56 41 4c 55 45 31 20 3e 20 56 41 4c 55 45 32 VALUE1 > VALUE2
a300: 0a 3b 3b 3b 20 20 20 20 20 20 20 7a 65 72 6f 20 .;;; zero
a310: 20 20 20 20 2d 3e 20 56 41 4c 55 45 31 20 3d 20 -> VALUE1 =
a320: 56 41 4c 55 45 32 0a 3b 3b 3b 20 20 20 20 20 20 VALUE2.;;;
a330: 20 6e 65 67 61 74 69 76 65 20 2d 3e 20 56 41 4c negative -> VAL
a340: 55 45 31 20 3c 20 56 41 4c 55 45 32 0a 3b 3b 3b UE1 < VALUE2.;;;
a350: 20 20 20 50 65 72 66 6f 72 6d 20 61 20 62 69 6e Perform a bin
a360: 61 72 79 20 73 65 61 72 63 68 20 74 68 72 6f 75 ary search throu
a370: 67 68 20 56 45 43 54 4f 52 20 66 6f 72 20 56 41 gh VECTOR for VA
a380: 4c 55 45 2c 20 63 6f 6d 70 61 72 69 6e 67 20 65 LUE, comparing e
a390: 61 63 68 0a 3b 3b 3b 20 20 20 65 6c 65 6d 65 6e ach.;;; elemen
a3a0: 74 20 74 6f 20 56 41 4c 55 45 20 77 69 74 68 20 t to VALUE with
a3b0: 43 4d 50 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 CMP..(define (ve
a3c0: 63 74 6f 72 2d 62 69 6e 61 72 79 2d 73 65 61 72 ctor-binary-sear
a3d0: 63 68 20 76 65 63 20 76 61 6c 75 65 20 63 6d 70 ch vec value cmp
a3e0: 20 2e 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 . maybe-start+e
a3f0: 6e 64 29 0a 20 20 28 6c 65 74 20 28 28 63 6d 70 nd). (let ((cmp
a400: 20 28 63 68 65 63 6b 2d 74 79 70 65 20 70 72 6f (check-type pro
a410: 63 65 64 75 72 65 3f 20 63 6d 70 20 76 65 63 74 cedure? cmp vect
a420: 6f 72 2d 62 69 6e 61 72 79 2d 73 65 61 72 63 68 or-binary-search
a430: 29 29 29 0a 20 20 20 20 28 6c 65 74 2d 76 65 63 ))). (let-vec
a440: 74 6f 72 2d 73 74 61 72 74 2b 65 6e 64 20 76 65 tor-start+end ve
a450: 63 74 6f 72 2d 62 69 6e 61 72 79 2d 73 65 61 72 ctor-binary-sear
a460: 63 68 20 76 65 63 20 6d 61 79 62 65 2d 73 74 61 ch vec maybe-sta
a470: 72 74 2b 65 6e 64 0a 20 20 20 20 20 20 20 20 20 rt+end.
a480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a490: 20 28 73 74 61 72 74 20 65 6e 64 29 0a 20 20 20 (start end).
a4a0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 73 (let loop ((s
a4b0: 74 61 72 74 20 73 74 61 72 74 29 20 28 65 6e 64 tart start) (end
a4c0: 20 65 6e 64 29 20 28 6a 20 23 66 29 29 0a 20 20 end) (j #f)).
a4d0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 20 28 (let ((i (
a4e0: 71 75 6f 74 69 65 6e 74 20 28 2b 20 73 74 61 72 quotient (+ star
a4f0: 74 20 65 6e 64 29 20 32 29 29 29 0a 20 20 20 20 t end) 2))).
a500: 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 3d (if (or (=
a510: 20 73 74 61 72 74 20 65 6e 64 29 20 28 61 6e 64 start end) (and
a520: 20 6a 20 28 3d 20 69 20 6a 29 29 29 0a 20 20 20 j (= i j))).
a530: 20 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 20 #f.
a540: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
a550: 20 28 28 63 6f 6d 70 61 72 69 73 6f 6e 0a 20 20 ((comparison.
a560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a570: 20 20 20 28 63 68 65 63 6b 2d 74 79 70 65 20 69 (check-type i
a580: 6e 74 65 67 65 72 3f 0a 20 20 20 20 20 20 20 20 nteger?.
a590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5a0: 20 20 20 20 20 20 20 20 20 28 63 6d 70 20 28 76 (cmp (v
a5b0: 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 69 29 ector-ref vec i)
a5c0: 20 76 61 6c 75 65 29 0a 20 20 20 20 20 20 20 20 value).
a5d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5e0: 20 20 20 20 20 20 20 20 20 60 28 2c 63 6d 70 20 `(,cmp
a5f0: 66 6f 72 20 2c 76 65 63 74 6f 72 2d 62 69 6e 61 for ,vector-bina
a600: 72 79 2d 73 65 61 72 63 68 29 29 29 29 0a 20 20 ry-search)))).
a610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
a620: 6f 6e 64 20 28 28 7a 65 72 6f 3f 20 20 20 20 20 ond ((zero?
a630: 63 6f 6d 70 61 72 69 73 6f 6e 29 20 69 29 0a 20 comparison) i).
a640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a650: 20 20 20 20 20 28 28 70 6f 73 69 74 69 76 65 3f ((positive?
a660: 20 63 6f 6d 70 61 72 69 73 6f 6e 29 20 28 6c 6f comparison) (lo
a670: 6f 70 20 73 74 61 72 74 20 69 20 69 29 29 0a 20 op start i i)).
a680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a690: 20 20 20 20 20 28 65 6c 73 65 20 20 20 20 20 20 (else
a6a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
a6b0: 6f 70 20 69 20 65 6e 64 20 69 29 29 29 29 29 29 op i end i))))))
a6c0: 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f ))))..;;; (VECTO
a6d0: 52 2d 41 4e 59 20 3c 70 72 65 64 3f 3e 20 3c 76 R-ANY <pred?> <v
a6e0: 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d 3e 20 76 ector> ...) -> v
a6f0: 61 6c 75 65 0a 3b 3b 3b 20 20 20 41 70 70 6c 79 alue.;;; Apply
a700: 20 50 52 45 44 3f 20 74 6f 20 65 61 63 68 20 70 PRED? to each p
a710: 61 72 61 6c 6c 65 6c 20 65 6c 65 6d 65 6e 74 20 arallel element
a720: 69 6e 20 65 61 63 68 20 56 45 43 54 4f 52 20 2e in each VECTOR .
a730: 2e 2e 3b 20 69 66 20 50 52 45 44 3f 0a 3b 3b 3b ..; if PRED?.;;;
a740: 20 20 20 73 68 6f 75 6c 64 20 65 76 65 72 20 72 should ever r
a750: 65 74 75 72 6e 20 61 20 74 72 75 65 20 76 61 6c eturn a true val
a760: 75 65 2c 20 69 6d 6d 65 64 69 61 74 65 6c 79 20 ue, immediately
a770: 73 74 6f 70 20 61 6e 64 20 72 65 74 75 72 6e 20 stop and return
a780: 74 68 61 74 0a 3b 3b 3b 20 20 20 76 61 6c 75 65 that.;;; value
a790: 3b 20 6f 74 68 65 72 77 69 73 65 2c 20 77 68 65 ; otherwise, whe
a7a0: 6e 20 74 68 65 20 73 68 6f 72 74 65 73 74 20 76 n the shortest v
a7b0: 65 63 74 6f 72 20 72 75 6e 73 20 6f 75 74 2c 20 ector runs out,
a7c0: 72 65 74 75 72 6e 20 23 46 2e 0a 3b 3b 3b 20 20 return #F..;;;
a7d0: 20 54 68 65 20 69 74 65 72 61 74 69 6f 6e 20 61 The iteration a
a7e0: 6e 64 20 6f 72 64 65 72 20 6f 66 20 61 70 70 6c nd order of appl
a7f0: 69 63 61 74 69 6f 6e 20 6f 66 20 50 52 45 44 3f ication of PRED?
a800: 20 61 63 72 6f 73 73 20 65 6c 65 6d 65 6e 74 73 across elements
a810: 0a 3b 3b 3b 20 20 20 69 73 20 6f 66 20 74 68 65 .;;; is of the
a820: 20 76 65 63 74 6f 72 73 20 69 73 20 73 74 72 69 vectors is stri
a830: 63 74 6c 79 20 6c 65 66 74 2d 74 6f 2d 72 69 67 ctly left-to-rig
a840: 68 74 2e 0a 28 64 65 66 69 6e 65 20 76 65 63 74 ht..(define vect
a850: 6f 72 2d 61 6e 79 0a 20 20 28 6c 65 74 72 65 63 or-any. (letrec
a860: 20 28 28 6c 6f 6f 70 31 20 28 6c 61 6d 62 64 61 ((loop1 (lambda
a870: 20 28 70 72 65 64 3f 20 76 65 63 20 69 20 6c 65 (pred? vec i le
a880: 6e 20 6c 65 6e 2d 31 29 0a 20 20 20 20 20 20 20 n len-1).
a890: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
a8a0: 64 20 28 6e 6f 74 20 28 3d 20 69 20 6c 65 6e 29 d (not (= i len)
a8b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a8c0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
a8d0: 3d 20 69 20 6c 65 6e 2d 31 29 0a 20 20 20 20 20 = i len-1).
a8e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a8f0: 20 20 20 20 20 20 20 20 28 70 72 65 64 3f 20 28 (pred? (
a900: 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 69 vector-ref vec i
a910: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
a920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a930: 28 6f 72 20 28 70 72 65 64 3f 20 28 76 65 63 74 (or (pred? (vect
a940: 6f 72 2d 72 65 66 20 76 65 63 20 69 29 29 0a 20 or-ref vec i)).
a950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a970: 28 6c 6f 6f 70 31 20 70 72 65 64 3f 20 76 65 63 (loop1 pred? vec
a980: 20 28 2b 20 69 20 31 29 0a 20 20 20 20 20 20 20 (+ i 1).
a990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9b0: 20 6c 65 6e 20 6c 65 6e 2d 31 29 29 29 29 29 29 len len-1))))))
a9c0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f . (loo
a9d0: 70 32 2b 20 28 6c 61 6d 62 64 61 20 28 70 72 65 p2+ (lambda (pre
a9e0: 64 3f 20 76 65 63 74 6f 72 73 20 69 20 6c 65 6e d? vectors i len
a9f0: 20 6c 65 6e 2d 31 29 0a 20 20 20 20 20 20 20 20 len-1).
aa00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
aa10: 64 20 28 6e 6f 74 20 28 3d 20 69 20 6c 65 6e 29 d (not (= i len)
aa20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
aa30: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
aa40: 28 3d 20 69 20 6c 65 6e 2d 31 29 0a 20 20 20 20 (= i len-1).
aa50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa60: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
aa70: 20 70 72 65 64 3f 20 28 76 65 63 74 6f 72 73 2d pred? (vectors-
aa80: 72 65 66 20 76 65 63 74 6f 72 73 20 69 29 29 0a ref vectors i)).
aa90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aaa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o
aab0: 72 20 28 61 70 70 6c 79 20 70 72 65 64 3f 20 28 r (apply pred? (
aac0: 76 65 63 74 6f 72 73 2d 72 65 66 20 76 65 63 74 vectors-ref vect
aad0: 6f 72 73 20 69 29 29 0a 20 20 20 20 20 20 20 20 ors i)).
aae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aaf0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 32 (loop2
ab00: 2b 20 70 72 65 64 3f 20 76 65 63 74 6f 72 73 20 + pred? vectors
ab10: 28 2b 20 69 20 31 29 0a 20 20 20 20 20 20 20 20 (+ i 1).
ab20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab40: 20 6c 65 6e 20 6c 65 6e 2d 31 29 29 29 29 29 29 len len-1))))))
ab50: 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 ). (lambda (p
ab60: 72 65 64 3f 20 76 65 63 20 2e 20 76 65 63 74 6f red? vec . vecto
ab70: 72 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 rs). (let (
ab80: 28 70 72 65 64 3f 20 28 63 68 65 63 6b 2d 74 79 (pred? (check-ty
ab90: 70 65 20 70 72 6f 63 65 64 75 72 65 3f 20 70 72 pe procedure? pr
aba0: 65 64 3f 20 76 65 63 74 6f 72 2d 61 6e 79 29 29 ed? vector-any))
abb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 . (ve
abc0: 63 20 20 20 28 63 68 65 63 6b 2d 74 79 70 65 20 c (check-type
abd0: 76 65 63 74 6f 72 3f 20 20 20 20 76 65 63 20 20 vector? vec
abe0: 20 76 65 63 74 6f 72 2d 61 6e 79 29 29 29 0a 20 vector-any))).
abf0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
ac00: 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 20 20 20 ? vectors).
ac10: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 (let ((le
ac20: 6e 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 n (vector-length
ac30: 20 76 65 63 29 29 29 0a 20 20 20 20 20 20 20 20 vec))).
ac40: 20 20 20 20 20 20 28 6c 6f 6f 70 31 20 70 72 65 (loop1 pre
ac50: 64 3f 20 76 65 63 20 30 20 6c 65 6e 20 28 2d 20 d? vec 0 len (-
ac60: 6c 65 6e 20 31 29 29 29 0a 20 20 20 20 20 20 20 len 1))).
ac70: 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e 20 (let ((len
ac80: 28 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 6e 67 74 (%smallest-lengt
ac90: 68 20 76 65 63 74 6f 72 73 0a 20 20 20 20 20 20 h vectors.
aca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
acb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
acc0: 20 20 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 (vector-lengt
acd0: 68 20 76 65 63 29 0a 20 20 20 20 20 20 20 20 20 h vec).
ace0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
acf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad00: 76 65 63 74 6f 72 2d 61 6e 79 29 29 29 0a 20 20 vector-any))).
ad10: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
ad20: 70 32 2b 20 70 72 65 64 3f 20 28 63 6f 6e 73 20 p2+ pred? (cons
ad30: 76 65 63 20 76 65 63 74 6f 72 73 29 20 30 20 6c vec vectors) 0 l
ad40: 65 6e 20 28 2d 20 6c 65 6e 20 31 29 29 29 29 29 en (- len 1)))))
ad50: 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 )))..;;; (VECTOR
ad60: 2d 45 56 45 52 59 20 3c 70 72 65 64 3f 3e 20 3c -EVERY <pred?> <
ad70: 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d 3e 20 vector> ...) ->
ad80: 76 61 6c 75 65 0a 3b 3b 3b 20 20 20 41 70 70 6c value.;;; Appl
ad90: 79 20 50 52 45 44 3f 20 74 6f 20 65 61 63 68 20 y PRED? to each
ada0: 70 61 72 61 6c 6c 65 6c 20 76 61 6c 75 65 20 69 parallel value i
adb0: 6e 20 65 61 63 68 20 56 45 43 54 4f 52 20 2e 2e n each VECTOR ..
adc0: 2e 3b 20 69 66 20 50 52 45 44 3f 0a 3b 3b 3b 20 .; if PRED?.;;;
add0: 20 20 73 68 6f 75 6c 64 20 65 76 65 72 20 72 65 should ever re
ade0: 74 75 72 6e 20 23 46 2c 20 69 6d 6d 65 64 69 61 turn #F, immedia
adf0: 74 65 6c 79 20 73 74 6f 70 20 61 6e 64 20 72 65 tely stop and re
ae00: 74 75 72 6e 20 23 46 3b 20 6f 74 68 65 72 77 69 turn #F; otherwi
ae10: 73 65 2c 0a 3b 3b 3b 20 20 20 69 66 20 50 52 45 se,.;;; if PRE
ae20: 44 3f 20 73 68 6f 75 6c 64 20 72 65 74 75 72 6e D? should return
ae30: 20 61 20 74 72 75 65 20 76 61 6c 75 65 20 66 6f a true value fo
ae40: 72 20 65 61 63 68 20 65 6c 65 6d 65 6e 74 2c 20 r each element,
ae50: 73 74 6f 70 70 69 6e 67 20 61 74 0a 3b 3b 3b 20 stopping at.;;;
ae60: 20 20 74 68 65 20 65 6e 64 20 6f 66 20 74 68 65 the end of the
ae70: 20 73 68 6f 72 74 65 73 74 20 76 65 63 74 6f 72 shortest vector
ae80: 2c 20 72 65 74 75 72 6e 20 74 68 65 20 6c 61 73 , return the las
ae90: 74 20 76 61 6c 75 65 20 74 68 61 74 20 50 52 45 t value that PRE
aea0: 44 3f 0a 3b 3b 3b 20 20 20 72 65 74 75 72 6e 65 D?.;;; returne
aeb0: 64 2e 20 20 49 6e 20 74 68 65 20 63 61 73 65 20 d. In the case
aec0: 74 68 61 74 20 74 68 65 72 65 20 69 73 20 61 6e that there is an
aed0: 20 65 6d 70 74 79 20 76 65 63 74 6f 72 2c 20 72 empty vector, r
aee0: 65 74 75 72 6e 20 23 54 2e 0a 3b 3b 3b 20 20 20 eturn #T..;;;
aef0: 54 68 65 20 69 74 65 72 61 74 69 6f 6e 20 61 6e The iteration an
af00: 64 20 6f 72 64 65 72 20 6f 66 20 61 70 70 6c 69 d order of appli
af10: 63 61 74 69 6f 6e 20 6f 66 20 50 52 45 44 3f 20 cation of PRED?
af20: 61 63 72 6f 73 73 20 65 6c 65 6d 65 6e 74 73 0a across elements.
af30: 3b 3b 3b 20 20 20 69 73 20 6f 66 20 74 68 65 20 ;;; is of the
af40: 76 65 63 74 6f 72 73 20 69 73 20 73 74 72 69 63 vectors is stric
af50: 74 6c 79 20 6c 65 66 74 2d 74 6f 2d 72 69 67 68 tly left-to-righ
af60: 74 2e 0a 28 64 65 66 69 6e 65 20 76 65 63 74 6f t..(define vecto
af70: 72 2d 65 76 65 72 79 0a 20 20 28 6c 65 74 72 65 r-every. (letre
af80: 63 20 28 28 6c 6f 6f 70 31 20 28 6c 61 6d 62 64 c ((loop1 (lambd
af90: 61 20 28 70 72 65 64 3f 20 76 65 63 20 69 20 6c a (pred? vec i l
afa0: 65 6e 20 6c 65 6e 2d 31 29 0a 20 20 20 20 20 20 en len-1).
afb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o
afc0: 72 20 28 3d 20 69 20 6c 65 6e 29 0a 20 20 20 20 r (= i len).
afd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
afe0: 20 20 20 20 28 69 66 20 28 3d 20 69 20 6c 65 6e (if (= i len
aff0: 2d 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 -1).
b000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b010: 28 70 72 65 64 3f 20 28 76 65 63 74 6f 72 2d 72 (pred? (vector-r
b020: 65 66 20 76 65 63 20 69 29 29 0a 20 20 20 20 20 ef vec i)).
b030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b040: 20 20 20 20 20 20 20 28 61 6e 64 20 28 70 72 65 (and (pre
b050: 64 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 d? (vector-ref v
b060: 65 63 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 ec i)).
b070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b080: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 31 20 70 (loop1 p
b090: 72 65 64 3f 20 76 65 63 20 28 2b 20 69 20 31 29 red? vec (+ i 1)
b0a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b0b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0c0: 20 20 20 20 20 20 20 20 20 6c 65 6e 20 6c 65 6e len len
b0d0: 2d 31 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 -1)))))).
b0e0: 20 20 20 20 28 6c 6f 6f 70 32 2b 20 28 6c 61 6d (loop2+ (lam
b0f0: 62 64 61 20 28 70 72 65 64 3f 20 76 65 63 74 6f bda (pred? vecto
b100: 72 73 20 69 20 6c 65 6e 20 6c 65 6e 2d 31 29 0a rs i len len-1).
b110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b120: 20 20 20 20 20 28 6f 72 20 28 3d 20 69 20 6c 65 (or (= i le
b130: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
b140: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
b150: 28 3d 20 69 20 6c 65 6e 2d 31 29 0a 20 20 20 20 (= i len-1).
b160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b170: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
b180: 70 72 65 64 3f 20 28 76 65 63 74 6f 72 73 2d 72 pred? (vectors-r
b190: 65 66 20 76 65 63 74 6f 72 73 20 69 29 29 0a 20 ef vectors i)).
b1a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b1b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
b1c0: 20 28 61 70 70 6c 79 20 70 72 65 64 3f 20 28 76 (apply pred? (v
b1d0: 65 63 74 6f 72 73 2d 72 65 66 20 76 65 63 74 6f ectors-ref vecto
b1e0: 72 73 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 rs i)).
b1f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b200: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 32 2b (loop2+
b210: 20 70 72 65 64 3f 20 76 65 63 74 6f 72 73 20 28 pred? vectors (
b220: 2b 20 69 20 31 29 0a 20 20 20 20 20 20 20 20 20 + i 1).
b230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b250: 20 6c 65 6e 20 6c 65 6e 2d 31 29 29 29 29 29 29 len len-1))))))
b260: 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 ). (lambda (p
b270: 72 65 64 3f 20 76 65 63 20 2e 20 76 65 63 74 6f red? vec . vecto
b280: 72 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 rs). (let (
b290: 28 70 72 65 64 3f 20 28 63 68 65 63 6b 2d 74 79 (pred? (check-ty
b2a0: 70 65 20 70 72 6f 63 65 64 75 72 65 3f 20 70 72 pe procedure? pr
b2b0: 65 64 3f 20 76 65 63 74 6f 72 2d 65 76 65 72 79 ed? vector-every
b2c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
b2d0: 76 65 63 20 20 20 28 63 68 65 63 6b 2d 74 79 70 vec (check-typ
b2e0: 65 20 76 65 63 74 6f 72 3f 20 20 20 20 76 65 63 e vector? vec
b2f0: 20 20 20 76 65 63 74 6f 72 2d 65 76 65 72 79 29 vector-every)
b300: 29 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 )). (if (
b310: 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 0a 20 null? vectors).
b320: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
b330: 28 28 6c 65 6e 20 28 76 65 63 74 6f 72 2d 6c 65 ((len (vector-le
b340: 6e 67 74 68 20 76 65 63 29 29 29 0a 20 20 20 20 ngth vec))).
b350: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 31 (loop1
b360: 20 70 72 65 64 3f 20 76 65 63 20 30 20 6c 65 6e pred? vec 0 len
b370: 20 28 2d 20 6c 65 6e 20 31 29 29 29 0a 20 20 20 (- len 1))).
b380: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
b390: 6c 65 6e 20 28 25 73 6d 61 6c 6c 65 73 74 2d 6c len (%smallest-l
b3a0: 65 6e 67 74 68 20 76 65 63 74 6f 72 73 0a 20 20 ength vectors.
b3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3d0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 6c (vector-l
b3e0: 65 6e 67 74 68 20 76 65 63 29 0a 20 20 20 20 20 ength vec).
b3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b410: 20 20 20 20 76 65 63 74 6f 72 2d 65 76 65 72 79 vector-every
b420: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
b430: 20 20 28 6c 6f 6f 70 32 2b 20 70 72 65 64 3f 20 (loop2+ pred?
b440: 28 63 6f 6e 73 20 76 65 63 20 76 65 63 74 6f 72 (cons vec vector
b450: 73 29 20 30 20 6c 65 6e 20 28 2d 20 6c 65 6e 20 s) 0 len (- len
b460: 31 29 29 29 29 29 29 29 29 0a 0a 0c 0a 0a 3b 3b 1)))))))).....;;
b470: 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ; --------------
b480: 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 4d 75 74 61 74 ------.;;; Mutat
b490: 6f 72 73 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 ors..;;; (VECTOR
b4a0: 2d 53 45 54 21 20 3c 76 65 63 74 6f 72 3e 20 3c -SET! <vector> <
b4b0: 69 6e 64 65 78 3e 20 3c 76 61 6c 75 65 3e 29 20 index> <value>)
b4c0: 2d 3e 20 75 6e 73 70 65 63 69 66 69 65 64 0a 3b -> unspecified.;
b4d0: 3b 3b 20 20 20 5b 52 35 52 53 5d 20 41 73 73 69 ;; [R5RS] Assi
b4e0: 67 6e 20 74 68 65 20 6c 6f 63 61 74 69 6f 6e 20 gn the location
b4f0: 61 74 20 49 4e 44 45 58 20 69 6e 20 56 45 43 54 at INDEX in VECT
b500: 4f 52 20 74 6f 20 56 41 4c 55 45 2e 0a 28 64 65 OR to VALUE..(de
b510: 66 69 6e 65 20 76 65 63 74 6f 72 2d 73 65 74 21 fine vector-set!
b520: 20 76 65 63 74 6f 72 2d 73 65 74 21 29 0a 0a 3b vector-set!)..;
b530: 3b 3b 20 28 56 45 43 54 4f 52 2d 53 57 41 50 21 ;; (VECTOR-SWAP!
b540: 20 3c 76 65 63 74 6f 72 3e 20 3c 69 6e 64 65 78 <vector> <index
b550: 31 3e 20 3c 69 6e 64 65 78 32 3e 29 20 2d 3e 20 1> <index2>) ->
b560: 75 6e 73 70 65 63 69 66 69 65 64 0a 3b 3b 3b 20 unspecified.;;;
b570: 20 20 53 77 61 70 20 74 68 65 20 76 61 6c 75 65 Swap the value
b580: 73 20 69 6e 20 74 68 65 20 6c 6f 63 61 74 69 6f s in the locatio
b590: 6e 73 20 61 74 20 49 4e 44 45 58 31 20 61 6e 64 ns at INDEX1 and
b5a0: 20 49 4e 44 45 58 32 2e 0a 28 64 65 66 69 6e 65 INDEX2..(define
b5b0: 20 28 76 65 63 74 6f 72 2d 73 77 61 70 21 20 76 (vector-swap! v
b5c0: 65 63 20 69 20 6a 29 0a 20 20 28 6c 65 74 20 28 ec i j). (let (
b5d0: 28 76 65 63 20 28 63 68 65 63 6b 2d 74 79 70 65 (vec (check-type
b5e0: 20 76 65 63 74 6f 72 3f 20 76 65 63 20 76 65 63 vector? vec vec
b5f0: 74 6f 72 2d 73 77 61 70 21 29 29 29 0a 20 20 20 tor-swap!))).
b600: 20 28 6c 65 74 20 28 28 69 20 28 63 68 65 63 6b (let ((i (check
b610: 2d 69 6e 64 65 78 20 76 65 63 20 69 20 76 65 63 -index vec i vec
b620: 74 6f 72 2d 73 77 61 70 21 29 29 0a 20 20 20 20 tor-swap!)).
b630: 20 20 20 20 20 20 28 6a 20 28 63 68 65 63 6b 2d (j (check-
b640: 69 6e 64 65 78 20 76 65 63 20 6a 20 76 65 63 74 index vec j vect
b650: 6f 72 2d 73 77 61 70 21 29 29 29 0a 20 20 20 20 or-swap!))).
b660: 20 20 28 6c 65 74 20 28 28 78 20 28 76 65 63 74 (let ((x (vect
b670: 6f 72 2d 72 65 66 20 76 65 63 20 69 29 29 29 0a or-ref vec i))).
b680: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
b690: 73 65 74 21 20 76 65 63 20 69 20 28 76 65 63 74 set! vec i (vect
b6a0: 6f 72 2d 72 65 66 20 76 65 63 20 6a 29 29 0a 20 or-ref vec j)).
b6b0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 (vector-s
b6c0: 65 74 21 20 76 65 63 20 6a 20 78 29 29 29 29 29 et! vec j x)))))
b6d0: 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 46 49 ..;;; (VECTOR-FI
b6e0: 4c 4c 21 20 3c 76 65 63 74 6f 72 3e 20 3c 76 61 LL! <vector> <va
b6f0: 6c 75 65 3e 20 5b 3c 73 74 61 72 74 3e 20 3c 65 lue> [<start> <e
b700: 6e 64 3e 5d 29 20 2d 3e 20 75 6e 73 70 65 63 69 nd>]) -> unspeci
b710: 66 69 65 64 0a 3b 3b 3b 20 20 20 5b 52 35 52 53 fied.;;; [R5RS
b720: 2b 5d 20 46 69 6c 6c 20 74 68 65 20 6c 6f 63 61 +] Fill the loca
b730: 74 69 6f 6e 73 20 69 6e 20 56 45 43 54 4f 52 20 tions in VECTOR
b740: 62 65 74 77 65 65 6e 20 53 54 41 52 54 2c 20 77 between START, w
b750: 68 6f 73 65 20 64 65 66 61 75 6c 74 0a 3b 3b 3b hose default.;;;
b760: 20 20 20 69 73 20 30 2c 20 61 6e 64 20 45 4e 44 is 0, and END
b770: 2c 20 77 68 6f 73 65 20 64 65 66 61 75 6c 74 20 , whose default
b780: 69 73 20 74 68 65 20 6c 65 6e 67 74 68 20 6f 66 is the length of
b790: 20 56 45 43 54 4f 52 2c 20 77 69 74 68 20 56 41 VECTOR, with VA
b7a0: 4c 55 45 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 54 68 69 LUE..;;;.;;; Thi
b7b0: 73 20 6f 6e 65 20 63 61 6e 20 70 72 6f 62 61 62 s one can probab
b7c0: 6c 79 20 62 65 20 6d 61 64 65 20 72 65 61 6c 6c ly be made reall
b7d0: 79 20 66 61 73 74 20 6e 61 74 69 76 65 6c 79 2e y fast natively.
b7e0: 0a 28 64 65 66 69 6e 65 20 76 65 63 74 6f 72 2d .(define vector-
b7f0: 66 69 6c 6c 21 0a 20 20 28 6c 65 74 20 28 28 25 fill!. (let ((%
b800: 76 65 63 74 6f 72 2d 66 69 6c 6c 21 20 76 65 63 vector-fill! vec
b810: 74 6f 72 2d 66 69 6c 6c 21 29 29 20 20 20 3b 20 tor-fill!)) ;
b820: 54 61 6b 65 20 74 68 65 20 6e 61 74 69 76 65 20 Take the native
b830: 6f 6e 65 2c 20 75 6e 64 65 72 0a 20 20 20 20 20 one, under.
b840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b860: 20 20 20 3b 20 20 20 74 68 65 20 61 73 73 75 6d ; the assum
b870: 70 74 69 6f 6e 20 74 68 61 74 20 69 74 27 73 0a ption that it's.
b880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8a0: 20 20 20 20 20 20 20 20 3b 20 20 20 66 61 73 74 ; fast
b8b0: 65 72 2c 20 73 6f 20 77 65 20 63 61 6e 20 75 73 er, so we can us
b8c0: 65 20 69 74 20 69 66 0a 20 20 20 20 20 20 20 20 e it if.
b8d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8f0: 3b 20 20 20 74 68 65 72 65 20 61 72 65 20 6e 6f ; there are no
b900: 20 6f 70 74 69 6f 6e 61 6c 0a 20 20 20 20 20 20 optional.
b910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b930: 20 20 3b 20 20 20 61 72 67 75 6d 65 6e 74 73 2e ; arguments.
b940: 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 65 . (lambda (ve
b950: 63 20 76 61 6c 75 65 20 2e 20 6d 61 79 62 65 2d c value . maybe-
b960: 73 74 61 72 74 2b 65 6e 64 29 0a 20 20 20 20 20 start+end).
b970: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 79 62 (if (null? mayb
b980: 65 2d 73 74 61 72 74 2b 65 6e 64 29 0a 20 20 20 e-start+end).
b990: 20 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 2d (%vector-
b9a0: 66 69 6c 6c 21 20 76 65 63 20 76 61 6c 75 65 29 fill! vec value)
b9b0: 20 20 20 20 20 3b 2b 2b 2b 0a 20 20 20 20 20 20 ;+++.
b9c0: 20 20 20 20 28 6c 65 74 2d 76 65 63 74 6f 72 2d (let-vector-
b9d0: 73 74 61 72 74 2b 65 6e 64 20 76 65 63 74 6f 72 start+end vector
b9e0: 2d 66 69 6c 6c 21 20 76 65 63 20 6d 61 79 62 65 -fill! vec maybe
b9f0: 2d 73 74 61 72 74 2b 65 6e 64 0a 20 20 20 20 20 -start+end.
ba00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba10: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 72 (star
ba20: 74 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 t end).
ba30: 20 20 20 28 64 6f 20 28 28 69 20 73 74 61 72 74 (do ((i start
ba40: 20 28 2b 20 69 20 31 29 29 29 0a 20 20 20 20 20 (+ i 1))).
ba50: 20 20 20 20 20 20 20 20 20 20 20 28 28 3d 20 69 ((= i
ba60: 20 65 6e 64 29 29 0a 20 20 20 20 20 20 20 20 20 end)).
ba70: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
ba80: 21 20 76 65 63 20 69 20 76 61 6c 75 65 29 29 29 ! vec i value)))
ba90: 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f ))))..;;; (VECTO
baa0: 52 2d 43 4f 50 59 21 20 3c 74 61 72 67 65 74 3e R-COPY! <target>
bab0: 20 3c 74 73 74 61 72 74 3e 20 3c 73 6f 75 72 63 <tstart> <sourc
bac0: 65 3e 20 5b 3c 73 73 74 61 72 74 3e 20 3c 73 65 e> [<sstart> <se
bad0: 6e 64 3e 5d 29 0a 3b 3b 3b 20 20 20 20 20 20 20 nd>]).;;;
bae0: 2d 3e 20 75 6e 73 70 65 63 69 66 69 65 64 0a 3b -> unspecified.;
baf0: 3b 3b 20 20 20 43 6f 70 79 20 74 68 65 20 76 61 ;; Copy the va
bb00: 6c 75 65 73 20 69 6e 20 74 68 65 20 6c 6f 63 61 lues in the loca
bb10: 74 69 6f 6e 73 20 69 6e 20 5b 53 53 54 41 52 54 tions in [SSTART
bb20: 2c 53 45 4e 44 29 20 66 72 6f 6d 20 53 4f 55 52 ,SEND) from SOUR
bb30: 43 45 20 74 6f 0a 3b 3b 3b 20 20 20 74 6f 20 54 CE to.;;; to T
bb40: 41 52 47 45 54 2c 20 73 74 61 72 74 69 6e 67 20 ARGET, starting
bb50: 61 74 20 54 53 54 41 52 54 20 69 6e 20 54 41 52 at TSTART in TAR
bb60: 47 45 54 2e 0a 3b 3b 3b 20 5b 77 64 63 5d 20 43 GET..;;; [wdc] C
bb70: 6f 72 72 65 63 74 65 64 20 74 6f 20 61 6c 6c 6f orrected to allo
bb80: 77 20 30 20 3c 3d 20 73 73 74 61 72 74 20 3c 3d w 0 <= sstart <=
bb90: 20 73 65 6e 64 20 3c 3d 20 28 76 65 63 74 6f 72 send <= (vector
bba0: 2d 6c 65 6e 67 74 68 20 73 6f 75 72 63 65 29 2e -length source).
bbb0: 0a 28 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 .(define (vector
bbc0: 2d 63 6f 70 79 21 20 74 61 72 67 65 74 20 74 73 -copy! target ts
bbd0: 74 61 72 74 20 73 6f 75 72 63 65 20 2e 20 6d 61 tart source . ma
bbe0: 79 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 ybe-sstart+send)
bbf0: 0a 20 20 28 64 65 66 69 6e 65 20 28 64 6f 69 74 . (define (doit
bc00: 21 20 73 73 74 61 72 74 20 73 65 6e 64 20 73 6f ! sstart send so
bc10: 75 72 63 65 2d 6c 65 6e 67 74 68 29 0a 20 20 20 urce-length).
bc20: 20 28 6c 65 74 20 28 28 74 73 74 61 72 74 20 28 (let ((tstart (
bc30: 63 68 65 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 check-type nonne
bc40: 67 2d 69 6e 74 3f 20 74 73 74 61 72 74 20 76 65 g-int? tstart ve
bc50: 63 74 6f 72 2d 63 6f 70 79 21 29 29 0a 20 20 20 ctor-copy!)).
bc60: 20 20 20 20 20 20 20 28 73 73 74 61 72 74 20 28 (sstart (
bc70: 63 68 65 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 check-type nonne
bc80: 67 2d 69 6e 74 3f 20 73 73 74 61 72 74 20 76 65 g-int? sstart ve
bc90: 63 74 6f 72 2d 63 6f 70 79 21 29 29 0a 20 20 20 ctor-copy!)).
bca0: 20 20 20 20 20 20 20 28 73 65 6e 64 20 20 20 28 (send (
bcb0: 63 68 65 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 check-type nonne
bcc0: 67 2d 69 6e 74 3f 20 73 65 6e 64 20 76 65 63 74 g-int? send vect
bcd0: 6f 72 2d 63 6f 70 79 21 29 29 29 0a 20 20 20 20 or-copy!))).
bce0: 20 20 28 63 6f 6e 64 20 28 28 61 6e 64 20 28 3c (cond ((and (<
bcf0: 3d 20 30 20 73 73 74 61 72 74 20 73 65 6e 64 20 = 0 sstart send
bd00: 73 6f 75 72 63 65 2d 6c 65 6e 67 74 68 29 0a 20 source-length).
bd10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd20: 20 28 3c 3d 20 28 2b 20 74 73 74 61 72 74 20 28 (<= (+ tstart (
bd30: 2d 20 73 65 6e 64 20 73 73 74 61 72 74 29 29 20 - send sstart))
bd40: 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 74 (vector-length t
bd50: 61 72 67 65 74 29 29 29 0a 20 20 20 20 20 20 20 arget))).
bd60: 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 2d 63 (%vector-c
bd70: 6f 70 79 21 20 74 61 72 67 65 74 20 74 73 74 61 opy! target tsta
bd80: 72 74 20 73 6f 75 72 63 65 20 73 73 74 61 72 74 rt source sstart
bd90: 20 73 65 6e 64 29 29 0a 20 20 20 20 20 20 20 20 send)).
bda0: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
bdb0: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 69 (error "i
bdc0: 6c 6c 65 67 61 6c 20 61 72 67 75 6d 65 6e 74 73 llegal arguments
bdd0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
bde0: 20 20 20 20 20 20 60 28 77 68 69 6c 65 20 63 61 `(while ca
bdf0: 6c 6c 69 6e 67 20 2c 76 65 63 74 6f 72 2d 63 6f lling ,vector-co
be00: 70 79 21 29 0a 20 20 20 20 20 20 20 20 20 20 20 py!).
be10: 20 20 20 20 20 20 20 20 20 60 28 74 61 72 67 65 `(targe
be20: 74 20 77 61 73 20 2c 74 61 72 67 65 74 29 0a 20 t was ,target).
be30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be40: 20 20 20 60 28 74 61 72 67 65 74 2d 6c 65 6e 67 `(target-leng
be50: 74 68 20 77 61 73 20 2c 28 76 65 63 74 6f 72 2d th was ,(vector-
be60: 6c 65 6e 67 74 68 20 74 61 72 67 65 74 29 29 0a length target)).
be70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be80: 20 20 20 20 60 28 74 73 74 61 72 74 20 77 61 73 `(tstart was
be90: 20 2c 74 73 74 61 72 74 29 0a 20 20 20 20 20 20 ,tstart).
bea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
beb0: 73 6f 75 72 63 65 20 77 61 73 20 2c 73 6f 75 72 source was ,sour
bec0: 63 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ce).
bed0: 20 20 20 20 20 20 20 20 60 28 73 6f 75 72 63 65 `(source
bee0: 2d 6c 65 6e 67 74 68 20 77 61 73 20 2c 73 6f 75 -length was ,sou
bef0: 72 63 65 2d 6c 65 6e 67 74 68 29 0a 20 20 20 20 rce-length).
bf00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf10: 60 28 73 73 74 61 72 74 20 77 61 73 20 2c 73 73 `(sstart was ,ss
bf20: 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 tart).
bf30: 20 20 20 20 20 20 20 20 20 20 60 28 73 65 6e 64 `(send
bf40: 20 20 20 77 61 73 20 2c 73 65 6e 64 29 29 29 29 was ,send))))
bf50: 29 29 0a 20 20 28 6c 65 74 20 28 28 6e 20 28 76 )). (let ((n (v
bf60: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 73 6f 75 ector-length sou
bf70: 72 63 65 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 rce))). (cond
bf80: 20 28 28 6e 75 6c 6c 3f 20 6d 61 79 62 65 2d 73 ((null? maybe-s
bf90: 73 74 61 72 74 2b 73 65 6e 64 29 0a 20 20 20 20 start+send).
bfa0: 20 20 20 20 20 20 20 28 64 6f 69 74 21 20 30 20 (doit! 0
bfb0: 6e 20 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 n n)).
bfc0: 28 28 6e 75 6c 6c 3f 20 28 63 64 72 20 6d 61 79 ((null? (cdr may
bfd0: 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 29 be-sstart+send))
bfe0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 6f 69 . (doi
bff0: 74 21 20 28 63 61 72 20 6d 61 79 62 65 2d 73 73 t! (car maybe-ss
c000: 74 61 72 74 2b 73 65 6e 64 29 20 6e 20 6e 29 29 tart+send) n n))
c010: 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c . ((nul
c020: 6c 3f 20 28 63 64 64 72 20 6d 61 79 62 65 2d 73 l? (cddr maybe-s
c030: 73 74 61 72 74 2b 73 65 6e 64 29 29 0a 20 20 20 start+send)).
c040: 20 20 20 20 20 20 20 20 28 64 6f 69 74 21 20 28 (doit! (
c050: 63 61 72 20 6d 61 79 62 65 2d 73 73 74 61 72 74 car maybe-sstart
c060: 2b 73 65 6e 64 29 20 28 63 61 64 72 20 6d 61 79 +send) (cadr may
c070: 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 20 be-sstart+send)
c080: 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 n)). (e
c090: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 lse. (
c0a0: 65 72 72 6f 72 20 22 74 6f 6f 20 6d 61 6e 79 20 error "too many
c0b0: 61 72 67 75 6d 65 6e 74 73 22 0a 20 20 20 20 20 arguments".
c0c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 65 63 vec
c0d0: 74 6f 72 2d 63 6f 70 79 21 0a 20 20 20 20 20 20 tor-copy!.
c0e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 64 (cdd
c0f0: 72 20 6d 61 79 62 65 2d 73 73 74 61 72 74 2b 73 r maybe-sstart+s
c100: 65 6e 64 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 end))))))..;;; (
c110: 56 45 43 54 4f 52 2d 52 45 56 45 52 53 45 2d 43 VECTOR-REVERSE-C
c120: 4f 50 59 21 20 3c 74 61 72 67 65 74 3e 20 3c 74 OPY! <target> <t
c130: 73 74 61 72 74 3e 20 3c 73 6f 75 72 63 65 3e 20 start> <source>
c140: 5b 3c 73 73 74 61 72 74 3e 20 3c 73 65 6e 64 3e [<sstart> <send>
c150: 5d 29 0a 3b 3b 3b 20 5b 77 64 63 5d 20 43 6f 72 ]).;;; [wdc] Cor
c160: 72 65 63 74 65 64 20 74 6f 20 61 6c 6c 6f 77 20 rected to allow
c170: 30 20 3c 3d 20 73 73 74 61 72 74 20 3c 3d 20 73 0 <= sstart <= s
c180: 65 6e 64 20 3c 3d 20 28 76 65 63 74 6f 72 2d 6c end <= (vector-l
c190: 65 6e 67 74 68 20 73 6f 75 72 63 65 29 2e 0a 28 ength source)..(
c1a0: 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 2d 72 define (vector-r
c1b0: 65 76 65 72 73 65 2d 63 6f 70 79 21 20 74 61 72 everse-copy! tar
c1c0: 67 65 74 20 74 73 74 61 72 74 20 73 6f 75 72 63 get tstart sourc
c1d0: 65 20 2e 20 6d 61 79 62 65 2d 73 73 74 61 72 74 e . maybe-sstart
c1e0: 2b 73 65 6e 64 29 0a 20 20 28 64 65 66 69 6e 65 +send). (define
c1f0: 20 28 64 6f 69 74 21 20 73 73 74 61 72 74 20 73 (doit! sstart s
c200: 65 6e 64 20 73 6f 75 72 63 65 2d 6c 65 6e 67 74 end source-lengt
c210: 68 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 73 h). (let ((ts
c220: 74 61 72 74 20 28 63 68 65 63 6b 2d 74 79 70 65 tart (check-type
c230: 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 74 73 74 nonneg-int? tst
c240: 61 72 74 20 76 65 63 74 6f 72 2d 72 65 76 65 72 art vector-rever
c250: 73 65 2d 63 6f 70 79 21 29 29 0a 20 20 20 20 20 se-copy!)).
c260: 20 20 20 20 20 28 73 73 74 61 72 74 20 28 63 68 (sstart (ch
c270: 65 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 67 2d eck-type nonneg-
c280: 69 6e 74 3f 20 73 73 74 61 72 74 20 76 65 63 74 int? sstart vect
c290: 6f 72 2d 72 65 76 65 72 73 65 2d 63 6f 70 79 21 or-reverse-copy!
c2a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 )). (se
c2b0: 6e 64 20 20 20 28 63 68 65 63 6b 2d 74 79 70 65 nd (check-type
c2c0: 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 73 65 6e nonneg-int? sen
c2d0: 64 20 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 d vector-reverse
c2e0: 2d 63 6f 70 79 21 29 29 29 0a 20 20 20 20 20 20 -copy!))).
c2f0: 28 63 6f 6e 64 20 28 28 61 6e 64 20 28 65 71 3f (cond ((and (eq?
c300: 20 74 61 72 67 65 74 20 73 6f 75 72 63 65 29 0a target source).
c310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c320: 20 20 28 6f 72 20 28 62 65 74 77 65 65 6e 3f 20 (or (between?
c330: 73 73 74 61 72 74 20 74 73 74 61 72 74 20 73 65 sstart tstart se
c340: 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
c350: 20 20 20 20 20 20 20 20 20 20 28 62 65 74 77 65 (betwe
c360: 65 6e 3f 20 74 73 74 61 72 74 20 73 73 74 61 72 en? tstart sstar
c370: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
c380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c390: 20 20 28 2b 20 74 73 74 61 72 74 20 28 2d 20 73 (+ tstart (- s
c3a0: 65 6e 64 20 73 73 74 61 72 74 29 29 29 29 29 0a end sstart))))).
c3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c3c0: 65 72 72 6f 72 20 22 76 65 63 74 6f 72 20 72 61 error "vector ra
c3d0: 6e 67 65 20 66 6f 72 20 73 65 6c 66 2d 63 6f 70 nge for self-cop
c3e0: 79 69 6e 67 20 6f 76 65 72 6c 61 70 73 22 0a 20 ying overlaps".
c3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c400: 20 20 20 20 20 76 65 63 74 6f 72 2d 72 65 76 65 vector-reve
c410: 72 73 65 2d 63 6f 70 79 21 0a 20 20 20 20 20 20 rse-copy!.
c420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c430: 60 28 76 65 63 74 6f 72 20 77 61 73 20 2c 74 61 `(vector was ,ta
c440: 72 67 65 74 29 0a 20 20 20 20 20 20 20 20 20 20 rget).
c450: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 74 73 `(ts
c460: 74 61 72 74 20 77 61 73 20 2c 74 73 74 61 72 74 tart was ,tstart
c470: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
c480: 20 20 20 20 20 20 20 20 60 28 73 73 74 61 72 74 `(sstart
c490: 20 77 61 73 20 2c 73 73 74 61 72 74 29 0a 20 20 was ,sstart).
c4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c4b0: 20 20 20 20 60 28 73 65 6e 64 20 20 20 77 61 73 `(send was
c4c0: 20 2c 73 65 6e 64 29 29 29 0a 20 20 20 20 20 20 ,send))).
c4d0: 20 20 20 20 20 20 28 28 61 6e 64 20 28 3c 3d 20 ((and (<=
c4e0: 30 20 73 73 74 61 72 74 20 73 65 6e 64 20 73 6f 0 sstart send so
c4f0: 75 72 63 65 2d 6c 65 6e 67 74 68 29 0a 20 20 20 urce-length).
c500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c510: 3c 3d 20 28 2b 20 74 73 74 61 72 74 20 28 2d 20 <= (+ tstart (-
c520: 73 65 6e 64 20 73 73 74 61 72 74 29 29 20 28 76 send sstart)) (v
c530: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 74 61 72 ector-length tar
c540: 67 65 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 get))).
c550: 20 20 20 20 28 25 76 65 63 74 6f 72 2d 72 65 76 (%vector-rev
c560: 65 72 73 65 2d 63 6f 70 79 21 20 74 61 72 67 65 erse-copy! targe
c570: 74 20 74 73 74 61 72 74 20 73 6f 75 72 63 65 20 t tstart source
c580: 73 73 74 61 72 74 20 73 65 6e 64 29 29 0a 20 20 sstart send)).
c590: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
c5a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
c5b0: 72 6f 72 20 22 69 6c 6c 65 67 61 6c 20 61 72 67 ror "illegal arg
c5c0: 75 6d 65 6e 74 73 22 0a 20 20 20 20 20 20 20 20 uments".
c5d0: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 77 68 `(wh
c5e0: 69 6c 65 20 63 61 6c 6c 69 6e 67 20 2c 76 65 63 ile calling ,vec
c5f0: 74 6f 72 2d 72 65 76 65 72 73 65 2d 63 6f 70 79 tor-reverse-copy
c600: 21 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 !).
c610: 20 20 20 20 20 20 20 60 28 74 61 72 67 65 74 20 `(target
c620: 77 61 73 20 2c 74 61 72 67 65 74 29 0a 20 20 20 was ,target).
c630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c640: 20 60 28 74 61 72 67 65 74 2d 6c 65 6e 67 74 68 `(target-length
c650: 20 77 61 73 20 2c 28 76 65 63 74 6f 72 2d 6c 65 was ,(vector-le
c660: 6e 67 74 68 20 74 61 72 67 65 74 29 29 0a 20 20 ngth target)).
c670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c680: 20 20 60 28 74 73 74 61 72 74 20 77 61 73 20 2c `(tstart was ,
c690: 74 73 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 tstart).
c6a0: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 73 6f `(so
c6b0: 75 72 63 65 20 77 61 73 20 2c 73 6f 75 72 63 65 urce was ,source
c6c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
c6d0: 20 20 20 20 20 20 60 28 73 6f 75 72 63 65 2d 6c `(source-l
c6e0: 65 6e 67 74 68 20 77 61 73 20 2c 73 6f 75 72 63 ength was ,sourc
c6f0: 65 2d 6c 65 6e 67 74 68 29 0a 20 20 20 20 20 20 e-length).
c700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
c710: 73 73 74 61 72 74 20 77 61 73 20 2c 73 73 74 61 sstart was ,ssta
c720: 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rt).
c730: 20 20 20 20 20 20 20 20 60 28 73 65 6e 64 20 20 `(send
c740: 20 77 61 73 20 2c 73 65 6e 64 29 29 29 29 29 29 was ,send))))))
c750: 0a 20 20 28 6c 65 74 20 28 28 6e 20 28 76 65 63 . (let ((n (vec
c760: 74 6f 72 2d 6c 65 6e 67 74 68 20 73 6f 75 72 63 tor-length sourc
c770: 65 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 20 28 e))). (cond (
c780: 28 6e 75 6c 6c 3f 20 6d 61 79 62 65 2d 73 73 74 (null? maybe-sst
c790: 61 72 74 2b 73 65 6e 64 29 0a 20 20 20 20 20 20 art+send).
c7a0: 20 20 20 20 20 28 64 6f 69 74 21 20 30 20 6e 20 (doit! 0 n
c7b0: 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 n)). ((
c7c0: 6e 75 6c 6c 3f 20 28 63 64 72 20 6d 61 79 62 65 null? (cdr maybe
c7d0: 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 29 0a 20 -sstart+send)).
c7e0: 20 20 20 20 20 20 20 20 20 20 28 64 6f 69 74 21 (doit!
c7f0: 20 28 63 61 72 20 6d 61 79 62 65 2d 73 73 74 61 (car maybe-ssta
c800: 72 74 2b 73 65 6e 64 29 20 6e 20 6e 29 29 0a 20 rt+send) n n)).
c810: 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f ((null?
c820: 20 28 63 64 64 72 20 6d 61 79 62 65 2d 73 73 74 (cddr maybe-sst
c830: 61 72 74 2b 73 65 6e 64 29 29 0a 20 20 20 20 20 art+send)).
c840: 20 20 20 20 20 20 28 64 6f 69 74 21 20 28 63 61 (doit! (ca
c850: 72 20 6d 61 79 62 65 2d 73 73 74 61 72 74 2b 73 r maybe-sstart+s
c860: 65 6e 64 29 20 28 63 61 64 72 20 6d 61 79 62 65 end) (cadr maybe
c870: 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 20 6e 29 -sstart+send) n)
c880: 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 ). (els
c890: 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 72 e. (er
c8a0: 72 6f 72 20 22 74 6f 6f 20 6d 61 6e 79 20 61 72 ror "too many ar
c8b0: 67 75 6d 65 6e 74 73 22 0a 20 20 20 20 20 20 20 guments".
c8c0: 20 20 20 20 20 20 20 20 20 20 20 76 65 63 74 6f vecto
c8d0: 72 2d 72 65 76 65 72 73 65 2d 63 6f 70 79 21 0a r-reverse-copy!.
c8e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c8f0: 20 20 28 63 64 64 72 20 6d 61 79 62 65 2d 73 73 (cddr maybe-ss
c900: 74 61 72 74 2b 73 65 6e 64 29 29 29 29 29 29 0a tart+send)))))).
c910: 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 52 45 56 .;;; (VECTOR-REV
c920: 45 52 53 45 21 20 3c 76 65 63 74 6f 72 3e 20 5b ERSE! <vector> [
c930: 3c 73 74 61 72 74 3e 20 3c 65 6e 64 3e 5d 29 20 <start> <end>])
c940: 2d 3e 20 75 6e 73 70 65 63 69 66 69 65 64 0a 3b -> unspecified.;
c950: 3b 3b 20 20 20 44 65 73 74 72 75 63 74 69 76 65 ;; Destructive
c960: 6c 79 20 72 65 76 65 72 73 65 20 74 68 65 20 63 ly reverse the c
c970: 6f 6e 74 65 6e 74 73 20 6f 66 20 74 68 65 20 73 ontents of the s
c980: 65 71 75 65 6e 63 65 20 6f 66 20 6c 6f 63 61 74 equence of locat
c990: 69 6f 6e 73 0a 3b 3b 3b 20 20 20 69 6e 20 56 45 ions.;;; in VE
c9a0: 43 54 4f 52 20 62 65 74 77 65 65 6e 20 53 54 41 CTOR between STA
c9b0: 52 54 2c 20 77 68 6f 73 65 20 64 65 66 61 75 6c RT, whose defaul
c9c0: 74 20 69 73 20 30 2c 20 61 6e 64 20 45 4e 44 2c t is 0, and END,
c9d0: 20 77 68 6f 73 65 0a 3b 3b 3b 20 20 20 64 65 66 whose.;;; def
c9e0: 61 75 6c 74 20 69 73 20 74 68 65 20 6c 65 6e 67 ault is the leng
c9f0: 74 68 20 6f 66 20 56 45 43 54 4f 52 2e 0a 28 64 th of VECTOR..(d
ca00: 65 66 69 6e 65 20 28 76 65 63 74 6f 72 2d 72 65 efine (vector-re
ca10: 76 65 72 73 65 21 20 76 65 63 20 2e 20 73 74 61 verse! vec . sta
ca20: 72 74 2b 65 6e 64 29 0a 20 20 28 6c 65 74 2d 76 rt+end). (let-v
ca30: 65 63 74 6f 72 2d 73 74 61 72 74 2b 65 6e 64 20 ector-start+end
ca40: 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 21 20 vector-reverse!
ca50: 76 65 63 20 73 74 61 72 74 2b 65 6e 64 0a 20 20 vec start+end.
ca60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ca70: 20 20 20 20 20 20 28 73 74 61 72 74 20 65 6e 64 (start end
ca80: 29 0a 20 20 20 20 28 25 76 65 63 74 6f 72 2d 72 ). (%vector-r
ca90: 65 76 65 72 73 65 21 20 76 65 63 20 73 74 61 72 everse! vec star
caa0: 74 20 65 6e 64 29 29 29 0a 0a 0c 0a 0a 3b 3b 3b t end))).....;;;
cab0: 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ---------------
cac0: 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 43 6f 6e 76 65 72 -----.;;; Conver
cad0: 73 69 6f 6e 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f sion..;;; (VECTO
cae0: 52 2d 3e 4c 49 53 54 20 3c 76 65 63 74 6f 72 3e R->LIST <vector>
caf0: 20 5b 3c 73 74 61 72 74 3e 20 3c 65 6e 64 3e 5d [<start> <end>]
cb00: 29 20 2d 3e 20 6c 69 73 74 0a 3b 3b 3b 20 20 20 ) -> list.;;;
cb10: 5b 52 35 52 53 2b 5d 20 50 72 6f 64 75 63 65 20 [R5RS+] Produce
cb20: 61 20 6c 69 73 74 20 63 6f 6e 74 61 69 6e 69 6e a list containin
cb30: 67 20 74 68 65 20 65 6c 65 6d 65 6e 74 73 20 69 g the elements i
cb40: 6e 20 74 68 65 20 6c 6f 63 61 74 69 6f 6e 73 0a n the locations.
cb50: 3b 3b 3b 20 20 20 62 65 74 77 65 65 6e 20 53 54 ;;; between ST
cb60: 41 52 54 2c 20 77 68 6f 73 65 20 64 65 66 61 75 ART, whose defau
cb70: 6c 74 20 69 73 20 30 2c 20 61 6e 64 20 45 4e 44 lt is 0, and END
cb80: 2c 20 77 68 6f 73 65 20 64 65 66 61 75 6c 74 20 , whose default
cb90: 69 73 20 74 68 65 0a 3b 3b 3b 20 20 20 6c 65 6e is the.;;; len
cba0: 67 74 68 20 6f 66 20 56 45 43 54 4f 52 2c 20 66 gth of VECTOR, f
cbb0: 72 6f 6d 20 56 45 43 54 4f 52 2e 0a 28 64 65 66 rom VECTOR..(def
cbc0: 69 6e 65 20 76 65 63 74 6f 72 2d 3e 6c 69 73 74 ine vector->list
cbd0: 0a 20 20 28 6c 65 74 20 28 28 25 76 65 63 74 6f . (let ((%vecto
cbe0: 72 2d 3e 6c 69 73 74 20 76 65 63 74 6f 72 2d 3e r->list vector->
cbf0: 6c 69 73 74 29 29 0a 20 20 20 20 28 6c 61 6d 62 list)). (lamb
cc00: 64 61 20 28 76 65 63 20 2e 20 6d 61 79 62 65 2d da (vec . maybe-
cc10: 73 74 61 72 74 2b 65 6e 64 29 0a 20 20 20 20 20 start+end).
cc20: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 79 62 (if (null? mayb
cc30: 65 2d 73 74 61 72 74 2b 65 6e 64 29 20 20 20 20 e-start+end)
cc40: 20 20 20 3b 20 4f 75 67 68 74 61 20 75 73 65 20 ; Oughta use
cc50: 43 41 53 45 2d 4c 41 4d 42 44 41 2e 0a 20 20 20 CASE-LAMBDA..
cc60: 20 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 2d (%vector-
cc70: 3e 6c 69 73 74 20 76 65 63 29 20 20 20 20 20 20 >list vec)
cc80: 20 20 20 20 20 3b 2b 2b 2b 0a 20 20 20 20 20 20 ;+++.
cc90: 20 20 20 20 28 6c 65 74 2d 76 65 63 74 6f 72 2d (let-vector-
cca0: 73 74 61 72 74 2b 65 6e 64 20 76 65 63 74 6f 72 start+end vector
ccb0: 2d 3e 6c 69 73 74 20 76 65 63 20 6d 61 79 62 65 ->list vec maybe
ccc0: 2d 73 74 61 72 74 2b 65 6e 64 0a 20 20 20 20 20 -start+end.
ccd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cce0: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 72 (star
ccf0: 74 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 t end).
cd00: 20 20 20 3b 28 75 6e 66 6f 6c 64 20 28 6c 61 6d ;(unfold (lam
cd10: 62 64 61 20 28 69 29 20 20 20 20 20 20 20 20 3b bda (i) ;
cd20: 20 4e 6f 20 53 52 46 49 20 31 2e 0a 20 20 20 20 No SRFI 1..
cd30: 20 20 20 20 20 20 20 20 3b 20 20 20 20 20 20 20 ;
cd40: 20 20 20 28 3c 20 69 20 73 74 61 72 74 29 29 0a (< i start)).
cd50: 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 20 20 ;
cd60: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 29 (lambda (i)
cd70: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 (vector-ref vec
cd80: 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 i)).
cd90: 20 3b 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ; (lambd
cda0: 61 20 28 69 29 20 28 2d 20 69 20 31 29 29 0a 20 a (i) (- i 1)).
cdb0: 20 20 20 20 20 20 20 20 20 20 20 3b 20 20 20 20 ;
cdc0: 20 20 20 20 28 2d 20 65 6e 64 20 31 29 29 0a 20 (- end 1)).
cdd0: 20 20 20 20 20 20 20 20 20 20 20 28 64 6f 20 28 (do (
cde0: 28 69 20 28 2d 20 65 6e 64 20 31 29 20 28 2d 20 (i (- end 1) (-
cdf0: 69 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 i 1)).
ce00: 20 20 20 20 20 20 20 28 72 65 73 75 6c 74 20 27 (result '
ce10: 28 29 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 () (cons (vector
ce20: 2d 72 65 66 20 76 65 63 20 69 29 20 72 65 73 75 -ref vec i) resu
ce30: 6c 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 lt))).
ce40: 20 20 20 20 20 20 28 28 3c 20 69 20 73 74 61 72 ((< i star
ce50: 74 29 20 72 65 73 75 6c 74 29 29 29 29 29 29 29 t) result)))))))
ce60: 0a 0a 3b 3b 3b 20 28 52 45 56 45 52 53 45 2d 56 ..;;; (REVERSE-V
ce70: 45 43 54 4f 52 2d 3e 4c 49 53 54 20 3c 76 65 63 ECTOR->LIST <vec
ce80: 74 6f 72 3e 20 5b 3c 73 74 61 72 74 3e 20 3c 65 tor> [<start> <e
ce90: 6e 64 3e 5d 29 20 2d 3e 20 6c 69 73 74 0a 3b 3b nd>]) -> list.;;
cea0: 3b 20 20 20 50 72 6f 64 75 63 65 20 61 20 6c 69 ; Produce a li
ceb0: 73 74 20 63 6f 6e 74 61 69 6e 69 6e 67 20 74 68 st containing th
cec0: 65 20 65 6c 65 6d 65 6e 74 73 20 69 6e 20 74 68 e elements in th
ced0: 65 20 6c 6f 63 61 74 69 6f 6e 73 20 62 65 74 77 e locations betw
cee0: 65 65 6e 0a 3b 3b 3b 20 20 20 53 54 41 52 54 2c een.;;; START,
cef0: 20 77 68 6f 73 65 20 64 65 66 61 75 6c 74 20 69 whose default i
cf00: 73 20 30 2c 20 61 6e 64 20 45 4e 44 2c 20 77 68 s 0, and END, wh
cf10: 6f 73 65 20 64 65 66 61 75 6c 74 20 69 73 20 74 ose default is t
cf20: 68 65 20 6c 65 6e 67 74 68 0a 3b 3b 3b 20 20 20 he length.;;;
cf30: 6f 66 20 56 45 43 54 4f 52 2c 20 66 72 6f 6d 20 of VECTOR, from
cf40: 56 45 43 54 4f 52 2c 20 69 6e 20 72 65 76 65 72 VECTOR, in rever
cf50: 73 65 20 6f 72 64 65 72 2e 0a 28 64 65 66 69 6e se order..(defin
cf60: 65 20 28 72 65 76 65 72 73 65 2d 76 65 63 74 6f e (reverse-vecto
cf70: 72 2d 3e 6c 69 73 74 20 76 65 63 20 2e 20 6d 61 r->list vec . ma
cf80: 79 62 65 2d 73 74 61 72 74 2b 65 6e 64 29 0a 20 ybe-start+end).
cf90: 20 28 6c 65 74 2d 76 65 63 74 6f 72 2d 73 74 61 (let-vector-sta
cfa0: 72 74 2b 65 6e 64 20 72 65 76 65 72 73 65 2d 76 rt+end reverse-v
cfb0: 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 65 63 20 ector->list vec
cfc0: 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e 64 0a maybe-start+end.
cfd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cfe0: 20 20 20 20 20 20 20 20 28 73 74 61 72 74 20 65 (start e
cff0: 6e 64 29 0a 20 20 20 20 3b 28 75 6e 66 6f 6c 64 nd). ;(unfold
d000: 20 28 6c 61 6d 62 64 61 20 28 69 29 20 28 3d 20 (lambda (i) (=
d010: 69 20 65 6e 64 29 29 20 20 20 20 20 3b 20 4e 6f i end)) ; No
d020: 20 53 52 46 49 20 31 2e 0a 20 20 20 20 3b 20 20 SRFI 1.. ;
d030: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 (lambda (i
d040: 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 ) (vector-ref ve
d050: 63 20 69 29 29 0a 20 20 20 20 3b 20 20 20 20 20 c i)). ;
d060: 20 20 20 28 6c 61 6d 62 64 61 20 28 69 29 20 28 (lambda (i) (
d070: 2b 20 69 20 31 29 29 0a 20 20 20 20 3b 20 20 20 + i 1)). ;
d080: 20 20 20 20 20 73 74 61 72 74 29 0a 20 20 20 20 start).
d090: 28 64 6f 20 28 28 69 20 73 74 61 72 74 20 28 2b (do ((i start (+
d0a0: 20 69 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 i 1)).
d0b0: 28 72 65 73 75 6c 74 20 27 28 29 20 28 63 6f 6e (result '() (con
d0c0: 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 s (vector-ref ve
d0d0: 63 20 69 29 20 72 65 73 75 6c 74 29 29 29 0a 20 c i) result))).
d0e0: 20 20 20 20 20 20 20 28 28 3d 20 69 20 65 6e 64 ((= i end
d0f0: 29 20 72 65 73 75 6c 74 29 29 29 29 0a 0a 3b 3b ) result))))..;;
d100: 3b 20 28 4c 49 53 54 2d 3e 56 45 43 54 4f 52 20 ; (LIST->VECTOR
d110: 3c 6c 69 73 74 3e 20 5b 3c 73 74 61 72 74 3e 20 <list> [<start>
d120: 3c 65 6e 64 3e 5d 29 20 2d 3e 20 76 65 63 74 6f <end>]) -> vecto
d130: 72 0a 3b 3b 3b 20 20 20 5b 52 35 52 53 2b 5d 20 r.;;; [R5RS+]
d140: 50 72 6f 64 75 63 65 20 61 20 76 65 63 74 6f 72 Produce a vector
d150: 20 63 6f 6e 74 61 69 6e 69 6e 67 20 74 68 65 20 containing the
d160: 65 6c 65 6d 65 6e 74 73 20 69 6e 20 4c 49 53 54 elements in LIST
d170: 2c 20 77 68 69 63 68 0a 3b 3b 3b 20 20 20 6d 75 , which.;;; mu
d180: 73 74 20 62 65 20 61 20 70 72 6f 70 65 72 20 6c st be a proper l
d190: 69 73 74 2c 20 62 65 74 77 65 65 6e 20 53 54 41 ist, between STA
d1a0: 52 54 2c 20 77 68 6f 73 65 20 64 65 66 61 75 6c RT, whose defaul
d1b0: 74 20 69 73 20 30 2c 20 26 20 45 4e 44 2c 0a 3b t is 0, & END,.;
d1c0: 3b 3b 20 20 20 77 68 6f 73 65 20 64 65 66 61 75 ;; whose defau
d1d0: 6c 74 20 69 73 20 74 68 65 20 6c 65 6e 67 74 68 lt is the length
d1e0: 20 6f 66 20 4c 49 53 54 2e 20 20 49 74 20 69 73 of LIST. It is
d1f0: 20 73 75 67 67 65 73 74 65 64 20 74 68 61 74 20 suggested that
d200: 69 66 20 74 68 65 0a 3b 3b 3b 20 20 20 6c 65 6e if the.;;; len
d210: 67 74 68 20 6f 66 20 4c 49 53 54 20 69 73 20 6b gth of LIST is k
d220: 6e 6f 77 6e 20 69 6e 20 61 64 76 61 6e 63 65 2c nown in advance,
d230: 20 74 68 65 20 53 54 41 52 54 20 61 6e 64 20 45 the START and E
d240: 4e 44 20 61 72 67 75 6d 65 6e 74 73 0a 3b 3b 3b ND arguments.;;;
d250: 20 20 20 62 65 20 70 61 73 73 65 64 2c 20 73 6f be passed, so
d260: 20 74 68 61 74 20 4c 49 53 54 2d 3e 56 45 43 54 that LIST->VECT
d270: 4f 52 20 6e 65 65 64 20 6e 6f 74 20 63 61 6c 6c OR need not call
d280: 20 4c 45 4e 47 54 48 20 74 6f 20 64 65 74 65 72 LENGTH to deter
d290: 6d 69 6e 65 0a 3b 3b 3b 20 20 20 74 68 65 20 74 mine.;;; the t
d2a0: 68 65 20 6c 65 6e 67 74 68 2e 0a 3b 3b 3b 0a 3b he length..;;;.;
d2b0: 3b 3b 20 54 68 69 73 20 69 6d 70 6c 65 6d 65 6e ;; This implemen
d2c0: 74 61 74 69 6f 6e 20 64 69 76 65 72 67 65 73 20 tation diverges
d2d0: 6f 6e 20 63 69 72 63 75 6c 61 72 20 6c 69 73 74 on circular list
d2e0: 73 2c 20 75 6e 6c 65 73 73 20 4c 45 4e 47 54 48 s, unless LENGTH
d2f0: 20 66 61 69 6c 73 0a 3b 3b 3b 20 61 6e 64 20 63 fails.;;; and c
d300: 61 75 73 65 73 20 2d 20 74 6f 20 66 61 69 6c 20 auses - to fail
d310: 61 73 20 77 65 6c 6c 2e 20 20 47 69 76 65 6e 20 as well. Given
d320: 61 20 4c 45 4e 47 54 48 2a 20 74 68 61 74 20 63 a LENGTH* that c
d330: 6f 6d 70 75 74 65 73 20 74 68 65 0a 3b 3b 3b 20 omputes the.;;;
d340: 6c 65 6e 67 74 68 20 6f 66 20 61 20 6c 69 73 74 length of a list
d350: 27 73 20 63 79 63 6c 65 2c 20 74 68 69 73 20 77 's cycle, this w
d360: 6f 75 6c 64 6e 27 74 20 64 69 76 65 72 67 65 2c ouldn't diverge,
d370: 20 61 6e 64 20 77 6f 75 6c 64 20 77 6f 72 6b 0a and would work.
d380: 3b 3b 3b 20 67 72 65 61 74 20 66 6f 72 20 63 69 ;;; great for ci
d390: 72 63 75 6c 61 72 20 6c 69 73 74 73 2e 0a 28 64 rcular lists..(d
d3a0: 65 66 69 6e 65 20 6c 69 73 74 2d 3e 76 65 63 74 efine list->vect
d3b0: 6f 72 0a 20 20 28 6c 65 74 20 28 28 25 6c 69 73 or. (let ((%lis
d3c0: 74 2d 3e 76 65 63 74 6f 72 20 6c 69 73 74 2d 3e t->vector list->
d3d0: 76 65 63 74 6f 72 29 29 0a 20 20 20 20 28 6c 61 vector)). (la
d3e0: 6d 62 64 61 20 28 6c 73 74 20 2e 20 6d 61 79 62 mbda (lst . mayb
d3f0: 65 2d 73 74 61 72 74 2b 65 6e 64 29 0a 20 20 20 e-start+end).
d400: 20 20 20 3b 3b 20 43 68 65 63 6b 69 6e 67 20 74 ;; Checking t
d410: 68 65 20 74 79 70 65 20 6f 66 20 61 20 70 72 6f he type of a pro
d420: 70 65 72 20 6c 69 73 74 20 69 73 20 65 78 70 65 per list is expe
d430: 6e 73 69 76 65 2c 20 73 6f 20 77 65 20 64 6f 20 nsive, so we do
d440: 69 74 0a 20 20 20 20 20 20 3b 3b 20 61 6d 6f 72 it. ;; amor
d450: 74 69 7a 65 64 6c 79 2c 20 6f 72 20 6c 65 74 20 tizedly, or let
d460: 25 4c 49 53 54 2d 3e 56 45 43 54 4f 52 20 6f 72 %LIST->VECTOR or
d470: 20 4c 49 53 54 2d 54 41 49 4c 20 64 6f 20 69 74 LIST-TAIL do it
d480: 2e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c .. (if (nul
d490: 6c 3f 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 l? maybe-start+e
d4a0: 6e 64 29 20 20 20 20 20 20 20 3b 20 4f 75 67 68 nd) ; Ough
d4b0: 74 61 20 75 73 65 20 43 41 53 45 2d 4c 41 4d 42 ta use CASE-LAMB
d4c0: 44 41 2e 0a 20 20 20 20 20 20 20 20 20 20 28 25 DA.. (%
d4d0: 6c 69 73 74 2d 3e 76 65 63 74 6f 72 20 6c 73 74 list->vector lst
d4e0: 29 20 20 20 20 20 20 20 20 20 20 20 3b 2b 2b 2b ) ;+++
d4f0: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 57 65 . ;; We
d500: 20 63 61 6e 27 74 20 75 73 65 20 4c 45 54 2d 56 can't use LET-V
d510: 45 43 54 4f 52 2d 53 54 41 52 54 2b 45 4e 44 2c ECTOR-START+END,
d520: 20 62 65 63 61 75 73 65 20 77 65 27 72 65 20 75 because we're u
d530: 73 69 6e 67 20 74 68 65 0a 20 20 20 20 20 20 20 sing the.
d540: 20 20 20 3b 3b 20 62 6f 75 6e 64 73 20 6f 66 20 ;; bounds of
d550: 61 20 5f 6c 69 73 74 5f 2c 20 6e 6f 74 20 61 20 a _list_, not a
d560: 76 65 63 74 6f 72 2e 0a 20 20 20 20 20 20 20 20 vector..
d570: 20 20 28 6c 65 74 2a 2d 6f 70 74 69 6f 6e 61 6c (let*-optional
d580: 73 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e s maybe-start+en
d590: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
d5a0: 28 28 73 74 61 72 74 20 30 29 0a 20 20 20 20 20 ((start 0).
d5b0: 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 20 28 (end (
d5c0: 6c 65 6e 67 74 68 20 6c 73 74 29 29 29 20 20 20 length lst)))
d5d0: 20 20 20 3b 20 55 67 68 20 2d 2d 20 4c 45 4e 47 ; Ugh -- LENG
d5e0: 54 48 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 TH. (
d5f0: 6c 65 74 20 28 28 73 74 61 72 74 20 28 63 68 65 let ((start (che
d600: 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 67 2d 69 ck-type nonneg-i
d610: 6e 74 3f 20 73 74 61 72 74 20 6c 69 73 74 2d 3e nt? start list->
d620: 76 65 63 74 6f 72 29 29 0a 20 20 20 20 20 20 20 vector)).
d630: 20 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 20 (end
d640: 20 20 28 63 68 65 63 6b 2d 74 79 70 65 20 6e 6f (check-type no
d650: 6e 6e 65 67 2d 69 6e 74 3f 20 65 6e 64 20 20 20 nneg-int? end
d660: 6c 69 73 74 2d 3e 76 65 63 74 6f 72 29 29 29 0a list->vector))).
d670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
d680: 6c 61 6d 62 64 61 20 28 66 29 0a 20 20 20 20 20 lambda (f).
d690: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec
d6a0: 74 6f 72 2d 75 6e 66 6f 6c 64 20 66 20 28 2d 20 tor-unfold f (-
d6b0: 65 6e 64 20 73 74 61 72 74 29 20 28 6c 69 73 74 end start) (list
d6c0: 2d 74 61 69 6c 20 6c 73 74 20 73 74 61 72 74 29 -tail lst start)
d6d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
d6e0: 20 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 65 78 (lambda (index
d6f0: 20 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 l).
d700: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c (cond ((nul
d710: 6c 3f 20 6c 29 0a 20 20 20 20 20 20 20 20 20 20 l? l).
d720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
d730: 72 72 6f 72 20 22 6c 69 73 74 20 77 61 73 20 74 rror "list was t
d740: 6f 6f 20 73 68 6f 72 74 22 0a 20 20 20 20 20 20 oo short".
d750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d760: 20 20 20 20 20 20 20 20 20 60 28 6c 69 73 74 20 `(list
d770: 77 61 73 20 2c 6c 73 74 29 0a 20 20 20 20 20 20 was ,lst).
d780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d790: 20 20 20 20 20 20 20 20 20 60 28 61 74 74 65 6d `(attem
d7a0: 70 74 65 64 20 65 6e 64 20 77 61 73 20 2c 65 6e pted end was ,en
d7b0: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
d7c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d7d0: 20 20 60 28 77 68 69 6c 65 20 63 61 6c 6c 69 6e `(while callin
d7e0: 67 20 2c 6c 69 73 74 2d 3e 76 65 63 74 6f 72 29 g ,list->vector)
d7f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
d800: 20 20 20 20 20 20 20 20 20 20 28 28 70 61 69 72 ((pair
d810: 3f 20 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ? l).
d820: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 61 (va
d830: 6c 75 65 73 20 28 63 61 72 20 6c 29 20 28 63 64 lues (car l) (cd
d840: 72 20 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 r l))).
d850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
d860: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
d870: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4d ;; M
d880: 61 6b 65 20 74 68 69 73 20 6c 6f 6f 6b 20 61 73 ake this look as
d890: 20 6d 75 63 68 20 6c 69 6b 65 20 77 68 61 74 20 much like what
d8a0: 43 48 45 43 4b 2d 54 59 50 45 0a 20 20 20 20 20 CHECK-TYPE.
d8b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d8c0: 20 20 20 3b 3b 20 77 6f 75 6c 64 20 72 65 70 6f ;; would repo
d8d0: 72 74 20 61 73 20 70 6f 73 73 69 62 6c 65 2e 0a rt as possible..
d8e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d8f0: 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 (error "
d900: 65 72 72 6f 6e 65 6f 75 73 20 76 61 6c 75 65 22 erroneous value"
d910: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d930: 3b 3b 20 57 65 20 77 61 6e 74 20 53 52 46 49 20 ;; We want SRFI
d940: 31 27 73 20 50 52 4f 50 45 52 2d 4c 49 53 54 3f 1's PROPER-LIST?
d950: 2c 20 62 75 74 20 69 74 0a 20 20 20 20 20 20 20 , but it.
d960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d970: 20 20 20 20 20 20 20 20 3b 3b 20 77 6f 75 6c 64 ;; would
d980: 20 62 65 20 61 20 77 61 73 74 65 20 74 6f 20 6c be a waste to l
d990: 69 6e 6b 20 61 6c 6c 20 6f 66 20 53 52 46 49 0a ink all of SRFI.
d9a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d9b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
d9c0: 3b 20 31 20 74 6f 20 74 68 69 73 20 6d 6f 64 75 ; 1 to this modu
d9d0: 6c 65 20 66 6f 72 20 6f 6e 6c 79 20 74 68 65 20 le for only the
d9e0: 73 69 6e 67 6c 65 0a 20 20 20 20 20 20 20 20 20 single.
d9f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da00: 20 20 20 20 20 20 3b 3b 20 66 75 6e 63 74 69 6f ;; functio
da10: 6e 20 50 52 4f 50 45 52 2d 4c 49 53 54 3f 2e 0a n PROPER-LIST?..
da20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
da40: 6c 69 73 74 20 6c 69 73 74 3f 20 6c 73 74 29 0a list list? lst).
da50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 `
da70: 28 77 68 69 6c 65 20 63 61 6c 6c 69 6e 67 0a 20 (while calling.
da80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
daa0: 2c 6c 69 73 74 2d 3e 76 65 63 74 6f 72 29 29 29 ,list->vector)))
dab0: 29 29 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 )))))))))..;;; (
dac0: 52 45 56 45 52 53 45 2d 4c 49 53 54 2d 3e 56 45 REVERSE-LIST->VE
dad0: 43 54 4f 52 20 3c 6c 69 73 74 3e 20 5b 3c 73 74 CTOR <list> [<st
dae0: 61 72 74 3e 20 3c 65 6e 64 3e 5d 29 20 2d 3e 20 art> <end>]) ->
daf0: 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 20 50 72 6f vector.;;; Pro
db00: 64 75 63 65 20 61 20 76 65 63 74 6f 72 20 63 6f duce a vector co
db10: 6e 74 61 69 6e 69 6e 67 20 74 68 65 20 65 6c 65 ntaining the ele
db20: 6d 65 6e 74 73 20 69 6e 20 4c 49 53 54 2c 20 77 ments in LIST, w
db30: 68 69 63 68 20 6d 75 73 74 20 62 65 20 61 0a 3b hich must be a.;
db40: 3b 3b 20 20 20 70 72 6f 70 65 72 20 6c 69 73 74 ;; proper list
db50: 2c 20 62 65 74 77 65 65 6e 20 53 54 41 52 54 2c , between START,
db60: 20 77 68 6f 73 65 20 64 65 66 61 75 6c 74 20 69 whose default i
db70: 73 20 30 2c 20 61 6e 64 20 45 4e 44 2c 20 77 68 s 0, and END, wh
db80: 6f 73 65 0a 3b 3b 3b 20 20 20 64 65 66 61 75 6c ose.;;; defaul
db90: 74 20 69 73 20 74 68 65 20 6c 65 6e 67 74 68 20 t is the length
dba0: 6f 66 20 4c 49 53 54 2c 20 69 6e 20 72 65 76 65 of LIST, in reve
dbb0: 72 73 65 20 6f 72 64 65 72 2e 20 20 49 74 20 69 rse order. It i
dbc0: 73 20 73 75 67 67 65 73 74 65 64 0a 3b 3b 3b 20 s suggested.;;;
dbd0: 20 20 74 68 61 74 20 69 66 20 74 68 65 20 6c 65 that if the le
dbe0: 6e 67 74 68 20 6f 66 20 4c 49 53 54 20 69 73 20 ngth of LIST is
dbf0: 6b 6e 6f 77 6e 20 69 6e 20 61 64 76 61 6e 63 65 known in advance
dc00: 2c 20 74 68 65 20 53 54 41 52 54 20 61 6e 64 20 , the START and
dc10: 45 4e 44 0a 3b 3b 3b 20 20 20 61 72 67 75 6d 65 END.;;; argume
dc20: 6e 74 73 20 62 65 20 70 61 73 73 65 64 2c 20 73 nts be passed, s
dc30: 6f 20 74 68 61 74 20 52 45 56 45 52 53 45 2d 4c o that REVERSE-L
dc40: 49 53 54 2d 3e 56 45 43 54 4f 52 20 6e 65 65 64 IST->VECTOR need
dc50: 20 6e 6f 74 20 63 61 6c 6c 0a 3b 3b 3b 20 20 20 not call.;;;
dc60: 4c 45 4e 47 54 48 20 74 6f 20 64 65 74 65 72 6d LENGTH to determ
dc70: 69 6e 65 20 74 68 65 20 74 68 65 20 6c 65 6e 67 ine the the leng
dc80: 74 68 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 54 68 69 73 th..;;;.;;; This
dc90: 20 61 6c 73 6f 20 64 69 76 65 72 67 65 73 20 6f also diverges o
dca0: 6e 20 63 69 72 63 75 6c 61 72 20 6c 69 73 74 73 n circular lists
dcb0: 20 75 6e 6c 65 73 73 2c 20 61 67 61 69 6e 2c 20 unless, again,
dcc0: 4c 45 4e 47 54 48 20 72 65 74 75 72 6e 73 0a 3b LENGTH returns.;
dcd0: 3b 3b 20 73 6f 6d 65 74 68 69 6e 67 20 74 68 61 ;; something tha
dce0: 74 20 6d 61 6b 65 73 20 2d 20 62 6f 72 6b 2e 0a t makes - bork..
dcf0: 28 64 65 66 69 6e 65 20 28 72 65 76 65 72 73 65 (define (reverse
dd00: 2d 6c 69 73 74 2d 3e 76 65 63 74 6f 72 20 6c 73 -list->vector ls
dd10: 74 20 2e 20 6d 61 79 62 65 2d 73 74 61 72 74 2b t . maybe-start+
dd20: 65 6e 64 29 0a 20 20 28 6c 65 74 2a 2d 6f 70 74 end). (let*-opt
dd30: 69 6f 6e 61 6c 73 20 6d 61 79 62 65 2d 73 74 61 ionals maybe-sta
dd40: 72 74 2b 65 6e 64 0a 20 20 20 20 20 20 28 28 73 rt+end. ((s
dd50: 74 61 72 74 20 30 29 0a 20 20 20 20 20 20 20 28 tart 0). (
dd60: 65 6e 64 20 28 6c 65 6e 67 74 68 20 6c 73 74 29 end (length lst)
dd70: 29 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ))
dd80: 3b 20 55 67 68 20 2d 2d 20 4c 45 4e 47 54 48 0a ; Ugh -- LENGTH.
dd90: 20 20 20 20 28 6c 65 74 20 28 28 73 74 61 72 74 (let ((start
dda0: 20 28 63 68 65 63 6b 2d 74 79 70 65 20 6e 6f 6e (check-type non
ddb0: 6e 65 67 2d 69 6e 74 3f 20 73 74 61 72 74 20 72 neg-int? start r
ddc0: 65 76 65 72 73 65 2d 6c 69 73 74 2d 3e 76 65 63 everse-list->vec
ddd0: 74 6f 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 tor)).
dde0: 28 65 6e 64 20 20 20 28 63 68 65 63 6b 2d 74 79 (end (check-ty
ddf0: 70 65 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 65 pe nonneg-int? e
de00: 6e 64 20 20 20 72 65 76 65 72 73 65 2d 6c 69 73 nd reverse-lis
de10: 74 2d 3e 76 65 63 74 6f 72 29 29 29 0a 20 20 20 t->vector))).
de20: 20 20 20 28 28 6c 61 6d 62 64 61 20 28 66 29 0a ((lambda (f).
de30: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
de40: 2d 75 6e 66 6f 6c 64 2d 72 69 67 68 74 20 66 20 -unfold-right f
de50: 28 2d 20 65 6e 64 20 73 74 61 72 74 29 20 28 6c (- end start) (l
de60: 69 73 74 2d 74 61 69 6c 20 6c 73 74 20 73 74 61 ist-tail lst sta
de70: 72 74 29 29 29 0a 20 20 20 20 20 20 20 28 6c 61 rt))). (la
de80: 6d 62 64 61 20 28 69 6e 64 65 78 20 6c 29 0a 20 mbda (index l).
de90: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 (cond ((
dea0: 6e 75 6c 6c 3f 20 6c 29 0a 20 20 20 20 20 20 20 null? l).
deb0: 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 (error
dec0: 22 6c 69 73 74 20 74 6f 6f 20 73 68 6f 72 74 22 "list too short"
ded0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
dee0: 20 20 20 20 20 20 20 20 60 28 6c 69 73 74 20 77 `(list w
def0: 61 73 20 2c 6c 73 74 29 0a 20 20 20 20 20 20 20 as ,lst).
df00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
df10: 60 28 61 74 74 65 6d 70 74 65 64 20 65 6e 64 20 `(attempted end
df20: 77 61 73 20 2c 65 6e 64 29 0a 20 20 20 20 20 20 was ,end).
df30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
df40: 20 60 28 77 68 69 6c 65 20 63 61 6c 6c 69 6e 67 `(while calling
df50: 20 2c 72 65 76 65 72 73 65 2d 6c 69 73 74 2d 3e ,reverse-list->
df60: 76 65 63 74 6f 72 29 29 29 0a 20 20 20 20 20 20 vector))).
df70: 20 20 20 20 20 20 20 20 20 28 28 70 61 69 72 3f ((pair?
df80: 20 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 l).
df90: 20 20 20 20 28 76 61 6c 75 65 73 20 28 63 61 72 (values (car
dfa0: 20 6c 29 20 28 63 64 72 20 6c 29 29 29 0a 20 20 l) (cdr l))).
dfb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
dfc0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
dfd0: 20 20 20 28 65 72 72 6f 72 20 22 65 72 72 6f 6e (error "erron
dfe0: 65 6f 75 73 20 76 61 6c 75 65 22 0a 20 20 20 20 eous value".
dff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e000: 20 20 20 28 6c 69 73 74 20 6c 69 73 74 3f 20 6c (list list? l
e010: 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 st).
e020: 20 20 20 20 20 20 20 20 20 20 20 60 28 77 68 69 `(whi
e030: 6c 65 20 63 61 6c 6c 69 6e 67 20 2c 72 65 76 65 le calling ,reve
e040: 72 73 65 2d 6c 69 73 74 2d 3e 76 65 63 74 6f 72 rse-list->vector
e050: 29 29 29 29 29 29 29 29 29 0a ))))))))).