0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 28 63 29 ;; Copyright (c)
0010: 20 32 30 30 39 20 44 65 72 69 63 6b 20 45 64 64 2009 Derick Edd
0020: 69 6e 67 74 6f 6e 2e 20 20 41 6c 6c 20 72 69 67 ington. All rig
0030: 68 74 73 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b hts reserved..;;
0040: 20 4c 69 63 65 6e 73 65 64 20 75 6e 64 65 72 20 Licensed under
0050: 61 6e 20 4d 49 54 2d 73 74 79 6c 65 20 6c 69 63 an MIT-style lic
0060: 65 6e 73 65 2e 20 20 4d 79 20 6c 69 63 65 6e 73 ense. My licens
0070: 65 20 69 73 20 69 6e 20 74 68 65 20 66 69 6c 65 e is in the file
0080: 0a 3b 3b 20 6e 61 6d 65 64 20 4c 49 43 45 4e 53 .;; named LICENS
0090: 45 20 66 72 6f 6d 20 74 68 65 20 6f 72 69 67 69 E from the origi
00a0: 6e 61 6c 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 74 nal collection t
00b0: 68 69 73 20 66 69 6c 65 20 69 73 20 64 69 73 74 his file is dist
00c0: 72 69 62 75 74 65 64 0a 3b 3b 20 77 69 74 68 2e ributed.;; with.
00d0: 20 20 49 66 20 74 68 69 73 20 66 69 6c 65 20 69 If this file i
00e0: 73 20 72 65 64 69 73 74 72 69 62 75 74 65 64 20 s redistributed
00f0: 77 69 74 68 20 73 6f 6d 65 20 6f 74 68 65 72 20 with some other
0100: 63 6f 6c 6c 65 63 74 69 6f 6e 2c 20 6d 79 0a 3b collection, my.;
0110: 3b 20 6c 69 63 65 6e 73 65 20 6d 75 73 74 20 61 ; license must a
0120: 6c 73 6f 20 62 65 20 69 6e 63 6c 75 64 65 64 2e lso be included.
0130: 0a 0a 23 21 72 36 72 73 0a 28 6c 69 62 72 61 72 ..#!r6rs.(librar
0140: 79 20 28 73 72 66 69 20 73 34 33 20 76 65 63 74 y (srfi s43 vect
0150: 6f 72 73 29 0a 20 20 28 65 78 70 6f 72 74 0a 20 ors). (export.
0160: 20 20 20 3b 3b 3b 20 2a 20 43 6f 6e 73 74 72 75 ;;; * Constru
0170: 63 74 6f 72 73 0a 20 20 20 20 6d 61 6b 65 2d 76 ctors. make-v
0180: 65 63 74 6f 72 20 76 65 63 74 6f 72 0a 20 20 20 ector vector.
0190: 20 76 65 63 74 6f 72 2d 75 6e 66 6f 6c 64 20 20 vector-unfold
01a0: 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d 75 6e vector-un
01b0: 66 6f 6c 64 2d 72 69 67 68 74 0a 20 20 20 20 76 fold-right. v
01c0: 65 63 74 6f 72 2d 63 6f 70 79 0a 20 20 20 20 76 ector-copy. v
01d0: 65 63 74 6f 72 2d 72 65 76 65 72 73 65 2d 63 6f ector-reverse-co
01e0: 70 79 0a 20 20 20 20 76 65 63 74 6f 72 2d 61 70 py. vector-ap
01f0: 70 65 6e 64 20 20 20 20 20 20 20 20 20 76 65 63 pend vec
0200: 74 6f 72 2d 63 6f 6e 63 61 74 65 6e 61 74 65 0a tor-concatenate.
0210: 20 20 20 20 3b 3b 3b 20 2a 20 50 72 65 64 69 63 ;;; * Predic
0220: 61 74 65 73 0a 20 20 20 20 76 65 63 74 6f 72 3f ates. vector?
0230: 0a 20 20 20 20 76 65 63 74 6f 72 2d 65 6d 70 74 . vector-empt
0240: 79 3f 0a 20 20 20 20 76 65 63 74 6f 72 3d 0a 20 y?. vector=.
0250: 20 20 20 3b 3b 3b 20 2a 20 53 65 6c 65 63 74 6f ;;; * Selecto
0260: 72 73 0a 20 20 20 20 76 65 63 74 6f 72 2d 72 65 rs. vector-re
0270: 66 0a 20 20 20 20 76 65 63 74 6f 72 2d 6c 65 6e f. vector-len
0280: 67 74 68 0a 20 20 20 20 3b 3b 3b 20 2a 20 49 74 gth. ;;; * It
0290: 65 72 61 74 69 6f 6e 0a 20 20 20 20 76 65 63 74 eration. vect
02a0: 6f 72 2d 66 6f 6c 64 20 20 20 20 20 20 20 20 20 or-fold
02b0: 20 20 76 65 63 74 6f 72 2d 66 6f 6c 64 2d 72 69 vector-fold-ri
02c0: 67 68 74 0a 20 20 20 20 76 65 63 74 6f 72 2d 6d ght. vector-m
02d0: 61 70 20 20 20 20 20 20 20 20 20 20 20 20 76 65 ap ve
02e0: 63 74 6f 72 2d 6d 61 70 21 0a 20 20 20 20 76 65 ctor-map!. ve
02f0: 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68 0a 20 20 ctor-for-each.
0300: 20 20 76 65 63 74 6f 72 2d 63 6f 75 6e 74 0a 20 vector-count.
0310: 20 20 20 3b 3b 3b 20 2a 20 53 65 61 72 63 68 69 ;;; * Searchi
0320: 6e 67 0a 20 20 20 20 76 65 63 74 6f 72 2d 69 6e ng. vector-in
0330: 64 65 78 20 20 20 20 20 20 20 20 20 20 76 65 63 dex vec
0340: 74 6f 72 2d 73 6b 69 70 0a 20 20 20 20 76 65 63 tor-skip. vec
0350: 74 6f 72 2d 69 6e 64 65 78 2d 72 69 67 68 74 20 tor-index-right
0360: 20 20 20 76 65 63 74 6f 72 2d 73 6b 69 70 2d 72 vector-skip-r
0370: 69 67 68 74 0a 20 20 20 20 76 65 63 74 6f 72 2d ight. vector-
0380: 62 69 6e 61 72 79 2d 73 65 61 72 63 68 20 20 76 binary-search v
0390: 65 63 74 6f 72 2d 61 6e 79 20 20 20 20 76 65 63 ector-any vec
03a0: 74 6f 72 2d 65 76 65 72 79 0a 20 20 20 20 3b 3b tor-every. ;;
03b0: 3b 20 2a 20 4d 75 74 61 74 6f 72 73 0a 20 20 20 ; * Mutators.
03c0: 20 76 65 63 74 6f 72 2d 73 65 74 21 0a 20 20 20 vector-set!.
03d0: 20 76 65 63 74 6f 72 2d 73 77 61 70 21 0a 20 20 vector-swap!.
03e0: 20 20 3b 3b 20 28 72 65 6e 61 6d 65 20 28 6d 79 ;; (rename (my
03f0: 3a 76 65 63 74 6f 72 2d 66 69 6c 6c 21 20 76 65 :vector-fill! ve
0400: 63 74 6f 72 2d 66 69 6c 6c 21 29 29 0a 20 20 20 ctor-fill!)).
0410: 20 76 65 63 74 6f 72 2d 66 69 6c 6c 21 0a 20 20 vector-fill!.
0420: 20 20 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 vector-reverse
0430: 21 0a 20 20 20 20 76 65 63 74 6f 72 2d 63 6f 70 !. vector-cop
0440: 79 21 20 20 20 20 20 20 20 20 20 20 76 65 63 74 y! vect
0450: 6f 72 2d 72 65 76 65 72 73 65 2d 63 6f 70 79 21 or-reverse-copy!
0460: 0a 20 20 20 20 3b 3b 3b 20 2a 20 43 6f 6e 76 65 . ;;; * Conve
0470: 72 73 69 6f 6e 0a 20 20 20 20 3b 3b 20 28 72 65 rsion. ;; (re
0480: 6e 61 6d 65 20 28 6d 79 3a 76 65 63 74 6f 72 2d name (my:vector-
0490: 3e 6c 69 73 74 20 76 65 63 74 6f 72 2d 3e 6c 69 >list vector->li
04a0: 73 74 29 29 0a 20 20 20 20 76 65 63 74 6f 72 2d st)). vector-
04b0: 3e 6c 69 73 74 20 72 65 76 65 72 73 65 2d 76 65 >list reverse-ve
04c0: 63 74 6f 72 2d 3e 6c 69 73 74 0a 20 20 20 20 3b ctor->list. ;
04d0: 3b 20 28 72 65 6e 61 6d 65 20 28 6d 79 3a 6c 69 ; (rename (my:li
04e0: 73 74 2d 3e 76 65 63 74 6f 72 20 6c 69 73 74 2d st->vector list-
04f0: 3e 76 65 63 74 6f 72 29 29 0a 20 20 20 20 6c 69 >vector)). li
0500: 73 74 2d 3e 76 65 63 74 6f 72 0a 20 20 20 20 72 st->vector. r
0510: 65 76 65 72 73 65 2d 6c 69 73 74 2d 3e 76 65 63 everse-list->vec
0520: 74 6f 72 20 29 0a 20 20 28 69 6d 70 6f 72 74 0a tor ). (import.
0530: 20 20 20 20 28 65 78 63 65 70 74 20 28 72 6e 72 (except (rnr
0540: 73 29 20 76 65 63 74 6f 72 2d 6d 61 70 20 76 65 s) vector-map ve
0550: 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68 20 76 65 ctor-for-each ve
0560: 63 74 6f 72 2d 66 69 6c 6c 21 20 76 65 63 74 6f ctor-fill! vecto
0570: 72 2d 3e 6c 69 73 74 0a 20 20 20 20 20 20 20 20 r->list.
0580: 20 20 20 20 6c 69 73 74 2d 3e 76 65 63 74 6f 72 list->vector
0590: 29 0a 20 20 20 20 28 72 6e 72 73 20 72 35 72 73 ). (rnrs r5rs
05a0: 29 0a 20 20 20 20 3b 3b 20 28 73 72 66 69 20 73 ). ;; (srfi s
05b0: 32 33 20 65 72 72 6f 72 20 74 72 69 63 6b 73 29 23 error tricks)
05c0: 0a 20 20 20 20 28 73 72 66 69 20 73 38 20 72 65 . (srfi s8 re
05d0: 63 65 69 76 65 29 0a 20 20 20 20 3b 3b 20 28 66 ceive). ;; (f
05e0: 6f 72 20 28 73 72 66 69 20 70 72 69 76 61 74 65 or (srfi private
05f0: 20 76 61 6e 69 73 68 29 20 65 78 70 61 6e 64 29 vanish) expand)
0600: 0a 20 20 20 20 3b 3b 20 28 73 72 66 69 20 70 72 . ;; (srfi pr
0610: 69 76 61 74 65 20 69 6e 63 6c 75 64 65 29 0a 0a ivate include)..
0620: 20 20 20 20 29 0a 0a 20 20 3b 3b 20 49 20 64 6f ).. ;; I do
0630: 20 74 68 65 73 65 20 6c 65 74 2d 73 79 6e 74 61 these let-synta
0640: 78 20 74 72 69 63 6b 73 20 73 6f 20 74 68 65 20 x tricks so the
0650: 6f 72 69 67 69 6e 61 6c 20 76 65 63 74 6f 72 2d original vector-
0660: 6c 69 62 2e 73 63 6d 20 66 69 6c 65 20 64 6f 65 lib.scm file doe
0670: 73 0a 20 20 3b 3b 20 6e 6f 74 20 68 61 76 65 20 s. ;; not have
0680: 74 6f 20 62 65 20 6d 6f 64 69 66 69 65 64 20 61 to be modified a
0690: 74 20 61 6c 6c 2e 0a 20 20 3b 3b 20 28 6c 65 74 t all.. ;; (let
06a0: 2d 73 79 6e 74 61 78 0a 20 20 3b 3b 20 20 20 20 -syntax. ;;
06b0: 20 28 28 64 65 66 69 6e 65 0a 20 20 3b 3b 20 20 ((define. ;;
06c0: 20 20 20 20 20 28 6c 65 74 20 28 28 76 64 20 28 (let ((vd (
06d0: 76 61 6e 69 73 68 2d 64 65 66 69 6e 65 20 64 65 vanish-define de
06e0: 66 69 6e 65 0a 20 20 3b 3b 20 20 20 20 20 20 20 fine. ;;
06f0: 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 (make
0700: 2d 76 65 63 74 6f 72 20 76 65 63 74 6f 72 20 76 -vector vector v
0710: 65 63 74 6f 72 3f 20 76 65 63 74 6f 72 2d 72 65 ector? vector-re
0720: 66 20 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 f vector-set! ve
0730: 63 74 6f 72 2d 6c 65 6e 67 74 68 29 29 29 29 0a ctor-length)))).
0740: 20 20 3b 3b 20 20 20 20 20 20 20 20 20 28 6c 61 ;; (la
0750: 6d 62 64 61 20 28 73 74 78 29 0a 20 20 3b 3b 20 mbda (stx). ;;
0760: 20 20 20 20 20 20 20 20 20 20 28 64 65 66 69 6e (defin
0770: 65 20 28 72 65 6e 61 6d 65 3f 20 69 64 29 0a 20 e (rename? id).
0780: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
0790: 28 6d 65 6d 70 20 28 6c 61 6d 62 64 61 20 28 78 (memp (lambda (x
07a0: 29 20 28 66 72 65 65 2d 69 64 65 6e 74 69 66 69 ) (free-identifi
07b0: 65 72 3d 3f 20 69 64 20 78 29 29 0a 20 20 3b 3b er=? id x)). ;;
07c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07d0: 20 20 20 28 6c 69 73 74 20 23 27 76 65 63 74 6f (list #'vecto
07e0: 72 2d 66 69 6c 6c 21 20 23 27 76 65 63 74 6f 72 r-fill! #'vector
07f0: 2d 3e 6c 69 73 74 20 23 27 6c 69 73 74 2d 3e 76 ->list #'list->v
0800: 65 63 74 6f 72 29 29 29 0a 20 20 3b 3b 20 20 20 ector))). ;;
0810: 20 20 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 (define
0820: 28 72 65 6e 61 6d 65 20 69 64 29 0a 20 20 3b 3b (rename id). ;;
0830: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 61 (da
0840: 74 75 6d 2d 3e 73 79 6e 74 61 78 20 69 64 0a 20 tum->syntax id.
0850: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
0860: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
0870: 0a 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 . ;;
0880: 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 (string-appe
0890: 6e 64 20 22 6d 79 3a 22 20 28 73 79 6d 62 6f 6c nd "my:" (symbol
08a0: 2d 3e 73 74 72 69 6e 67 20 28 73 79 6e 74 61 78 ->string (syntax
08b0: 2d 3e 64 61 74 75 6d 20 69 64 29 29 29 29 29 29 ->datum id))))))
08c0: 0a 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 . ;;
08d0: 28 73 79 6e 74 61 78 2d 63 61 73 65 20 73 74 78 (syntax-case stx
08e0: 20 28 29 0a 20 20 3b 3b 20 20 20 20 20 20 20 20 (). ;;
08f0: 20 20 20 20 20 28 28 5f 20 6e 61 6d 65 20 2e 20 ((_ name .
0900: 72 29 0a 20 20 3b 3b 20 20 20 20 20 20 20 20 20 r). ;;
0910: 20 20 20 20 20 28 61 6e 64 20 28 69 64 65 6e 74 (and (ident
0920: 69 66 69 65 72 3f 20 23 27 6e 61 6d 65 29 0a 20 ifier? #'name).
0930: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
0940: 20 20 20 20 20 20 28 72 65 6e 61 6d 65 3f 20 23 (rename? #
0950: 27 6e 61 6d 65 29 29 0a 20 20 3b 3b 20 20 20 20 'name)). ;;
0960: 20 20 20 20 20 20 20 20 20 20 23 60 28 64 65 66 #`(def
0970: 69 6e 65 20 23 2c 28 72 65 6e 61 6d 65 20 23 27 ine #,(rename #'
0980: 6e 61 6d 65 29 20 2e 20 72 29 29 0a 20 20 3b 3b name) . r)). ;;
0990: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 5f 20 (_
09a0: 28 76 64 20 73 74 78 29 29 29 29 29 29 0a 20 20 (vd stx)))))).
09b0: 3b 3b 20 20 20 20 20 20 28 64 65 66 69 6e 65 2d ;; (define-
09c0: 73 79 6e 74 61 78 0a 20 20 3b 3b 20 20 20 20 20 syntax. ;;
09d0: 20 20 28 76 61 6e 69 73 68 2d 64 65 66 69 6e 65 (vanish-define
09e0: 20 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 0a 20 define-syntax.
09f0: 20 3b 3b 20 20 20 20 20 20 20 20 28 72 65 63 65 ;; (rece
0a00: 69 76 65 29 29 29 29 0a 20 20 3b 3b 20 20 20 28 ive)))). ;; (
0a10: 53 52 46 49 2d 32 33 2d 65 72 72 6f 72 2d 3e 52 SRFI-23-error->R
0a20: 36 52 53 20 22 28 6c 69 62 72 61 72 79 20 28 73 6RS "(library (s
0a30: 72 66 69 20 73 34 33 20 76 65 63 74 6f 72 73 29 rfi s43 vectors)
0a40: 29 22 0a 20 20 3b 3b 20 20 20 20 28 69 6e 63 6c )". ;; (incl
0a50: 75 64 65 2f 72 65 73 6f 6c 76 65 20 28 22 73 72 ude/resolve ("sr
0a60: 66 69 22 20 22 73 34 33 22 29 20 22 76 65 63 74 fi" "s43") "vect
0a70: 6f 72 2d 6c 69 62 2e 73 63 6d 22 29 29 29 0a 0a or-lib.scm")))..
0a80: 3b 3b 20 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;; ;;;;;;;;;;;;;
0a90: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0aa0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0ab0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0ac0: 3b 3b 3b 3b 3b 3b 0a 0a 3b 3b 3b 3b 3b 3b 20 53 ;;;;;;..;;;;;; S
0ad0: 52 46 49 20 34 33 3a 20 56 65 63 74 6f 72 20 6c RFI 43: Vector l
0ae0: 69 62 72 61 72 79 20 20 20 20 20 20 20 20 20 20 ibrary
0af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b00: 20 2d 2a 2d 20 53 63 68 65 6d 65 20 2d 2a 2d 0a -*- Scheme -*-.
0b10: 3b 3b 3b 0a 3b 3b 3b 20 54 61 79 6c 6f 72 20 43 ;;;.;;; Taylor C
0b20: 61 6d 70 62 65 6c 6c 20 77 72 6f 74 65 20 74 68 ampbell wrote th
0b30: 69 73 20 63 6f 64 65 3b 20 68 65 20 70 6c 61 63 is code; he plac
0b40: 65 73 20 69 74 20 69 6e 20 74 68 65 20 70 75 62 es it in the pub
0b50: 6c 69 63 20 64 6f 6d 61 69 6e 2e 0a 3b 3b 3b 20 lic domain..;;;
0b60: 57 69 6c 6c 20 43 6c 69 6e 67 65 72 20 5b 77 64 Will Clinger [wd
0b70: 63 5d 20 6d 61 64 65 20 73 6f 6d 65 20 63 6f 72 c] made some cor
0b80: 72 65 63 74 69 6f 6e 73 2c 20 61 6c 73 6f 20 69 rections, also i
0b90: 6e 20 74 68 65 20 70 75 62 6c 69 63 20 64 6f 6d n the public dom
0ba0: 61 69 6e 2e 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d ain...;;; ------
0bb0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b --------------.;
0bc0: 3b 3b 20 45 78 70 6f 72 74 65 64 20 70 72 6f 63 ;; Exported proc
0bd0: 65 64 75 72 65 20 69 6e 64 65 78 0a 3b 3b 3b 0a edure index.;;;.
0be0: 3b 3b 3b 20 2a 20 43 6f 6e 73 74 72 75 63 74 6f ;;; * Constructo
0bf0: 72 73 0a 3b 3b 3b 20 6d 61 6b 65 2d 76 65 63 74 rs.;;; make-vect
0c00: 6f 72 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 76 65 or vector.;;; ve
0c10: 63 74 6f 72 2d 75 6e 66 6f 6c 64 20 20 20 20 20 ctor-unfold
0c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 65 ve
0c30: 63 74 6f 72 2d 75 6e 66 6f 6c 64 2d 72 69 67 68 ctor-unfold-righ
0c40: 74 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 63 6f 70 t.;;; vector-cop
0c50: 79 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y
0c60: 20 20 20 20 20 20 76 65 63 74 6f 72 2d 72 65 76 vector-rev
0c70: 65 72 73 65 2d 63 6f 70 79 0a 3b 3b 3b 20 76 65 erse-copy.;;; ve
0c80: 63 74 6f 72 2d 61 70 70 65 6e 64 20 20 20 20 20 ctor-append
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 65 ve
0ca0: 63 74 6f 72 2d 63 6f 6e 63 61 74 65 6e 61 74 65 ctor-concatenate
0cb0: 0a 3b 3b 3b 0a 3b 3b 3b 20 2a 20 50 72 65 64 69 .;;;.;;; * Predi
0cc0: 63 61 74 65 73 0a 3b 3b 3b 20 76 65 63 74 6f 72 cates.;;; vector
0cd0: 3f 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 65 6d 70 ?.;;; vector-emp
0ce0: 74 79 3f 0a 3b 3b 3b 20 76 65 63 74 6f 72 3d 0a ty?.;;; vector=.
0cf0: 3b 3b 3b 0a 3b 3b 3b 20 2a 20 53 65 6c 65 63 74 ;;;.;;; * Select
0d00: 6f 72 73 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 72 ors.;;; vector-r
0d10: 65 66 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 6c 65 ef.;;; vector-le
0d20: 6e 67 74 68 0a 3b 3b 3b 0a 3b 3b 3b 20 2a 20 49 ngth.;;;.;;; * I
0d30: 74 65 72 61 74 69 6f 6e 0a 3b 3b 3b 20 76 65 63 teration.;;; vec
0d40: 74 6f 72 2d 66 6f 6c 64 20 20 20 20 20 20 20 20 tor-fold
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 65 63 vec
0d60: 74 6f 72 2d 66 6f 6c 64 2d 72 69 67 68 74 0a 3b tor-fold-right.;
0d70: 3b 3b 20 76 65 63 74 6f 72 2d 6d 61 70 20 20 20 ;; vector-map
0d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d90: 20 20 20 76 65 63 74 6f 72 2d 6d 61 70 21 0a 3b vector-map!.;
0da0: 3b 3b 20 76 65 63 74 6f 72 2d 66 6f 72 2d 65 61 ;; vector-for-ea
0db0: 63 68 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 63 6f ch.;;; vector-co
0dc0: 75 6e 74 0a 3b 3b 3b 0a 3b 3b 3b 20 2a 20 53 65 unt.;;;.;;; * Se
0dd0: 61 72 63 68 69 6e 67 0a 3b 3b 3b 20 76 65 63 74 arching.;;; vect
0de0: 6f 72 2d 69 6e 64 65 78 20 20 20 20 20 20 20 20 or-index
0df0: 20 20 20 20 20 20 20 20 20 20 20 20 76 65 63 74 vect
0e00: 6f 72 2d 73 6b 69 70 0a 3b 3b 3b 20 76 65 63 74 or-skip.;;; vect
0e10: 6f 72 2d 69 6e 64 65 78 2d 72 69 67 68 74 20 20 or-index-right
0e20: 20 20 20 20 20 20 20 20 20 20 20 20 76 65 63 74 vect
0e30: 6f 72 2d 73 6b 69 70 2d 72 69 67 68 74 0a 3b 3b or-skip-right.;;
0e40: 3b 20 76 65 63 74 6f 72 2d 62 69 6e 61 72 79 2d ; vector-binary-
0e50: 73 65 61 72 63 68 0a 3b 3b 3b 20 76 65 63 74 6f search.;;; vecto
0e60: 72 2d 61 6e 79 20 20 20 20 20 20 20 20 20 20 20 r-any
0e70: 20 20 20 20 20 20 20 20 20 20 20 76 65 63 74 6f vecto
0e80: 72 2d 65 76 65 72 79 0a 3b 3b 3b 0a 3b 3b 3b 20 r-every.;;;.;;;
0e90: 2a 20 4d 75 74 61 74 6f 72 73 0a 3b 3b 3b 20 76 * Mutators.;;; v
0ea0: 65 63 74 6f 72 2d 73 65 74 21 0a 3b 3b 3b 20 76 ector-set!.;;; v
0eb0: 65 63 74 6f 72 2d 73 77 61 70 21 0a 3b 3b 3b 20 ector-swap!.;;;
0ec0: 76 65 63 74 6f 72 2d 66 69 6c 6c 21 0a 3b 3b 3b vector-fill!.;;;
0ed0: 20 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 21 vector-reverse!
0ee0: 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 63 6f 70 79 .;;; vector-copy
0ef0: 21 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 !
0f00: 20 20 20 20 20 76 65 63 74 6f 72 2d 72 65 76 65 vector-reve
0f10: 72 73 65 2d 63 6f 70 79 21 0a 3b 3b 3b 20 76 65 rse-copy!.;;; ve
0f20: 63 74 6f 72 2d 72 65 76 65 72 73 65 21 0a 3b 3b ctor-reverse!.;;
0f30: 3b 0a 3b 3b 3b 20 2a 20 43 6f 6e 76 65 72 73 69 ;.;;; * Conversi
0f40: 6f 6e 0a 3b 3b 3b 20 76 65 63 74 6f 72 2d 3e 6c on.;;; vector->l
0f50: 69 73 74 20 20 20 20 20 20 20 20 20 20 20 20 20 ist
0f60: 20 20 20 20 20 20 20 72 65 76 65 72 73 65 2d 76 reverse-v
0f70: 65 63 74 6f 72 2d 3e 6c 69 73 74 0a 3b 3b 3b 20 ector->list.;;;
0f80: 6c 69 73 74 2d 3e 76 65 63 74 6f 72 20 20 20 20 list->vector
0f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fa0: 72 65 76 65 72 73 65 2d 6c 69 73 74 2d 3e 76 65 reverse-list->ve
0fb0: 63 74 6f 72 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d 2d ctor.....;;; ---
0fc0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0fd0: 2d 0a 3b 3b 3b 20 43 6f 6d 6d 65 6e 74 61 72 79 -.;;; Commentary
0fe0: 20 6f 6e 20 65 66 66 69 63 69 65 6e 63 79 20 6f on efficiency o
0ff0: 66 20 74 68 65 20 63 6f 64 65 0a 0a 3b 3b 3b 20 f the code..;;;
1000: 54 68 69 73 20 63 6f 64 65 20 69 73 20 73 6f 6d This code is som
1010: 65 77 68 61 74 20 74 75 6e 65 64 20 66 6f 72 20 ewhat tuned for
1020: 65 66 66 69 63 69 65 6e 63 79 2e 20 20 54 68 65 efficiency. The
1030: 72 65 20 61 72 65 20 73 65 76 65 72 61 6c 0a 3b re are several.;
1040: 3b 3b 20 69 6e 74 65 72 6e 61 6c 20 72 6f 75 74 ;; internal rout
1050: 69 6e 65 73 20 74 68 61 74 20 63 61 6e 20 62 65 ines that can be
1060: 20 6f 70 74 69 6d 69 7a 65 64 20 67 72 65 61 74 optimized great
1070: 6c 79 20 74 6f 20 67 72 65 61 74 6c 79 20 69 6d ly to greatly im
1080: 70 72 6f 76 65 0a 3b 3b 3b 20 74 68 65 20 70 65 prove.;;; the pe
1090: 72 66 6f 72 6d 61 6e 63 65 20 6f 66 20 6d 75 63 rformance of muc
10a0: 68 20 6f 66 20 74 68 65 20 6c 69 62 72 61 72 79 h of the library
10b0: 2e 20 20 54 68 65 73 65 20 69 6e 74 65 72 6e 61 . These interna
10c0: 6c 20 70 72 6f 63 65 64 75 72 65 73 0a 3b 3b 3b l procedures.;;;
10d0: 20 61 72 65 20 61 6c 72 65 61 64 79 20 63 61 72 are already car
10e0: 65 66 75 6c 6c 79 20 74 75 6e 65 64 20 66 6f 72 efully tuned for
10f0: 20 70 65 72 66 6f 72 6d 61 6e 63 65 2c 20 61 6e performance, an
1100: 64 20 6c 61 6d 62 64 61 2d 6c 69 66 74 65 64 20 d lambda-lifted
1110: 62 79 0a 3b 3b 3b 20 68 61 6e 64 2e 20 20 53 6f by.;;; hand. So
1120: 6d 65 20 6f 74 68 65 72 20 72 6f 75 74 69 6e 65 me other routine
1130: 73 20 61 72 65 20 6c 61 6d 62 64 61 2d 6c 69 66 s are lambda-lif
1140: 74 65 64 20 62 79 20 68 61 6e 64 2c 20 62 75 74 ted by hand, but
1150: 20 6f 6e 6c 79 20 74 68 65 0a 3b 3b 3b 20 6c 6f only the.;;; lo
1160: 6f 70 73 20 61 72 65 20 6c 61 6d 62 64 61 2d 6c ops are lambda-l
1170: 69 66 74 65 64 2c 20 61 6e 64 20 6f 6e 6c 79 20 ifted, and only
1180: 69 66 20 73 6f 6d 65 20 72 6f 75 74 69 6e 65 20 if some routine
1190: 68 61 73 20 74 77 6f 20 70 6f 73 73 69 62 6c 65 has two possible
11a0: 0a 3b 3b 3b 20 6c 6f 6f 70 73 20 2d 2d 20 61 20 .;;; loops -- a
11b0: 66 61 73 74 20 70 61 74 68 20 61 6e 64 20 61 6e fast path and an
11c0: 20 6e 2d 61 72 79 20 63 61 73 65 20 2d 2d 2c 20 n-ary case --,
11d0: 77 68 65 72 65 61 73 20 5f 61 6c 6c 5f 20 6f 66 whereas _all_ of
11e0: 20 74 68 65 0a 3b 3b 3b 20 69 6e 74 65 72 6e 61 the.;;; interna
11f0: 6c 20 72 6f 75 74 69 6e 65 73 27 20 6c 6f 6f 70 l routines' loop
1200: 73 20 61 72 65 20 6c 61 6d 62 64 61 2d 6c 69 66 s are lambda-lif
1210: 74 65 64 20 73 6f 20 61 73 20 74 6f 20 6e 65 76 ted so as to nev
1220: 65 72 20 63 6f 6e 73 20 61 0a 3b 3b 3b 20 63 6c er cons a.;;; cl
1230: 6f 73 75 72 65 20 69 6e 20 74 68 65 69 72 20 62 osure in their b
1240: 6f 64 79 20 28 56 45 43 54 4f 52 2d 50 41 52 53 ody (VECTOR-PARS
1250: 45 2d 53 54 41 52 54 2b 45 4e 44 20 64 6f 65 73 E-START+END does
1260: 6e 27 74 20 68 61 76 65 20 61 20 6c 6f 6f 70 29 n't have a loop)
1270: 2c 0a 3b 3b 3b 20 65 76 65 6e 20 69 6e 20 53 63 ,.;;; even in Sc
1280: 68 65 6d 65 20 73 79 73 74 65 6d 73 20 74 68 61 heme systems tha
1290: 74 20 70 65 72 66 6f 72 6d 20 6e 6f 20 6c 6f 6f t perform no loo
12a0: 70 20 6f 70 74 69 6d 69 7a 61 74 69 6f 6e 20 28 p optimization (
12b0: 77 68 69 63 68 20 69 73 0a 3b 3b 3b 20 6d 6f 73 which is.;;; mos
12c0: 74 20 6f 66 20 74 68 65 6d 2c 20 75 6e 66 6f 72 t of them, unfor
12d0: 74 75 6e 61 74 65 6c 79 29 2e 0a 3b 3b 3b 0a 3b tunately)..;;;.;
12e0: 3b 3b 20 46 61 73 74 20 70 61 74 68 73 20 61 72 ;; Fast paths ar
12f0: 65 20 70 72 6f 76 69 64 65 64 20 66 6f 72 20 63 e provided for c
1300: 6f 6d 6d 6f 6e 20 63 61 73 65 73 20 69 6e 20 6d ommon cases in m
1310: 6f 73 74 20 6f 66 20 74 68 65 20 6c 6f 6f 70 73 ost of the loops
1320: 20 69 6e 0a 3b 3b 3b 20 74 68 69 73 20 6c 69 62 in.;;; this lib
1330: 72 61 72 79 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 41 6c rary..;;;.;;; Al
1340: 6c 20 63 61 6c 6c 73 20 74 6f 20 70 72 69 6d 69 l calls to primi
1350: 74 69 76 65 20 76 65 63 74 6f 72 20 6f 70 65 72 tive vector oper
1360: 61 74 69 6f 6e 73 20 61 72 65 20 70 72 6f 74 65 ations are prote
1370: 63 74 65 64 20 62 79 20 61 20 70 72 69 6f 72 0a cted by a prior.
1380: 3b 3b 3b 20 74 79 70 65 20 63 68 65 63 6b 3b 20 ;;; type check;
1390: 74 68 65 79 20 63 61 6e 20 62 65 20 73 61 66 65 they can be safe
13a0: 6c 79 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 ly converted to
13b0: 75 73 65 20 75 6e 73 61 66 65 20 65 71 75 69 76 use unsafe equiv
13c0: 61 6c 65 6e 74 73 0a 3b 3b 3b 20 6f 66 20 74 68 alents.;;; of th
13d0: 65 20 6f 70 65 72 61 74 69 6f 6e 73 2c 20 69 66 e operations, if
13e0: 20 61 76 61 69 6c 61 62 6c 65 2e 20 20 49 64 65 available. Ide
13f0: 61 6c 6c 79 2c 20 74 68 65 20 63 6f 6d 70 69 6c ally, the compil
1400: 65 72 20 73 68 6f 75 6c 64 20 62 65 0a 3b 3b 3b er should be.;;;
1410: 20 61 62 6c 65 20 74 6f 20 64 65 74 65 72 6d 69 able to determi
1420: 6e 65 20 74 68 69 73 2c 20 62 75 74 20 74 68 65 ne this, but the
1430: 20 73 74 61 74 65 20 6f 66 20 53 63 68 65 6d 65 state of Scheme
1440: 20 63 6f 6d 70 69 6c 65 72 73 20 74 6f 64 61 79 compilers today
1450: 20 69 73 0a 3b 3b 3b 20 6e 6f 74 20 61 20 68 61 is.;;; not a ha
1460: 70 70 79 20 6f 6e 65 2e 0a 3b 3b 3b 0a 3b 3b 3b ppy one..;;;.;;;
1470: 20 45 66 66 69 63 69 65 6e 63 79 20 6f 66 20 74 Efficiency of t
1480: 68 65 20 61 63 74 75 61 6c 20 61 6c 67 6f 72 69 he actual algori
1490: 74 68 6d 73 20 69 73 20 61 20 72 61 74 68 65 72 thms is a rather
14a0: 20 6d 75 6e 64 61 6e 65 20 70 6f 69 6e 74 20 74 mundane point t
14b0: 6f 0a 3b 3b 3b 20 6d 65 6e 74 69 6f 6e 3b 20 76 o.;;; mention; v
14c0: 65 63 74 6f 72 20 6f 70 65 72 61 74 69 6f 6e 73 ector operations
14d0: 20 61 72 65 20 72 61 72 65 6c 79 20 62 65 79 6f are rarely beyo
14e0: 6e 64 20 62 65 69 6e 67 20 73 74 72 61 69 67 68 nd being straigh
14f0: 74 66 6f 72 77 61 72 64 2e 0a 0a 0c 0a 0a 3b 3b tforward......;;
1500: 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ; --------------
1510: 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 55 74 69 6c 69 ------.;;; Utili
1520: 74 69 65 73 0a 0a 3b 3b 3b 20 53 52 46 49 20 38 ties..;;; SRFI 8
1530: 2c 20 74 6f 6f 20 74 72 69 76 69 61 6c 20 74 6f , too trivial to
1540: 20 70 75 74 20 69 6e 20 74 68 65 20 64 65 70 65 put in the depe
1550: 6e 64 65 6e 63 69 65 73 20 6c 69 73 74 2e 0a 3b ndencies list..;
1560: 3b 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ; (define-syntax
1570: 20 72 65 63 65 69 76 65 0a 3b 3b 20 20 20 28 73 receive.;; (s
1580: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 3b yntax-rules ().;
1590: 3b 20 20 20 20 20 28 28 72 65 63 65 69 76 65 20 ; ((receive
15a0: 3f 66 6f 72 6d 61 6c 73 20 3f 70 72 6f 64 75 63 ?formals ?produc
15b0: 65 72 20 3f 62 6f 64 79 31 20 3f 62 6f 64 79 32 er ?body1 ?body2
15c0: 20 2e 2e 2e 29 0a 3b 3b 20 20 20 20 20 20 28 63 ...).;; (c
15d0: 61 6c 6c 2d 77 69 74 68 2d 76 61 6c 75 65 73 20 all-with-values
15e0: 28 6c 61 6d 62 64 61 20 28 29 20 3f 70 72 6f 64 (lambda () ?prod
15f0: 75 63 65 72 29 0a 3b 3b 20 20 20 20 20 20 20 20 ucer).;;
1600: 28 6c 61 6d 62 64 61 20 3f 66 6f 72 6d 61 6c 73 (lambda ?formals
1610: 20 3f 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e ?body1 ?body2 .
1620: 2e 2e 29 29 29 29 29 0a 0a 3b 3b 3b 20 4e 6f 74 ..)))))..;;; Not
1630: 20 74 68 65 20 62 65 73 74 20 4c 45 54 2a 2d 4f the best LET*-O
1640: 50 54 49 4f 4e 41 4c 53 2c 20 62 75 74 20 6e 6f PTIONALS, but no
1650: 74 20 74 68 65 20 77 6f 72 73 74 2c 20 65 69 74 t the worst, eit
1660: 68 65 72 2e 20 20 55 73 65 20 4f 6c 69 6e 27 73 her. Use Olin's
1670: 0a 3b 3b 3b 20 69 66 20 69 74 27 73 20 61 76 61 .;;; if it's ava
1680: 69 6c 61 62 6c 65 20 74 6f 20 79 6f 75 2e 0a 28 ilable to you..(
1690: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6c 65 define-syntax le
16a0: 74 2a 2d 6f 70 74 69 6f 6e 61 6c 73 0a 20 20 28 t*-optionals. (
16b0: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a syntax-rules ().
16c0: 20 20 20 20 28 28 6c 65 74 2a 2d 6f 70 74 69 6f ((let*-optio
16d0: 6e 61 6c 73 20 28 3f 78 20 2e 2e 2e 29 20 28 28 nals (?x ...) ((
16e0: 3f 76 61 72 20 3f 64 65 66 61 75 6c 74 29 20 2e ?var ?default) .
16f0: 2e 2e 29 20 3f 62 6f 64 79 31 20 3f 62 6f 64 79 ..) ?body1 ?body
1700: 32 20 2e 2e 2e 29 0a 20 20 20 20 20 28 6c 65 74 2 ...). (let
1710: 20 28 28 61 72 67 73 20 28 3f 78 20 2e 2e 2e 29 ((args (?x ...)
1720: 29 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 2d )). (let*-
1730: 6f 70 74 69 6f 6e 61 6c 73 20 61 72 67 73 20 28 optionals args (
1740: 28 3f 76 61 72 20 3f 64 65 66 61 75 6c 74 29 20 (?var ?default)
1750: 2e 2e 2e 29 20 3f 62 6f 64 79 31 20 3f 62 6f 64 ...) ?body1 ?bod
1760: 79 32 20 2e 2e 2e 29 29 29 0a 20 20 20 20 28 28 y2 ...))). ((
1770: 6c 65 74 2a 2d 6f 70 74 69 6f 6e 61 6c 73 20 3f let*-optionals ?
1780: 61 72 67 73 20 28 28 3f 76 61 72 20 3f 64 65 66 args ((?var ?def
1790: 61 75 6c 74 29 20 2e 2e 2e 29 20 3f 62 6f 64 79 ault) ...) ?body
17a0: 31 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 0a 20 20 1 ?body2 ...).
17b0: 20 20 20 28 6c 65 74 2a 2d 6f 70 74 69 6f 6e 61 (let*-optiona
17c0: 6c 73 3a 61 75 78 20 3f 61 72 67 73 20 3f 61 72 ls:aux ?args ?ar
17d0: 67 73 20 28 28 3f 76 61 72 20 3f 64 65 66 61 75 gs ((?var ?defau
17e0: 6c 74 29 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 lt) ...).
17f0: 3f 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e 2e ?body1 ?body2 ..
1800: 2e 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 .))))..(define-s
1810: 79 6e 74 61 78 20 6c 65 74 2a 2d 6f 70 74 69 6f yntax let*-optio
1820: 6e 61 6c 73 3a 61 75 78 0a 20 20 28 73 79 6e 74 nals:aux. (synt
1830: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 ax-rules ().
1840: 28 28 61 75 78 20 3f 6f 72 69 67 2d 61 72 67 73 ((aux ?orig-args
1850: 2d 76 61 72 20 3f 61 72 67 73 2d 76 61 72 20 28 -var ?args-var (
1860: 29 20 3f 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 ) ?body1 ?body2
1870: 2e 2e 2e 29 0a 20 20 20 20 20 28 69 66 20 28 6e ...). (if (n
1880: 75 6c 6c 3f 20 3f 61 72 67 73 2d 76 61 72 29 0a ull? ?args-var).
1890: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 29 (let ()
18a0: 20 3f 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e ?body1 ?body2 .
18b0: 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 28 65 72 ..). (er
18c0: 72 6f 72 20 22 74 6f 6f 20 6d 61 6e 79 20 61 72 ror "too many ar
18d0: 67 75 6d 65 6e 74 73 22 20 28 6c 65 6e 67 74 68 guments" (length
18e0: 20 3f 6f 72 69 67 2d 61 72 67 73 2d 76 61 72 29 ?orig-args-var)
18f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1900: 20 3f 6f 72 69 67 2d 61 72 67 73 2d 76 61 72 29 ?orig-args-var)
1910: 29 29 0a 20 20 20 20 28 28 61 75 78 20 3f 6f 72 )). ((aux ?or
1920: 69 67 2d 61 72 67 73 2d 76 61 72 20 3f 61 72 67 ig-args-var ?arg
1930: 73 2d 76 61 72 0a 20 20 20 20 20 20 20 20 20 28 s-var. (
1940: 28 3f 76 61 72 20 3f 64 65 66 61 75 6c 74 29 20 (?var ?default)
1950: 3f 6d 6f 72 65 20 2e 2e 2e 29 0a 20 20 20 20 20 ?more ...).
1960: 20 20 3f 62 6f 64 79 31 20 3f 62 6f 64 79 32 20 ?body1 ?body2
1970: 2e 2e 2e 29 0a 20 20 20 20 20 28 69 66 20 28 6e ...). (if (n
1980: 75 6c 6c 3f 20 3f 61 72 67 73 2d 76 61 72 29 0a ull? ?args-var).
1990: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
19a0: 28 3f 76 61 72 20 3f 64 65 66 61 75 6c 74 29 20 (?var ?default)
19b0: 3f 6d 6f 72 65 20 2e 2e 2e 29 20 3f 62 6f 64 79 ?more ...) ?body
19c0: 31 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 0a 20 20 1 ?body2 ...).
19d0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 3f 76 (let ((?v
19e0: 61 72 20 28 63 61 72 20 3f 61 72 67 73 2d 76 61 ar (car ?args-va
19f0: 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r)).
1a00: 20 20 20 28 6e 65 77 2d 61 72 67 73 20 28 63 64 (new-args (cd
1a10: 72 20 3f 61 72 67 73 2d 76 61 72 29 29 29 0a 20 r ?args-var))).
1a20: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 2d (let*-
1a30: 6f 70 74 69 6f 6e 61 6c 73 3a 61 75 78 20 3f 6f optionals:aux ?o
1a40: 72 69 67 2d 61 72 67 73 2d 76 61 72 20 6e 65 77 rig-args-var new
1a50: 2d 61 72 67 73 0a 20 20 20 20 20 20 20 20 20 20 -args.
1a60: 20 20 20 20 20 28 3f 6d 6f 72 65 20 2e 2e 2e 29 (?more ...)
1a70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3f 62 . ?b
1a80: 6f 64 79 31 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 ody1 ?body2 ...)
1a90: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
1aa0: 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 78 29 0a 20 nonneg-int? x).
1ab0: 20 28 61 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 (and (integer?
1ac0: 78 29 0a 20 20 20 20 20 20 20 28 6e 6f 74 20 28 x). (not (
1ad0: 6e 65 67 61 74 69 76 65 3f 20 78 29 29 29 29 0a negative? x)))).
1ae0: 0a 28 64 65 66 69 6e 65 20 28 62 65 74 77 65 65 .(define (betwee
1af0: 6e 3f 20 78 20 79 20 7a 29 0a 20 20 28 61 6e 64 n? x y z). (and
1b00: 20 28 3c 20 20 78 20 79 29 0a 20 20 20 20 20 20 (< x y).
1b10: 20 28 3c 3d 20 79 20 7a 29 29 29 0a 0a 28 64 65 (<= y z)))..(de
1b20: 66 69 6e 65 20 28 75 6e 73 70 65 63 69 66 69 65 fine (unspecifie
1b30: 64 2d 76 61 6c 75 65 29 20 28 69 66 20 23 66 20 d-value) (if #f
1b40: 23 66 29 29 0a 0a 3b 2b 2b 20 54 68 69 73 20 73 #f))..;++ This s
1b50: 68 6f 75 6c 64 20 62 65 20 69 6d 70 6c 65 6d 65 hould be impleme
1b60: 6e 74 65 64 20 6d 6f 72 65 20 65 66 66 69 63 69 nted more effici
1b70: 65 6e 74 6c 79 2e 20 20 49 74 20 73 68 6f 75 6c ently. It shoul
1b80: 64 6e 27 74 20 63 6f 6e 73 20 61 0a 3b 2b 2b 20 dn't cons a.;++
1b90: 63 6c 6f 73 75 72 65 2c 20 61 6e 64 20 74 68 65 closure, and the
1ba0: 20 63 6f 6e 73 20 63 65 6c 6c 73 20 75 73 65 64 cons cells used
1bb0: 20 69 6e 20 74 68 65 20 6c 6f 6f 70 73 20 77 68 in the loops wh
1bc0: 65 6e 20 75 73 69 6e 67 20 74 68 69 73 20 63 6f en using this co
1bd0: 75 6c 64 0a 3b 2b 2b 20 62 65 20 72 65 75 73 65 uld.;++ be reuse
1be0: 64 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 63 74 d..(define (vect
1bf0: 6f 72 73 2d 72 65 66 20 76 65 63 74 6f 72 73 20 ors-ref vectors
1c00: 69 29 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 i). (map (lambd
1c10: 61 20 28 76 29 20 28 76 65 63 74 6f 72 2d 72 65 a (v) (vector-re
1c20: 66 20 76 20 69 29 29 20 76 65 63 74 6f 72 73 29 f v i)) vectors)
1c30: 29 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d ).....;;; ------
1c40: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b --------------.;
1c50: 3b 3b 20 45 72 72 6f 72 20 63 68 65 63 6b 69 6e ;; Error checkin
1c60: 67 0a 0a 3b 3b 3b 20 45 72 72 6f 72 20 73 69 67 g..;;; Error sig
1c70: 6e 61 6c 6c 69 6e 67 20 28 6e 6f 74 20 63 68 65 nalling (not che
1c80: 63 6b 69 6e 67 29 20 69 73 20 64 6f 6e 65 20 69 cking) is done i
1c90: 6e 20 61 20 77 61 79 20 74 68 61 74 20 74 72 69 n a way that tri
1ca0: 65 73 20 74 6f 20 62 65 0a 3b 3b 3b 20 61 73 20 es to be.;;; as
1cb0: 68 65 6c 70 66 75 6c 20 74 6f 20 74 68 65 20 70 helpful to the p
1cc0: 65 72 73 6f 6e 20 77 68 6f 20 67 65 74 73 20 74 erson who gets t
1cd0: 68 65 20 64 65 62 75 67 67 69 6e 67 20 70 72 6f he debugging pro
1ce0: 6d 70 74 20 61 73 20 70 6f 73 73 69 62 6c 65 2e mpt as possible.
1cf0: 0a 3b 3b 3b 20 54 68 61 74 20 73 61 69 64 2c 20 .;;; That said,
1d00: 65 72 72 6f 72 20 5f 63 68 65 63 6b 69 6e 67 5f error _checking_
1d10: 20 74 72 69 65 73 20 74 6f 20 62 65 20 61 73 20 tries to be as
1d20: 75 6e 72 65 64 75 6e 64 61 6e 74 20 61 73 20 70 unredundant as p
1d30: 6f 73 73 69 62 6c 65 2e 0a 0a 3b 3b 3b 20 49 20 ossible...;;; I
1d40: 64 6f 6e 27 74 20 75 73 65 20 61 6e 79 20 73 6f don't use any so
1d50: 72 74 20 6f 66 20 67 65 6e 65 72 61 6c 20 63 6f rt of general co
1d60: 6e 64 69 74 69 6f 6e 20 6d 65 63 68 61 6e 69 73 ndition mechanis
1d70: 6d 3b 20 49 20 75 73 65 20 73 69 6d 70 6c 79 0a m; I use simply.
1d80: 3b 3b 3b 20 53 52 46 49 20 32 33 27 73 20 45 52 ;;; SRFI 23's ER
1d90: 52 4f 52 2c 20 65 76 65 6e 20 69 6e 20 63 61 73 ROR, even in cas
1da0: 65 73 20 77 68 65 72 65 20 69 74 20 6d 69 67 68 es where it migh
1db0: 74 20 62 65 20 62 65 74 74 65 72 20 74 6f 20 75 t be better to u
1dc0: 73 65 20 73 75 63 68 0a 3b 3b 3b 20 61 20 67 65 se such.;;; a ge
1dd0: 6e 65 72 61 6c 20 63 6f 6e 64 69 74 69 6f 6e 20 neral condition
1de0: 6d 65 63 68 61 6e 69 73 6d 2e 20 20 46 69 78 20 mechanism. Fix
1df0: 74 68 61 74 20 77 68 65 6e 20 70 6f 72 74 69 6e that when portin
1e00: 67 20 74 68 69 73 20 74 6f 20 61 0a 3b 3b 3b 20 g this to a.;;;
1e10: 53 63 68 65 6d 65 20 69 6d 70 6c 65 6d 65 6e 74 Scheme implement
1e20: 61 74 69 6f 6e 20 74 68 61 74 20 68 61 73 20 69 ation that has i
1e30: 74 73 20 6f 77 6e 20 63 6f 6e 64 69 74 69 6f 6e ts own condition
1e40: 20 73 79 73 74 65 6d 2e 0a 0a 3b 3b 3b 20 49 6e system...;;; In
1e50: 20 61 72 67 75 6d 65 6e 74 20 63 68 65 63 6b 73 argument checks
1e60: 2c 20 75 70 6f 6e 20 72 65 63 65 69 76 69 6e 67 , upon receiving
1e70: 20 61 6e 20 69 6e 76 61 6c 69 64 20 61 72 67 75 an invalid argu
1e80: 6d 65 6e 74 2c 20 74 68 65 20 63 68 65 63 6b 65 ment, the checke
1e90: 72 0a 3b 3b 3b 20 70 72 6f 63 65 64 75 72 65 20 r.;;; procedure
1ea0: 72 65 63 75 72 73 69 76 65 6c 79 20 63 61 6c 6c recursively call
1eb0: 73 20 69 74 73 65 6c 66 2c 20 62 75 74 20 69 6e s itself, but in
1ec0: 20 6f 6e 65 20 6f 66 20 74 68 65 20 61 72 67 75 one of the argu
1ed0: 6d 65 6e 74 73 20 74 6f 0a 3b 3b 3b 20 69 74 73 ments to.;;; its
1ee0: 65 6c 66 20 69 73 20 61 20 63 61 6c 6c 20 74 6f elf is a call to
1ef0: 20 45 52 52 4f 52 3b 20 74 68 69 73 20 6d 65 63 ERROR; this mec
1f00: 68 61 6e 69 73 6d 20 69 73 20 75 73 65 64 20 69 hanism is used i
1f10: 6e 20 74 68 65 20 68 6f 70 65 73 20 74 68 61 74 n the hopes that
1f20: 0a 3b 3b 3b 20 74 68 65 20 75 73 65 72 20 6d 61 .;;; the user ma
1f30: 79 20 62 65 20 74 68 72 6f 77 6e 20 69 6e 74 6f y be thrown into
1f40: 20 61 20 64 65 62 75 67 67 65 72 20 70 72 6f 6d a debugger prom
1f50: 70 74 2c 20 70 72 6f 63 65 65 64 20 77 69 74 68 pt, proceed with
1f60: 20 61 6e 6f 74 68 65 72 0a 3b 3b 3b 20 76 61 6c another.;;; val
1f70: 75 65 2c 20 61 6e 64 20 6c 65 74 20 69 74 20 62 ue, and let it b
1f80: 65 20 63 68 65 63 6b 65 64 20 61 67 61 69 6e 2e e checked again.
1f90: 0a 0a 3b 3b 3b 20 54 79 70 65 20 63 68 65 63 6b ..;;; Type check
1fa0: 69 6e 67 20 69 73 20 70 72 65 74 74 79 20 62 61 ing is pretty ba
1fb0: 73 69 63 2c 20 62 75 74 20 65 61 73 69 6c 79 20 sic, but easily
1fc0: 66 61 63 74 6f 72 65 64 20 6f 75 74 20 61 6e 64 factored out and
1fd0: 20 72 65 70 6c 61 63 65 64 0a 3b 3b 3b 20 77 69 replaced.;;; wi
1fe0: 74 68 20 77 68 61 74 65 76 65 72 20 79 6f 75 72 th whatever your
1ff0: 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 27 implementation'
2000: 73 20 70 72 65 66 65 72 72 65 64 20 74 79 70 65 s preferred type
2010: 20 63 68 65 63 6b 69 6e 67 20 6d 65 74 68 6f 64 checking method
2020: 0a 3b 3b 3b 20 69 73 2e 20 20 49 20 64 6f 75 62 .;;; is. I doub
2030: 74 20 74 68 65 72 65 20 77 69 6c 6c 20 62 65 20 t there will be
2040: 6d 61 6e 79 20 6f 74 68 65 72 20 6d 65 74 68 6f many other metho
2050: 64 73 20 6f 66 20 69 6e 64 65 78 20 63 68 65 63 ds of index chec
2060: 6b 69 6e 67 2c 0a 3b 3b 3b 20 74 68 6f 75 67 68 king,.;;; though
2070: 20 74 68 65 20 69 6e 64 65 78 20 63 68 65 63 6b the index check
2080: 65 72 73 20 6d 69 67 68 74 20 62 65 20 62 65 74 ers might be bet
2090: 74 65 72 20 69 6d 70 6c 65 6d 65 6e 74 65 64 20 ter implemented
20a0: 6e 61 74 69 76 65 6c 79 2e 0a 0a 3b 3b 3b 20 28 natively...;;; (
20b0: 43 48 45 43 4b 2d 54 59 50 45 20 3c 74 79 70 65 CHECK-TYPE <type
20c0: 2d 70 72 65 64 69 63 61 74 65 3f 3e 20 3c 76 61 -predicate?> <va
20d0: 6c 75 65 3e 20 3c 63 61 6c 6c 65 65 3e 29 20 2d lue> <callee>) -
20e0: 3e 20 76 61 6c 75 65 0a 3b 3b 3b 20 20 20 45 6e > value.;;; En
20f0: 73 75 72 65 20 74 68 61 74 20 56 41 4c 55 45 20 sure that VALUE
2100: 73 61 74 69 73 66 69 65 73 20 54 59 50 45 2d 50 satisfies TYPE-P
2110: 52 45 44 49 43 41 54 45 3f 3b 20 69 66 20 6e 6f REDICATE?; if no
2120: 74 2c 20 73 69 67 6e 61 6c 20 61 6e 0a 3b 3b 3b t, signal an.;;;
2130: 20 20 20 65 72 72 6f 72 20 73 74 61 74 69 6e 67 error stating
2140: 20 74 68 61 74 20 56 41 4c 55 45 20 64 69 64 20 that VALUE did
2150: 6e 6f 74 20 73 61 74 69 73 66 79 20 54 59 50 45 not satisfy TYPE
2160: 2d 50 52 45 44 49 43 41 54 45 3f 2c 20 73 68 6f -PREDICATE?, sho
2170: 77 69 6e 67 0a 3b 3b 3b 20 20 20 74 68 61 74 20 wing.;;; that
2180: 74 68 69 73 20 68 61 70 70 65 6e 65 64 20 77 68 this happened wh
2190: 69 6c 65 20 63 61 6c 6c 69 6e 67 20 43 41 4c 4c ile calling CALL
21a0: 45 45 2e 20 20 52 65 74 75 72 6e 20 56 41 4c 55 EE. Return VALU
21b0: 45 20 69 66 20 6e 6f 0a 3b 3b 3b 20 20 20 65 72 E if no.;;; er
21c0: 72 6f 72 20 77 61 73 20 73 69 67 6e 61 6c 6c 65 ror was signalle
21d0: 64 2e 0a 28 64 65 66 69 6e 65 20 28 63 68 65 63 d..(define (chec
21e0: 6b 2d 74 79 70 65 20 70 72 65 64 3f 20 76 61 6c k-type pred? val
21f0: 75 65 20 63 61 6c 6c 65 65 29 0a 20 20 28 69 66 ue callee). (if
2200: 20 28 70 72 65 64 3f 20 76 61 6c 75 65 29 0a 20 (pred? value).
2210: 20 20 20 20 20 76 61 6c 75 65 0a 20 20 20 20 20 value.
2220: 20 3b 3b 20 52 65 63 75 72 3a 20 77 68 65 6e 20 ;; Recur: when
2230: 28 6f 72 20 69 66 29 20 74 68 65 20 75 73 65 72 (or if) the user
2240: 20 67 65 74 73 20 61 20 64 65 62 75 67 67 65 72 gets a debugger
2250: 20 70 72 6f 6d 70 74 2c 20 68 65 20 63 61 6e 0a prompt, he can.
2260: 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 65 64 ;; proceed
2270: 20 77 68 65 72 65 20 74 68 65 20 63 61 6c 6c 20 where the call
2280: 74 6f 20 45 52 52 4f 52 20 77 61 73 20 77 69 74 to ERROR was wit
2290: 68 20 74 68 65 20 63 6f 72 72 65 63 74 20 76 61 h the correct va
22a0: 6c 75 65 2e 0a 20 20 20 20 20 20 28 63 68 65 63 lue.. (chec
22b0: 6b 2d 74 79 70 65 20 70 72 65 64 3f 0a 20 20 20 k-type pred?.
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
22d0: 65 72 72 6f 72 20 22 65 72 72 6f 6e 65 6f 75 73 error "erroneous
22e0: 20 76 61 6c 75 65 22 0a 20 20 20 20 20 20 20 20 value".
22f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2300: 20 28 6c 69 73 74 20 70 72 65 64 3f 20 76 61 6c (list pred? val
2310: 75 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ue).
2320: 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 77 `(w
2330: 68 69 6c 65 20 63 61 6c 6c 69 6e 67 20 2c 63 61 hile calling ,ca
2340: 6c 6c 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 llee)).
2350: 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 callee)
2360: 29 29 0a 0a 3b 3b 3b 20 28 43 48 45 43 4b 2d 49 ))..;;; (CHECK-I
2370: 4e 44 45 58 20 3c 76 65 63 74 6f 72 3e 20 3c 69 NDEX <vector> <i
2380: 6e 64 65 78 3e 20 3c 63 61 6c 6c 65 65 3e 29 20 ndex> <callee>)
2390: 2d 3e 20 69 6e 64 65 78 0a 3b 3b 3b 20 20 20 45 -> index.;;; E
23a0: 6e 73 75 72 65 20 74 68 61 74 20 49 4e 44 45 58 nsure that INDEX
23b0: 20 69 73 20 61 20 76 61 6c 69 64 20 69 6e 64 65 is a valid inde
23c0: 78 20 69 6e 74 6f 20 56 45 43 54 4f 52 3b 20 69 x into VECTOR; i
23d0: 66 20 6e 6f 74 2c 20 73 69 67 6e 61 6c 20 61 6e f not, signal an
23e0: 0a 3b 3b 3b 20 20 20 65 72 72 6f 72 20 73 74 61 .;;; error sta
23f0: 74 69 6e 67 20 74 68 61 74 20 69 74 20 69 73 20 ting that it is
2400: 6e 6f 74 20 61 6e 64 20 74 68 61 74 20 74 68 69 not and that thi
2410: 73 20 68 61 70 70 65 6e 65 64 20 69 6e 20 61 20 s happened in a
2420: 63 61 6c 6c 20 74 6f 0a 3b 3b 3b 20 20 20 43 41 call to.;;; CA
2430: 4c 4c 45 45 2e 20 20 52 65 74 75 72 6e 20 49 4e LLEE. Return IN
2440: 44 45 58 20 77 68 65 6e 20 69 74 20 69 73 20 76 DEX when it is v
2450: 61 6c 69 64 2e 20 20 28 4e 6f 74 65 20 74 68 61 alid. (Note tha
2460: 74 20 74 68 69 73 20 64 6f 65 73 20 4e 4f 54 0a t this does NOT.
2470: 3b 3b 3b 20 20 20 63 68 65 63 6b 20 74 68 61 74 ;;; check that
2480: 20 56 45 43 54 4f 52 20 69 73 20 69 6e 64 65 65 VECTOR is indee
2490: 64 20 61 20 76 65 63 74 6f 72 2e 29 0a 28 64 65 d a vector.).(de
24a0: 66 69 6e 65 20 28 63 68 65 63 6b 2d 69 6e 64 65 fine (check-inde
24b0: 78 20 76 65 63 20 69 6e 64 65 78 20 63 61 6c 6c x vec index call
24c0: 65 65 29 0a 20 20 28 6c 65 74 20 28 28 69 6e 64 ee). (let ((ind
24d0: 65 78 20 28 63 68 65 63 6b 2d 74 79 70 65 20 69 ex (check-type i
24e0: 6e 74 65 67 65 72 3f 20 69 6e 64 65 78 20 63 61 nteger? index ca
24f0: 6c 6c 65 65 29 29 29 0a 20 20 20 20 28 63 6f 6e llee))). (con
2500: 64 20 28 28 3c 20 69 6e 64 65 78 20 30 29 0a 20 d ((< index 0).
2510: 20 20 20 20 20 20 20 20 20 20 28 63 68 65 63 6b (check
2520: 2d 69 6e 64 65 78 20 76 65 63 0a 20 20 20 20 20 -index vec.
2530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2540: 20 20 20 28 65 72 72 6f 72 20 22 76 65 63 74 6f (error "vecto
2550: 72 20 69 6e 64 65 78 20 74 6f 6f 20 6c 6f 77 22 r index too low"
2560: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 69 6e 64 65 78 0a 20 20 20 20 20 20 20 20 20 20 index.
2590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25a0: 20 20 20 20 20 60 28 69 6e 74 6f 20 76 65 63 74 `(into vect
25b0: 6f 72 20 2c 76 65 63 29 0a 20 20 20 20 20 20 20 or ,vec).
25c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25d0: 20 20 20 20 20 20 20 20 60 28 77 68 69 6c 65 20 `(while
25e0: 63 61 6c 6c 69 6e 67 20 2c 63 61 6c 6c 65 65 29 calling ,callee)
25f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2600: 20 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 callee
2610: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 3e )). ((>
2620: 3d 20 69 6e 64 65 78 20 28 76 65 63 74 6f 72 2d = index (vector-
2630: 6c 65 6e 67 74 68 20 76 65 63 29 29 0a 20 20 20 length vec)).
2640: 20 20 20 20 20 20 20 20 28 63 68 65 63 6b 2d 69 (check-i
2650: 6e 64 65 78 20 76 65 63 0a 20 20 20 20 20 20 20 ndex vec.
2660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2670: 20 28 65 72 72 6f 72 20 22 76 65 63 74 6f 72 20 (error "vector
2680: 69 6e 64 65 78 20 74 6f 6f 20 68 69 67 68 22 0a index too high".
2690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
26b0: 6e 64 65 78 0a 20 20 20 20 20 20 20 20 20 20 20 ndex.
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26d0: 20 20 20 20 60 28 69 6e 74 6f 20 76 65 63 74 6f `(into vecto
26e0: 72 20 2c 76 65 63 29 0a 20 20 20 20 20 20 20 20 r ,vec).
26f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2700: 20 20 20 20 20 20 20 60 28 77 68 69 6c 65 20 63 `(while c
2710: 61 6c 6c 69 6e 67 20 2c 63 61 6c 6c 65 65 29 29 alling ,callee))
2720: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2730: 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 callee)
2740: 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 ). (els
2750: 65 20 69 6e 64 65 78 29 29 29 29 0a 0a 3b 3b 3b e index))))..;;;
2760: 20 28 43 48 45 43 4b 2d 49 4e 44 49 43 45 53 20 (CHECK-INDICES
2770: 3c 76 65 63 74 6f 72 3e 0a 3b 3b 3b 20 20 20 20 <vector>.;;;
2780: 20 20 20 20 20 20 20 20 20 20 20 20 3c 73 74 61 <sta
2790: 72 74 3e 20 3c 73 74 61 72 74 2d 6e 61 6d 65 3e rt> <start-name>
27a0: 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 .;;;
27b0: 20 20 20 20 3c 65 6e 64 3e 20 3c 65 6e 64 2d 6e <end> <end-n
27c0: 61 6d 65 3e 0a 3b 3b 3b 20 20 20 20 20 20 20 20 ame>.;;;
27d0: 20 20 20 20 20 20 20 20 3c 63 61 6c 6c 65 72 3e <caller>
27e0: 29 20 2d 3e 20 5b 73 74 61 72 74 20 65 6e 64 5d ) -> [start end]
27f0: 0a 3b 3b 3b 20 20 20 45 6e 73 75 72 65 20 74 68 .;;; Ensure th
2800: 61 74 20 53 54 41 52 54 20 61 6e 64 20 45 4e 44 at START and END
2810: 20 61 72 65 20 76 61 6c 69 64 20 62 6f 75 6e 64 are valid bound
2820: 73 20 6f 66 20 61 20 72 61 6e 67 65 20 77 69 74 s of a range wit
2830: 68 69 6e 0a 3b 3b 3b 20 20 20 56 45 43 54 4f 52 hin.;;; VECTOR
2840: 3b 20 69 66 20 6e 6f 74 2c 20 73 69 67 6e 61 6c ; if not, signal
2850: 20 61 6e 20 65 72 72 6f 72 20 73 74 61 74 69 6e an error statin
2860: 67 20 74 68 61 74 20 74 68 65 79 20 61 72 65 20 g that they are
2870: 6e 6f 74 2c 20 77 69 74 68 0a 3b 3b 3b 20 20 20 not, with.;;;
2880: 74 68 65 20 6d 65 73 73 61 67 65 20 62 65 69 6e the message bein
2890: 67 20 69 6e 66 6f 72 6d 61 74 69 76 65 20 61 62 g informative ab
28a0: 6f 75 74 20 77 68 61 74 20 74 68 65 20 61 72 67 out what the arg
28b0: 75 6d 65 6e 74 20 6e 61 6d 65 73 20 77 65 72 65 ument names were
28c0: 0a 3b 3b 3b 20 20 20 63 61 6c 6c 65 64 20 2d 2d .;;; called --
28d0: 20 62 79 20 75 73 69 6e 67 20 53 54 41 52 54 2d by using START-
28e0: 4e 41 4d 45 20 26 20 45 4e 44 2d 4e 41 4d 45 20 NAME & END-NAME
28f0: 2d 2d 2c 20 61 6e 64 20 74 68 61 74 20 69 74 20 --, and that it
2900: 6f 63 63 75 72 72 65 64 0a 3b 3b 3b 20 20 20 77 occurred.;;; w
2910: 68 69 6c 65 20 63 61 6c 6c 69 6e 67 20 43 41 4c hile calling CAL
2920: 4c 45 45 2e 20 20 41 6c 73 6f 20 65 6e 73 75 72 LEE. Also ensur
2930: 65 20 74 68 61 74 20 56 45 43 20 69 73 20 69 6e e that VEC is in
2940: 20 66 61 63 74 20 61 20 76 65 63 74 6f 72 2e 0a fact a vector..
2950: 3b 3b 3b 20 20 20 52 65 74 75 72 6e 73 20 6e 6f ;;; Returns no
2960: 20 75 73 65 66 75 6c 20 76 61 6c 75 65 2e 0a 28 useful value..(
2970: 64 65 66 69 6e 65 20 28 63 68 65 63 6b 2d 69 6e define (check-in
2980: 64 69 63 65 73 20 76 65 63 20 73 74 61 72 74 20 dices vec start
2990: 73 74 61 72 74 2d 6e 61 6d 65 20 65 6e 64 20 65 start-name end e
29a0: 6e 64 2d 6e 61 6d 65 20 63 61 6c 6c 65 65 29 0a nd-name callee).
29b0: 20 20 28 6c 65 74 20 28 28 6c 6f 73 65 20 28 6c (let ((lose (l
29c0: 61 6d 62 64 61 20 74 68 69 6e 67 73 0a 20 20 20 ambda things.
29d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
29e0: 70 6c 79 20 65 72 72 6f 72 20 22 76 65 63 74 6f ply error "vecto
29f0: 72 20 72 61 6e 67 65 20 6f 75 74 20 6f 66 20 62 r range out of b
2a00: 6f 75 6e 64 73 22 0a 20 20 20 20 20 20 20 20 20 ounds".
2a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
2a20: 70 70 65 6e 64 20 74 68 69 6e 67 73 0a 20 20 20 ppend things.
2a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a40: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 76 65 `(ve
2a50: 63 74 6f 72 20 77 61 73 20 2c 76 65 63 29 0a 20 ctor was ,vec).
2a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
2a80: 2c 73 74 61 72 74 2d 6e 61 6d 65 20 77 61 73 20 ,start-name was
2a90: 2c 73 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 ,start).
2aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ab0: 20 20 20 20 20 20 20 60 28 2c 65 6e 64 2d 6e 61 `(,end-na
2ac0: 6d 65 20 77 61 73 20 2c 65 6e 64 29 0a 20 20 20 me was ,end).
2ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 77 68 `(wh
2af0: 69 6c 65 20 63 61 6c 6c 69 6e 67 20 2c 63 61 6c ile calling ,cal
2b00: 6c 65 65 29 29 29 29 29 0a 20 20 20 20 20 20 20 lee))))).
2b10: 20 28 73 74 61 72 74 20 28 63 68 65 63 6b 2d 74 (start (check-t
2b20: 79 70 65 20 69 6e 74 65 67 65 72 3f 20 73 74 61 ype integer? sta
2b30: 72 74 20 63 61 6c 6c 65 65 29 29 0a 20 20 20 20 rt callee)).
2b40: 20 20 20 20 28 65 6e 64 20 20 20 28 63 68 65 63 (end (chec
2b50: 6b 2d 74 79 70 65 20 69 6e 74 65 67 65 72 3f 20 k-type integer?
2b60: 65 6e 64 20 20 20 63 61 6c 6c 65 65 29 29 29 0a end callee))).
2b70: 20 20 20 20 28 63 6f 6e 64 20 28 28 3e 20 73 74 (cond ((> st
2b80: 61 72 74 20 65 6e 64 29 0a 20 20 20 20 20 20 20 art end).
2b90: 20 20 20 20 3b 3b 20 49 27 6d 20 6e 6f 74 20 73 ;; I'm not s
2ba0: 75 72 65 20 68 6f 77 20 77 65 6c 6c 20 74 68 69 ure how well thi
2bb0: 73 20 77 69 6c 6c 20 77 6f 72 6b 2e 20 20 54 68 s will work. Th
2bc0: 65 20 69 6e 74 65 6e 74 20 69 73 20 74 68 61 74 e intent is that
2bd0: 0a 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 74 . ;; t
2be0: 68 65 20 70 72 6f 67 72 61 6d 6d 65 72 20 74 65 he programmer te
2bf0: 6c 6c 73 20 74 68 65 20 64 65 62 75 67 67 65 72 lls the debugger
2c00: 20 74 6f 20 70 72 6f 63 65 65 64 20 77 69 74 68 to proceed with
2c10: 20 62 6f 74 68 20 61 0a 20 20 20 20 20 20 20 20 both a.
2c20: 20 20 20 3b 3b 20 6e 65 77 20 53 54 41 52 54 20 ;; new START
2c30: 26 20 61 20 6e 65 77 20 45 4e 44 20 62 79 20 72 & a new END by r
2c40: 65 74 75 72 6e 69 6e 67 20 6d 75 6c 74 69 70 6c eturning multipl
2c50: 65 20 76 61 6c 75 65 73 0a 20 20 20 20 20 20 20 e values.
2c60: 20 20 20 20 3b 3b 20 73 6f 6d 65 77 68 65 72 65 ;; somewhere
2c70: 2e 0a 20 20 20 20 20 20 20 20 20 20 20 28 72 65 .. (re
2c80: 63 65 69 76 65 20 28 6e 65 77 2d 73 74 61 72 74 ceive (new-start
2c90: 20 6e 65 77 2d 65 6e 64 29 0a 20 20 20 20 20 20 new-end).
2ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
2cb0: 6f 73 65 20 60 28 2c 65 6e 64 2d 6e 61 6d 65 20 ose `(,end-name
2cc0: 3c 20 2c 73 74 61 72 74 2d 6e 61 6d 65 29 29 0a < ,start-name)).
2cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68 (ch
2ce0: 65 63 6b 2d 69 6e 64 69 63 65 73 20 76 65 63 0a eck-indices vec.
2cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d00: 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 77 2d new-
2d10: 73 74 61 72 74 20 73 74 61 72 74 2d 6e 61 6d 65 start start-name
2d20: 0a 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 6e 65 77 new
2d40: 2d 65 6e 64 20 65 6e 64 2d 6e 61 6d 65 0a 20 20 -end end-name.
2d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d60: 20 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 callee
2d70: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 ))). ((
2d80: 3c 20 73 74 61 72 74 20 30 29 0a 20 20 20 20 20 < start 0).
2d90: 20 20 20 20 20 20 28 63 68 65 63 6b 2d 69 6e 64 (check-ind
2da0: 69 63 65 73 20 76 65 63 0a 20 20 20 20 20 20 20 ices vec.
2db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dc0: 20 20 20 28 6c 6f 73 65 20 60 28 2c 73 74 61 72 (lose `(,star
2dd0: 74 2d 6e 61 6d 65 20 3c 20 30 29 29 0a 20 20 20 t-name < 0)).
2de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2df0: 20 20 20 20 20 20 20 73 74 61 72 74 2d 6e 61 6d start-nam
2e00: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
2e10: 20 20 20 20 20 20 20 20 20 20 20 20 65 6e 64 20 end
2e20: 65 6e 64 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 end-name.
2e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e40: 20 20 20 63 61 6c 6c 65 65 29 29 0a 20 20 20 20 callee)).
2e50: 20 20 20 20 20 20 28 28 3e 3d 20 73 74 61 72 74 ((>= start
2e60: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
2e70: 76 65 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 vec)).
2e80: 20 28 63 68 65 63 6b 2d 69 6e 64 69 63 65 73 20 (check-indices
2e90: 76 65 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 vec.
2ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
2eb0: 6f 73 65 20 60 28 2c 73 74 61 72 74 2d 6e 61 6d ose `(,start-nam
2ec0: 65 20 3e 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 e > len).
2ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ee0: 20 20 20 20 20 20 20 20 20 60 28 6c 65 6e 20 77 `(len w
2ef0: 61 73 20 2c 28 76 65 63 74 6f 72 2d 6c 65 6e 67 as ,(vector-leng
2f00: 74 68 20 76 65 63 29 29 29 0a 20 20 20 20 20 20 th vec))).
2f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f20: 20 20 20 20 73 74 61 72 74 2d 6e 61 6d 65 0a 20 start-name.
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f40: 20 20 20 20 20 20 20 20 20 65 6e 64 20 65 6e 64 end end
2f50: 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 -name.
2f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f70: 63 61 6c 6c 65 65 29 29 0a 20 20 20 20 20 20 20 callee)).
2f80: 20 20 20 28 28 3e 20 65 6e 64 20 28 76 65 63 74 ((> end (vect
2f90: 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 29 0a or-length vec)).
2fa0: 20 20 20 20 20 20 20 20 20 20 20 28 63 68 65 63 (chec
2fb0: 6b 2d 69 6e 64 69 63 65 73 20 76 65 63 0a 20 20 k-indices vec.
2fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2fd0: 20 20 20 20 20 20 20 20 73 74 61 72 74 20 73 74 start st
2fe0: 61 72 74 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 art-name.
2ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3000: 20 20 20 28 6c 6f 73 65 20 60 28 2c 65 6e 64 2d (lose `(,end-
3010: 6e 61 6d 65 20 3e 20 6c 65 6e 29 0a 20 20 20 20 name > len).
3020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3030: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 6c 65 `(le
3040: 6e 20 77 61 73 20 2c 28 76 65 63 74 6f 72 2d 6c n was ,(vector-l
3050: 65 6e 67 74 68 20 76 65 63 29 29 29 0a 20 20 20 ength vec))).
3060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3070: 20 20 20 20 20 20 20 65 6e 64 2d 6e 61 6d 65 0a end-name.
3080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3090: 20 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 callee
30a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c )). (el
30b0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 76 se. (v
30c0: 61 6c 75 65 73 20 73 74 61 72 74 20 65 6e 64 29 alues start end)
30d0: 29 29 29 29 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d 2d )))).....;;; ---
30e0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
30f0: 2d 0a 3b 3b 3b 20 49 6e 74 65 72 6e 61 6c 20 72 -.;;; Internal r
3100: 6f 75 74 69 6e 65 73 0a 0a 3b 3b 3b 20 54 68 65 outines..;;; The
3110: 73 65 20 73 68 6f 75 6c 64 20 61 6c 6c 20 62 65 se should all be
3120: 20 69 6e 74 65 67 72 61 74 65 64 2c 20 6e 61 74 integrated, nat
3130: 69 76 65 2c 20 6f 72 20 6f 74 68 65 72 77 69 73 ive, or otherwis
3140: 65 20 6f 70 74 69 6d 69 7a 65 64 20 2d 2d 0a 3b e optimized --.;
3150: 3b 3b 20 74 68 65 79 27 72 65 20 75 73 65 64 20 ;; they're used
3160: 61 20 5f 6c 6f 74 5f 20 2d 2d 2e 20 20 41 6c 6c a _lot_ --. All
3170: 20 6f 66 20 74 68 65 20 6c 6f 6f 70 73 20 61 6e of the loops an
3180: 64 20 4c 45 54 73 20 69 6e 73 69 64 65 20 6c 6f d LETs inside lo
3190: 6f 70 73 0a 3b 3b 3b 20 61 72 65 20 6c 61 6d 62 ops.;;; are lamb
31a0: 64 61 2d 6c 69 66 74 65 64 20 62 79 20 68 61 6e da-lifted by han
31b0: 64 2c 20 6a 75 73 74 20 73 6f 20 61 73 20 6e 6f d, just so as no
31c0: 74 20 74 6f 20 63 6f 6e 73 20 63 6c 6f 73 75 72 t to cons closur
31d0: 65 73 20 69 6e 20 74 68 65 0a 3b 3b 3b 20 6c 6f es in the.;;; lo
31e0: 6f 70 73 2e 20 20 28 49 66 20 79 6f 75 72 20 63 ops. (If your c
31f0: 6f 6d 70 69 6c 65 72 20 63 61 6e 20 64 6f 20 62 ompiler can do b
3200: 65 74 74 65 72 20 74 68 61 6e 20 74 68 61 74 20 etter than that
3210: 69 66 20 74 68 65 79 27 72 65 20 6e 6f 74 0a 3b if they're not.;
3220: 3b 3b 20 6c 61 6d 62 64 61 2d 6c 69 66 74 65 64 ;; lambda-lifted
3230: 2c 20 74 68 65 6e 20 6c 61 6d 62 64 61 2d 64 72 , then lambda-dr
3240: 6f 70 20 28 3f 29 20 74 68 65 6d 2e 29 0a 0a 3b op (?) them.)..;
3250: 3b 3b 20 28 56 45 43 54 4f 52 2d 50 41 52 53 45 ;; (VECTOR-PARSE
3260: 2d 53 54 41 52 54 2b 45 4e 44 20 3c 76 65 63 74 -START+END <vect
3270: 6f 72 3e 20 3c 61 72 67 75 6d 65 6e 74 73 3e 0a or> <arguments>.
3280: 3b 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;;
3290: 20 20 20 20 20 20 20 20 20 20 20 20 3c 73 74 61 <sta
32a0: 72 74 2d 6e 61 6d 65 3e 20 3c 65 6e 64 2d 6e 61 rt-name> <end-na
32b0: 6d 65 3e 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 me>.;;;
32c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
32d0: 3c 63 61 6c 6c 65 65 3e 29 0a 3b 3b 3b 20 20 20 <callee>).;;;
32e0: 20 20 20 20 2d 3e 20 5b 73 74 61 72 74 20 65 6e -> [start en
32f0: 64 5d 0a 3b 3b 3b 20 20 20 52 65 74 75 72 6e 20 d].;;; Return
3300: 74 77 6f 20 76 61 6c 75 65 73 2c 20 63 6f 6d 70 two values, comp
3310: 6f 73 69 6e 67 20 61 20 76 61 6c 69 64 20 72 61 osing a valid ra
3320: 6e 67 65 20 77 69 74 68 69 6e 20 56 45 43 54 4f nge within VECTO
3330: 52 2c 20 61 73 0a 3b 3b 3b 20 20 20 65 78 74 72 R, as.;;; extr
3340: 61 63 74 65 64 20 66 72 6f 6d 20 41 52 47 55 4d acted from ARGUM
3350: 45 4e 54 53 20 6f 72 20 64 65 66 61 75 6c 74 65 ENTS or defaulte
3360: 64 20 66 72 6f 6d 20 56 45 43 54 4f 52 20 2d 2d d from VECTOR --
3370: 20 30 20 66 6f 72 20 53 54 41 52 54 0a 3b 3b 3b 0 for START.;;;
3380: 20 20 20 61 6e 64 20 74 68 65 20 6c 65 6e 67 74 and the lengt
3390: 68 20 6f 66 20 56 45 43 54 4f 52 20 66 6f 72 20 h of VECTOR for
33a0: 45 4e 44 20 2d 2d 3b 20 53 54 41 52 54 2d 4e 41 END --; START-NA
33b0: 4d 45 20 61 6e 64 20 45 4e 44 2d 4e 41 4d 45 20 ME and END-NAME
33c0: 61 72 65 0a 3b 3b 3b 20 20 20 70 75 72 65 6c 79 are.;;; purely
33d0: 20 66 6f 72 20 65 72 72 6f 72 20 63 68 65 63 6b for error check
33e0: 69 6e 67 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 ing..(define (ve
33f0: 63 74 6f 72 2d 70 61 72 73 65 2d 73 74 61 72 74 ctor-parse-start
3400: 2b 65 6e 64 20 76 65 63 20 61 72 67 73 20 73 74 +end vec args st
3410: 61 72 74 2d 6e 61 6d 65 20 65 6e 64 2d 6e 61 6d art-name end-nam
3420: 65 20 63 61 6c 6c 65 65 29 0a 20 20 28 6c 65 74 e callee). (let
3430: 20 28 28 6c 65 6e 20 28 76 65 63 74 6f 72 2d 6c ((len (vector-l
3440: 65 6e 67 74 68 20 76 65 63 29 29 29 0a 20 20 20 ength vec))).
3450: 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 61 (cond ((null? a
3460: 72 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 rgs).
3470: 28 76 61 6c 75 65 73 20 30 20 6c 65 6e 29 29 0a (values 0 len)).
3480: 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c ((null
3490: 3f 20 28 63 64 72 20 61 72 67 73 29 29 0a 20 20 ? (cdr args)).
34a0: 20 20 20 20 20 20 20 20 20 28 63 68 65 63 6b 2d (check-
34b0: 69 6e 64 69 63 65 73 20 76 65 63 0a 20 20 20 20 indices vec.
34c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34d0: 20 20 20 20 20 20 28 63 61 72 20 61 72 67 73 29 (car args)
34e0: 20 73 74 61 72 74 2d 6e 61 6d 65 0a 20 20 20 20 start-name.
34f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3500: 20 20 20 20 20 20 6c 65 6e 20 65 6e 64 2d 6e 61 len end-na
3510: 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 me.
3520: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 61 6c cal
3530: 6c 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 lee)).
3540: 28 28 6e 75 6c 6c 3f 20 28 63 64 64 72 20 61 72 ((null? (cddr ar
3550: 67 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 gs)).
3560: 28 63 68 65 63 6b 2d 69 6e 64 69 63 65 73 20 76 (check-indices v
3570: 65 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ec.
3580: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 (ca
3590: 72 20 20 61 72 67 73 29 20 73 74 61 72 74 2d 6e r args) start-n
35a0: 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ame.
35b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
35c0: 61 64 72 20 61 72 67 73 29 20 65 6e 64 2d 6e 61 adr args) end-na
35d0: 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 me.
35e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 61 6c cal
35f0: 6c 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 lee)).
3600: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
3610: 20 28 65 72 72 6f 72 20 22 74 6f 6f 20 6d 61 6e (error "too man
3620: 79 20 61 72 67 75 6d 65 6e 74 73 22 0a 20 20 20 y arguments".
3630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 `
3640: 28 65 78 74 72 61 20 61 72 67 73 20 77 65 72 65 (extra args were
3650: 20 2c 28 63 64 64 72 20 61 72 67 73 29 29 0a 20 ,(cddr args)).
3660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3670: 20 60 28 77 68 69 6c 65 20 63 61 6c 6c 69 6e 67 `(while calling
3680: 20 2c 63 61 6c 6c 65 65 29 29 29 29 29 29 0a 0a ,callee))))))..
3690: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6c (define-syntax l
36a0: 65 74 2d 76 65 63 74 6f 72 2d 73 74 61 72 74 2b et-vector-start+
36b0: 65 6e 64 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 end. (syntax-ru
36c0: 6c 65 73 20 28 29 0a 20 20 20 20 28 28 6c 65 74 les (). ((let
36d0: 2d 76 65 63 74 6f 72 2d 73 74 61 72 74 2b 65 6e -vector-start+en
36e0: 64 20 3f 63 61 6c 6c 65 65 20 3f 76 65 63 20 3f d ?callee ?vec ?
36f0: 61 72 67 73 20 28 3f 73 74 61 72 74 20 3f 65 6e args (?start ?en
3700: 64 29 0a 20 20 20 20 20 20 20 3f 62 6f 64 79 31 d). ?body1
3710: 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 0a 20 20 20 ?body2 ...).
3720: 20 20 28 6c 65 74 20 28 28 3f 76 65 63 20 28 63 (let ((?vec (c
3730: 68 65 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 heck-type vector
3740: 3f 20 3f 76 65 63 20 3f 63 61 6c 6c 65 65 29 29 ? ?vec ?callee))
3750: 29 0a 20 20 20 20 20 20 20 28 72 65 63 65 69 76 ). (receiv
3760: 65 20 28 3f 73 74 61 72 74 20 3f 65 6e 64 29 0a e (?start ?end).
3770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3780: 28 76 65 63 74 6f 72 2d 70 61 72 73 65 2d 73 74 (vector-parse-st
3790: 61 72 74 2b 65 6e 64 20 3f 76 65 63 20 3f 61 72 art+end ?vec ?ar
37a0: 67 73 20 27 3f 73 74 61 72 74 20 27 3f 65 6e 64 gs '?start '?end
37b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
37c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
37d0: 20 20 20 20 20 20 20 20 20 3f 63 61 6c 6c 65 65 ?callee
37e0: 29 0a 20 20 20 20 20 20 20 20 20 3f 62 6f 64 79 ). ?body
37f0: 31 20 3f 62 6f 64 79 32 20 2e 2e 2e 29 29 29 29 1 ?body2 ...))))
3800: 29 0a 0a 3b 3b 3b 20 28 25 53 4d 41 4c 4c 45 53 )..;;; (%SMALLES
3810: 54 2d 4c 45 4e 47 54 48 20 3c 76 65 63 74 6f 72 T-LENGTH <vector
3820: 2d 6c 69 73 74 3e 20 3c 64 65 66 61 75 6c 74 2d -list> <default-
3830: 6c 65 6e 67 74 68 3e 20 3c 63 61 6c 6c 65 65 3e length> <callee>
3840: 29 0a 3b 3b 3b 20 20 20 20 20 20 20 2d 3e 20 65 ).;;; -> e
3850: 78 61 63 74 2c 20 6e 6f 6e 6e 65 67 61 74 69 76 xact, nonnegativ
3860: 65 20 69 6e 74 65 67 65 72 0a 3b 3b 3b 20 20 20 e integer.;;;
3870: 43 6f 6d 70 75 74 65 20 74 68 65 20 73 6d 61 6c Compute the smal
3880: 6c 65 73 74 20 6c 65 6e 67 74 68 20 6f 66 20 56 lest length of V
3890: 45 43 54 4f 52 2d 4c 49 53 54 2e 20 20 44 45 46 ECTOR-LIST. DEF
38a0: 41 55 4c 54 2d 4c 45 4e 47 54 48 20 69 73 0a 3b AULT-LENGTH is.;
38b0: 3b 3b 20 20 20 74 68 65 20 6c 65 6e 67 74 68 20 ;; the length
38c0: 74 68 61 74 20 69 73 20 72 65 74 75 72 6e 65 64 that is returned
38d0: 20 69 66 20 56 45 43 54 4f 52 2d 4c 49 53 54 20 if VECTOR-LIST
38e0: 69 73 20 65 6d 70 74 79 2e 20 20 43 6f 6d 6d 6f is empty. Commo
38f0: 6e 20 75 73 65 0a 3b 3b 3b 20 20 20 6f 66 20 74 n use.;;; of t
3900: 68 69 73 20 69 73 20 69 6e 20 6e 2d 61 72 79 20 his is in n-ary
3910: 76 65 63 74 6f 72 20 72 6f 75 74 69 6e 65 73 3a vector routines:
3920: 0a 3b 3b 3b 20 20 20 20 20 28 64 65 66 69 6e 65 .;;; (define
3930: 20 28 66 20 76 65 63 20 2e 20 76 65 63 74 6f 72 (f vec . vector
3940: 73 29 0a 3b 3b 3b 20 20 20 20 20 20 20 28 6c 65 s).;;; (le
3950: 74 20 28 28 76 65 63 20 28 63 68 65 63 6b 2d 74 t ((vec (check-t
3960: 79 70 65 20 76 65 63 74 6f 72 3f 20 76 65 63 20 ype vector? vec
3970: 66 29 29 29 0a 3b 3b 3b 20 20 20 20 20 20 20 20 f))).;;;
3980: 20 2e 2e 2e 28 25 73 6d 61 6c 6c 65 73 74 2d 6c ...(%smallest-l
3990: 65 6e 67 74 68 20 76 65 63 74 6f 72 73 20 28 76 ength vectors (v
39a0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 ector-length vec
39b0: 29 20 66 29 2e 2e 2e 29 29 0a 3b 3b 3b 20 20 20 ) f)...)).;;;
39c0: 25 53 4d 41 4c 4c 45 53 54 2d 4c 45 4e 47 54 48 %SMALLEST-LENGTH
39d0: 20 74 61 6b 65 73 20 63 61 72 65 20 6f 66 20 74 takes care of t
39e0: 68 65 20 74 79 70 65 20 63 68 65 63 6b 69 6e 67 he type checking
39f0: 20 2d 2d 20 77 68 69 63 68 20 69 73 20 77 68 61 -- which is wha
3a00: 74 0a 3b 3b 3b 20 20 20 74 68 65 20 43 41 4c 4c t.;;; the CALL
3a10: 45 45 20 61 72 67 75 6d 65 6e 74 20 69 73 20 66 EE argument is f
3a20: 6f 72 20 2d 2d 3b 20 74 68 75 73 2c 20 74 68 65 or --; thus, the
3a30: 20 64 65 73 69 67 6e 20 69 73 20 74 75 6e 65 64 design is tuned
3a40: 20 66 6f 72 0a 3b 3b 3b 20 20 20 61 76 6f 69 64 for.;;; avoid
3a50: 69 6e 67 20 72 65 64 75 6e 64 61 6e 74 20 74 79 ing redundant ty
3a60: 70 65 20 63 68 65 63 6b 73 2e 0a 28 64 65 66 69 pe checks..(defi
3a70: 6e 65 20 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 6e ne %smallest-len
3a80: 67 74 68 0a 20 20 28 6c 65 74 72 65 63 20 28 28 gth. (letrec ((
3a90: 6c 6f 6f 70 20 28 6c 61 6d 62 64 61 20 28 76 65 loop (lambda (ve
3aa0: 63 74 6f 72 2d 6c 69 73 74 20 6c 65 6e 67 74 68 ctor-list length
3ab0: 20 63 61 6c 6c 65 65 29 0a 20 20 20 20 20 20 20 callee).
3ac0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
3ad0: 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 2d 6c 69 (null? vector-li
3ae0: 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 st).
3af0: 20 20 20 20 20 20 20 20 20 20 20 6c 65 6e 67 74 lengt
3b00: 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 h.
3b10: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 (loop (
3b20: 63 64 72 20 76 65 63 74 6f 72 2d 6c 69 73 74 29 cdr vector-list)
3b30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
3b50: 69 6e 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 in (vector-lengt
3b60: 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 h.
3b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b80: 20 20 20 20 20 28 63 68 65 63 6b 2d 74 79 70 65 (check-type
3b90: 20 76 65 63 74 6f 72 3f 0a 20 20 20 20 20 20 20 vector?.
3ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bc0: 20 20 20 20 20 20 20 20 28 63 61 72 20 76 65 63 (car vec
3bd0: 74 6f 72 2d 6c 69 73 74 29 0a 20 20 20 20 20 20 tor-list).
3be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c00: 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 callee)
3c10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c30: 20 20 20 20 6c 65 6e 67 74 68 29 0a 20 20 20 20 length).
3c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c50: 20 20 20 20 20 20 20 20 20 63 61 6c 6c 65 65 29 callee)
3c60: 29 29 29 29 0a 20 20 20 20 6c 6f 6f 70 29 29 0a )))). loop)).
3c70: 0a 3b 3b 3b 20 28 25 56 45 43 54 4f 52 2d 43 4f .;;; (%VECTOR-CO
3c80: 50 59 21 20 3c 74 61 72 67 65 74 3e 20 3c 74 73 PY! <target> <ts
3c90: 74 61 72 74 3e 20 3c 73 6f 75 72 63 65 3e 20 3c tart> <source> <
3ca0: 73 73 74 61 72 74 3e 20 3c 73 65 6e 64 3e 29 0a sstart> <send>).
3cb0: 3b 3b 3b 20 20 20 43 6f 70 79 20 65 6c 65 6d 65 ;;; Copy eleme
3cc0: 6e 74 73 20 61 74 20 6c 6f 63 61 74 69 6f 6e 73 nts at locations
3cd0: 20 53 53 54 41 52 54 20 74 6f 20 53 45 4e 44 20 SSTART to SEND
3ce0: 66 72 6f 6d 20 53 4f 55 52 43 45 20 74 6f 20 54 from SOURCE to T
3cf0: 41 52 47 45 54 2c 0a 3b 3b 3b 20 20 20 73 74 61 ARGET,.;;; sta
3d00: 72 74 69 6e 67 20 61 74 20 54 53 54 41 52 54 20 rting at TSTART
3d10: 69 6e 20 54 41 52 47 45 54 2e 0a 3b 3b 3b 0a 3b in TARGET..;;;.;
3d20: 3b 3b 20 4f 70 74 69 6d 69 7a 65 20 74 68 69 73 ;; Optimize this
3d30: 21 20 20 50 72 6f 62 61 62 6c 79 20 77 69 74 68 ! Probably with
3d40: 20 73 6f 6d 65 20 63 6f 6d 62 69 6e 61 74 69 6f some combinatio
3d50: 6e 20 6f 66 3a 0a 3b 3b 3b 20 20 20 2d 20 46 6f n of:.;;; - Fo
3d60: 72 63 65 20 69 74 20 74 6f 20 62 65 20 69 6e 74 rce it to be int
3d70: 65 67 72 61 74 65 64 2e 0a 3b 3b 3b 20 20 20 2d egrated..;;; -
3d80: 20 4c 65 74 20 69 74 20 75 73 65 20 75 6e 73 61 Let it use unsa
3d90: 66 65 20 76 65 63 74 6f 72 20 65 6c 65 6d 65 6e fe vector elemen
3da0: 74 20 64 65 72 65 66 65 72 65 6e 63 69 6e 67 20 t dereferencing
3db0: 72 6f 75 74 69 6e 65 73 3a 20 62 6f 75 6e 64 73 routines: bounds
3dc0: 0a 3b 3b 3b 20 20 20 20 20 63 68 65 63 6b 69 6e .;;; checkin
3dd0: 67 20 61 6c 72 65 61 64 79 20 68 61 70 70 65 6e g already happen
3de0: 73 20 6f 75 74 73 69 64 65 20 6f 66 20 69 74 2e s outside of it.
3df0: 20 20 28 4f 72 20 75 73 65 20 61 20 63 6f 6d 70 (Or use a comp
3e00: 69 6c 65 72 0a 3b 3b 3b 20 20 20 20 20 74 68 61 iler.;;; tha
3e10: 74 20 66 69 67 75 72 65 73 20 74 68 69 73 20 6f t figures this o
3e20: 75 74 2c 20 62 75 74 20 4f 6c 69 6e 20 53 68 69 ut, but Olin Shi
3e30: 76 65 72 73 27 20 50 68 44 20 74 68 65 73 69 73 vers' PhD thesis
3e40: 20 73 65 65 6d 73 20 74 6f 0a 3b 3b 3b 20 20 20 seems to.;;;
3e50: 20 20 68 61 76 65 20 62 65 65 6e 20 6c 61 72 67 have been larg
3e60: 65 6c 79 20 69 67 6e 6f 72 65 64 20 69 6e 20 61 ely ignored in a
3e70: 63 74 75 61 6c 20 69 6d 70 6c 65 6d 65 6e 74 61 ctual implementa
3e80: 74 69 6f 6e 73 2e 2e 2e 29 0a 3b 3b 3b 20 20 20 tions...).;;;
3e90: 2d 20 49 6d 70 6c 65 6d 65 6e 74 20 69 74 20 6e - Implement it n
3ea0: 61 74 69 76 65 6c 79 20 61 73 20 61 20 56 4d 20 atively as a VM
3eb0: 70 72 69 6d 69 74 69 76 65 3a 20 74 68 65 20 56 primitive: the V
3ec0: 4d 20 63 61 6e 20 75 6e 64 6f 75 62 74 65 64 6c M can undoubtedl
3ed0: 79 0a 3b 3b 3b 20 20 20 20 20 70 65 72 66 6f 72 y.;;; perfor
3ee0: 6d 20 6d 75 63 68 20 66 61 73 74 65 72 20 74 68 m much faster th
3ef0: 61 6e 20 69 74 20 63 61 6e 20 6d 61 6b 65 20 53 an it can make S
3f00: 63 68 65 6d 65 20 70 65 72 66 6f 72 6d 2c 20 65 cheme perform, e
3f10: 76 65 6e 20 77 69 74 68 0a 3b 3b 3b 20 20 20 20 ven with.;;;
3f20: 20 62 6f 75 6e 64 73 20 63 68 65 63 6b 69 6e 67 bounds checking
3f30: 2e 0a 3b 3b 3b 20 20 20 2d 20 49 6d 70 6c 65 6d ..;;; - Implem
3f40: 65 6e 74 20 69 74 20 69 6e 20 61 73 73 65 6d 62 ent it in assemb
3f50: 6c 79 3a 20 79 6f 75 20 5f 77 61 6e 74 5f 20 74 ly: you _want_ t
3f60: 68 65 20 66 69 6e 65 20 63 6f 6e 74 72 6f 6c 20 he fine control
3f70: 74 68 61 74 0a 3b 3b 3b 20 20 20 20 20 61 73 73 that.;;; ass
3f80: 65 6d 62 6c 79 20 63 61 6e 20 67 69 76 65 20 79 embly can give y
3f90: 6f 75 20 66 6f 72 20 74 68 69 73 2e 0a 3b 3b 3b ou for this..;;;
3fa0: 20 49 20 61 6c 72 65 61 64 79 20 6c 61 6d 62 64 I already lambd
3fb0: 61 2d 6c 69 66 74 20 69 74 20 62 79 20 68 61 6e a-lift it by han
3fc0: 64 2c 20 62 75 74 20 79 6f 75 20 73 68 6f 75 6c d, but you shoul
3fd0: 64 20 62 65 20 61 62 6c 65 20 74 6f 20 6d 61 6b d be able to mak
3fe0: 65 20 69 74 0a 3b 3b 3b 20 65 76 65 6e 20 62 65 e it.;;; even be
3ff0: 74 74 65 72 20 74 68 61 6e 20 74 68 61 74 2e 0a tter than that..
4000: 28 64 65 66 69 6e 65 20 25 76 65 63 74 6f 72 2d (define %vector-
4010: 63 6f 70 79 21 0a 20 20 28 6c 65 74 72 65 63 20 copy!. (letrec
4020: 28 28 6c 6f 6f 70 2f 6c 2d 3e 72 20 28 6c 61 6d ((loop/l->r (lam
4030: 62 64 61 20 28 74 61 72 67 65 74 20 73 6f 75 72 bda (target sour
4040: 63 65 20 73 65 6e 64 20 69 20 6a 29 0a 20 20 20 ce send i j).
4050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4060: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 3c 20 69 (cond ((< i
4070: 20 73 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 send).
4080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4090: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
40a0: 74 21 20 74 61 72 67 65 74 20 6a 0a 20 20 20 20 t! target j.
40b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40d0: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
40e0: 72 65 66 20 73 6f 75 72 63 65 20 69 29 29 0a 20 ref source i)).
40f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
4110: 6f 6f 70 2f 6c 2d 3e 72 20 74 61 72 67 65 74 20 oop/l->r target
4120: 73 6f 75 72 63 65 20 73 65 6e 64 0a 20 20 20 20 source send.
4130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4150: 20 20 20 20 20 20 28 2b 20 69 20 31 29 20 28 2b (+ i 1) (+
4160: 20 6a 20 31 29 29 29 29 29 29 0a 20 20 20 20 20 j 1)))))).
4170: 20 20 20 20 20 20 28 6c 6f 6f 70 2f 72 2d 3e 6c (loop/r->l
4180: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
4190: 20 73 6f 75 72 63 65 20 73 73 74 61 72 74 20 69 source sstart i
41a0: 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 j).
41b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
41c0: 64 20 28 28 3e 3d 20 69 20 73 73 74 61 72 74 29 d ((>= i sstart)
41d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
41e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41f0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 61 72 (vector-set! tar
4200: 67 65 74 20 6a 0a 20 20 20 20 20 20 20 20 20 20 get j.
4210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4230: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 6f (vector-ref so
4240: 75 72 63 65 20 69 29 29 0a 20 20 20 20 20 20 20 urce i)).
4250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4260: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 2f 72 2d (loop/r-
4270: 3e 6c 20 74 61 72 67 65 74 20 73 6f 75 72 63 65 >l target source
4280: 20 73 73 74 61 72 74 0a 20 20 20 20 20 20 20 20 sstart.
4290: 20 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 28 2d 20 69 20 31 29 20 28 2d 20 6a 20 31 (- i 1) (- j 1
42c0: 29 29 29 29 29 29 29 0a 20 20 20 20 28 6c 61 6d ))))))). (lam
42d0: 62 64 61 20 28 74 61 72 67 65 74 20 74 73 74 61 bda (target tsta
42e0: 72 74 20 73 6f 75 72 63 65 20 73 73 74 61 72 74 rt source sstart
42f0: 20 73 65 6e 64 29 0a 20 20 20 20 20 20 28 69 66 send). (if
4300: 20 28 3e 20 73 73 74 61 72 74 20 74 73 74 61 72 (> sstart tstar
4310: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 3b t) ;
4320: 20 4d 61 6b 65 20 73 75 72 65 20 77 65 20 64 6f Make sure we do
4330: 6e 27 74 20 63 6f 70 79 20 6f 76 65 72 0a 20 20 n't copy over.
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4360: 20 20 20 20 20 20 3b 20 20 20 6f 75 72 73 65 6c ; oursel
4370: 76 65 73 2e 0a 20 20 20 20 20 20 20 20 20 20 28 ves.. (
4380: 6c 6f 6f 70 2f 6c 2d 3e 72 20 74 61 72 67 65 74 loop/l->r target
4390: 20 73 6f 75 72 63 65 20 73 65 6e 64 20 73 73 74 source send sst
43a0: 61 72 74 20 74 73 74 61 72 74 29 0a 20 20 20 20 art tstart).
43b0: 20 20 20 20 20 20 28 6c 6f 6f 70 2f 72 2d 3e 6c (loop/r->l
43c0: 20 74 61 72 67 65 74 20 73 6f 75 72 63 65 20 73 target source s
43d0: 73 74 61 72 74 20 28 2d 20 73 65 6e 64 20 31 29 start (- send 1)
43e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
43f0: 20 20 20 20 20 20 28 2b 20 2d 31 20 74 73 74 61 (+ -1 tsta
4400: 72 74 20 73 65 6e 64 20 28 2d 20 73 73 74 61 72 rt send (- sstar
4410: 74 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 25 t)))))))..;;; (%
4420: 56 45 43 54 4f 52 2d 52 45 56 45 52 53 45 2d 43 VECTOR-REVERSE-C
4430: 4f 50 59 21 20 3c 74 61 72 67 65 74 3e 20 3c 74 OPY! <target> <t
4440: 73 74 61 72 74 3e 20 3c 73 6f 75 72 63 65 3e 20 start> <source>
4450: 3c 73 73 74 61 72 74 3e 20 3c 73 65 6e 64 3e 29 <sstart> <send>)
4460: 0a 3b 3b 3b 20 20 20 43 6f 70 79 20 65 6c 65 6d .;;; Copy elem
4470: 65 6e 74 73 20 66 72 6f 6d 20 53 53 54 41 52 54 ents from SSTART
4480: 20 74 6f 20 53 45 4e 44 20 66 72 6f 6d 20 53 4f to SEND from SO
4490: 55 52 43 45 20 74 6f 20 54 41 52 47 45 54 2c 20 URCE to TARGET,
44a0: 69 6e 20 74 68 65 0a 3b 3b 3b 20 20 20 72 65 76 in the.;;; rev
44b0: 65 72 73 65 20 6f 72 64 65 72 2e 0a 28 64 65 66 erse order..(def
44c0: 69 6e 65 20 25 76 65 63 74 6f 72 2d 72 65 76 65 ine %vector-reve
44d0: 72 73 65 2d 63 6f 70 79 21 0a 20 20 28 6c 65 74 rse-copy!. (let
44e0: 72 65 63 20 28 28 6c 6f 6f 70 20 28 6c 61 6d 62 rec ((loop (lamb
44f0: 64 61 20 28 74 61 72 67 65 74 20 73 6f 75 72 63 da (target sourc
4500: 65 20 73 73 74 61 72 74 20 69 20 6a 29 0a 20 20 e sstart i j).
4510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4520: 20 28 63 6f 6e 64 20 28 28 3e 3d 20 69 20 73 73 (cond ((>= i ss
4530: 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 tart).
4540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4550: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 61 72 (vector-set! tar
4560: 67 65 74 20 6a 20 28 76 65 63 74 6f 72 2d 72 65 get j (vector-re
4570: 66 20 73 6f 75 72 63 65 20 69 29 29 0a 20 20 20 f source i)).
4580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4590: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 74 61 72 (loop tar
45a0: 67 65 74 20 73 6f 75 72 63 65 20 73 73 74 61 72 get source sstar
45b0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 20 20 28 2d 20 69 20 31 29 0a 20 20 20 20 20 20 (- i 1).
45e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45f0: 20 20 20 20 20 20 20 20 20 20 28 2b 20 6a 20 31 (+ j 1
4600: 29 29 29 29 29 29 29 0a 20 20 20 20 28 6c 61 6d ))))))). (lam
4610: 62 64 61 20 28 74 61 72 67 65 74 20 74 73 74 61 bda (target tsta
4620: 72 74 20 73 6f 75 72 63 65 20 73 73 74 61 72 74 rt source sstart
4630: 20 73 65 6e 64 29 0a 20 20 20 20 20 20 28 6c 6f send). (lo
4640: 6f 70 20 74 61 72 67 65 74 20 73 6f 75 72 63 65 op target source
4650: 20 73 73 74 61 72 74 0a 20 20 20 20 20 20 20 20 sstart.
4660: 20 20 20 20 28 2d 20 73 65 6e 64 20 31 29 0a 20 (- send 1).
4670: 20 20 20 20 20 20 20 20 20 20 20 74 73 74 61 72 tstar
4680: 74 29 29 29 29 0a 0a 3b 3b 3b 20 28 25 56 45 43 t))))..;;; (%VEC
4690: 54 4f 52 2d 52 45 56 45 52 53 45 21 20 3c 76 65 TOR-REVERSE! <ve
46a0: 63 74 6f 72 3e 29 0a 28 64 65 66 69 6e 65 20 25 ctor>).(define %
46b0: 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 21 0a vector-reverse!.
46c0: 20 20 28 6c 65 74 72 65 63 20 28 28 6c 6f 6f 70 (letrec ((loop
46d0: 20 28 6c 61 6d 62 64 61 20 28 76 65 63 20 69 20 (lambda (vec i
46e0: 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j).
46f0: 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 3c 3d (cond ((<=
4700: 20 69 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 i j).
4710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4720: 28 6c 65 74 20 28 28 76 20 28 76 65 63 74 6f 72 (let ((v (vector
4730: 2d 72 65 66 20 76 65 63 20 69 29 29 29 0a 20 20 -ref vec i))).
4740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4750: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
4760: 72 2d 73 65 74 21 20 76 65 63 20 69 20 28 76 65 r-set! vec i (ve
4770: 63 74 6f 72 2d 72 65 66 20 76 65 63 20 6a 29 29 ctor-ref vec j))
4780: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4790: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
47a0: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 6a 20 ctor-set! vec j
47b0: 76 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 v).
47c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
47d0: 6c 6f 6f 70 20 76 65 63 20 28 2b 20 69 20 31 29 loop vec (+ i 1)
47e0: 20 28 2d 20 6a 20 31 29 29 29 29 29 29 29 29 0a (- j 1)))))))).
47f0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 65 63 (lambda (vec
4800: 20 73 74 61 72 74 20 65 6e 64 29 0a 20 20 20 20 start end).
4810: 20 20 28 6c 6f 6f 70 20 76 65 63 20 73 74 61 72 (loop vec star
4820: 74 20 28 2d 20 65 6e 64 20 31 29 29 29 29 29 0a t (- end 1))))).
4830: 0a 3b 3b 3b 20 28 25 56 45 43 54 4f 52 2d 46 4f .;;; (%VECTOR-FO
4840: 4c 44 31 20 3c 6b 6f 6e 73 3e 20 3c 6b 6e 69 6c LD1 <kons> <knil
4850: 3e 20 3c 76 65 63 74 6f 72 3e 29 20 2d 3e 20 6b > <vector>) -> k
4860: 6e 69 6c 27 0a 3b 3b 3b 20 20 20 20 20 28 4b 4f nil'.;;; (KO
4870: 4e 53 20 3c 69 6e 64 65 78 3e 20 3c 6b 6e 69 6c NS <index> <knil
4880: 3e 20 3c 65 6c 74 3e 29 20 2d 3e 20 6b 6e 69 6c > <elt>) -> knil
4890: 27 0a 28 64 65 66 69 6e 65 20 25 76 65 63 74 6f '.(define %vecto
48a0: 72 2d 66 6f 6c 64 31 0a 20 20 28 6c 65 74 72 65 r-fold1. (letre
48b0: 63 20 28 28 6c 6f 6f 70 20 28 6c 61 6d 62 64 61 c ((loop (lambda
48c0: 20 28 6b 6f 6e 73 20 6b 6e 69 6c 20 6c 65 6e 20 (kons knil len
48d0: 76 65 63 20 69 29 0a 20 20 20 20 20 20 20 20 20 vec i).
48e0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3d (if (=
48f0: 20 69 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 i len).
4900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6b k
4910: 6e 69 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 nil.
4920: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
4930: 20 6b 6f 6e 73 0a 20 20 20 20 20 20 20 20 20 20 kons.
4940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4950: 20 20 20 28 6b 6f 6e 73 20 69 20 6b 6e 69 6c 20 (kons i knil
4960: 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 (vector-ref vec
4970: 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i)).
4980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4990: 20 6c 65 6e 20 76 65 63 20 28 2b 20 69 20 31 29 len vec (+ i 1)
49a0: 29 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 ))))). (lambd
49b0: 61 20 28 6b 6f 6e 73 20 6b 6e 69 6c 20 6c 65 6e a (kons knil len
49c0: 20 76 65 63 29 0a 20 20 20 20 20 20 28 6c 6f 6f vec). (loo
49d0: 70 20 6b 6f 6e 73 20 6b 6e 69 6c 20 6c 65 6e 20 p kons knil len
49e0: 76 65 63 20 30 29 29 29 29 0a 0a 3b 3b 3b 20 28 vec 0))))..;;; (
49f0: 25 56 45 43 54 4f 52 2d 46 4f 4c 44 32 2b 20 3c %VECTOR-FOLD2+ <
4a00: 6b 6f 6e 73 3e 20 3c 6b 6e 69 6c 3e 20 3c 76 65 kons> <knil> <ve
4a10: 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d 3e 20 6b 6e ctor> ...) -> kn
4a20: 69 6c 27 0a 3b 3b 3b 20 20 20 20 20 28 4b 4f 4e il'.;;; (KON
4a30: 53 20 3c 69 6e 64 65 78 3e 20 3c 6b 6e 69 6c 3e S <index> <knil>
4a40: 20 3c 65 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 6b <elt> ...) -> k
4a50: 6e 69 6c 27 0a 28 64 65 66 69 6e 65 20 25 76 65 nil'.(define %ve
4a60: 63 74 6f 72 2d 66 6f 6c 64 32 2b 0a 20 20 28 6c ctor-fold2+. (l
4a70: 65 74 72 65 63 20 28 28 6c 6f 6f 70 20 28 6c 61 etrec ((loop (la
4a80: 6d 62 64 61 20 28 6b 6f 6e 73 20 6b 6e 69 6c 20 mbda (kons knil
4a90: 6c 65 6e 20 76 65 63 74 6f 72 73 20 69 29 0a 20 len vectors i).
4aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ab0: 20 20 28 69 66 20 28 3d 20 69 20 6c 65 6e 29 0a (if (= i len).
4ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ad0: 20 20 20 20 20 20 20 6b 6e 69 6c 0a 20 20 20 20 knil.
4ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4af0: 20 20 20 28 6c 6f 6f 70 20 6b 6f 6e 73 0a 20 20 (loop kons.
4b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b10: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
4b20: 79 20 6b 6f 6e 73 20 69 20 6b 6e 69 6c 0a 20 20 y kons i knil.
4b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b50: 20 20 28 76 65 63 74 6f 72 73 2d 72 65 66 20 76 (vectors-ref v
4b60: 65 63 74 6f 72 73 20 69 29 29 0a 20 20 20 20 20 ectors i)).
4b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b80: 20 20 20 20 20 20 20 20 6c 65 6e 20 76 65 63 74 len vect
4b90: 6f 72 73 20 28 2b 20 69 20 31 29 29 29 29 29 29 ors (+ i 1))))))
4ba0: 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 6f . (lambda (ko
4bb0: 6e 73 20 6b 6e 69 6c 20 6c 65 6e 20 76 65 63 74 ns knil len vect
4bc0: 6f 72 73 29 0a 20 20 20 20 20 20 28 6c 6f 6f 70 ors). (loop
4bd0: 20 6b 6f 6e 73 20 6b 6e 69 6c 20 6c 65 6e 20 76 kons knil len v
4be0: 65 63 74 6f 72 73 20 30 29 29 29 29 0a 0a 3b 3b ectors 0))))..;;
4bf0: 3b 20 28 25 56 45 43 54 4f 52 2d 4d 41 50 21 20 ; (%VECTOR-MAP!
4c00: 3c 66 3e 20 3c 74 61 72 67 65 74 3e 20 3c 6c 65 <f> <target> <le
4c10: 6e 67 74 68 3e 20 3c 76 65 63 74 6f 72 3e 29 20 ngth> <vector>)
4c20: 2d 3e 20 74 61 72 67 65 74 0a 3b 3b 3b 20 20 20 -> target.;;;
4c30: 20 20 28 46 20 3c 69 6e 64 65 78 3e 20 3c 65 6c (F <index> <el
4c40: 74 3e 29 20 2d 3e 20 65 6c 74 27 0a 28 64 65 66 t>) -> elt'.(def
4c50: 69 6e 65 20 25 76 65 63 74 6f 72 2d 6d 61 70 31 ine %vector-map1
4c60: 21 0a 20 20 28 6c 65 74 72 65 63 20 28 28 6c 6f !. (letrec ((lo
4c70: 6f 70 20 28 6c 61 6d 62 64 61 20 28 66 20 74 61 op (lambda (f ta
4c80: 72 67 65 74 20 76 65 63 20 69 29 0a 20 20 20 20 rget vec i).
4c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4ca0: 69 66 20 28 7a 65 72 6f 3f 20 69 29 0a 20 20 20 if (zero? i).
4cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cc0: 20 20 20 20 74 61 72 67 65 74 0a 20 20 20 20 20 target.
4cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ce0: 20 20 28 6c 65 74 20 28 28 6a 20 28 2d 20 69 20 (let ((j (- i
4cf0: 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 1))).
4d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
4d10: 65 63 74 6f 72 2d 73 65 74 21 20 74 61 72 67 65 ector-set! targe
4d20: 74 20 6a 0a 20 20 20 20 20 20 20 20 20 20 20 20 t j.
4d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d40: 20 20 20 20 20 20 20 20 20 20 28 66 20 6a 20 28 (f j (
4d50: 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 6a vector-ref vec j
4d60: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
4d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
4d80: 6f 70 20 66 20 74 61 72 67 65 74 20 76 65 63 20 op f target vec
4d90: 6a 29 29 29 29 29 29 0a 20 20 20 20 28 6c 61 6d j)))))). (lam
4da0: 62 64 61 20 28 66 20 74 61 72 67 65 74 20 76 65 bda (f target ve
4db0: 63 20 6c 65 6e 29 0a 20 20 20 20 20 20 28 6c 6f c len). (lo
4dc0: 6f 70 20 66 20 74 61 72 67 65 74 20 76 65 63 20 op f target vec
4dd0: 6c 65 6e 29 29 29 29 0a 0a 3b 3b 3b 20 28 25 56 len))))..;;; (%V
4de0: 45 43 54 4f 52 2d 4d 41 50 32 2b 21 20 3c 66 3e ECTOR-MAP2+! <f>
4df0: 20 3c 74 61 72 67 65 74 3e 20 3c 76 65 63 74 6f <target> <vecto
4e00: 72 73 3e 20 3c 6c 65 6e 3e 29 20 2d 3e 20 74 61 rs> <len>) -> ta
4e10: 72 67 65 74 0a 3b 3b 3b 20 20 20 20 20 28 46 20 rget.;;; (F
4e20: 3c 69 6e 64 65 78 3e 20 3c 65 6c 74 3e 20 2e 2e <index> <elt> ..
4e30: 2e 29 20 2d 3e 20 65 6c 74 27 0a 28 64 65 66 69 .) -> elt'.(defi
4e40: 6e 65 20 25 76 65 63 74 6f 72 2d 6d 61 70 32 2b ne %vector-map2+
4e50: 21 0a 20 20 28 6c 65 74 72 65 63 20 28 28 6c 6f !. (letrec ((lo
4e60: 6f 70 20 28 6c 61 6d 62 64 61 20 28 66 20 74 61 op (lambda (f ta
4e70: 72 67 65 74 20 76 65 63 74 6f 72 73 20 69 29 0a rget vectors i).
4e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e90: 20 20 20 28 69 66 20 28 7a 65 72 6f 3f 20 69 29 (if (zero? i)
4ea0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4eb0: 20 20 20 20 20 20 20 20 74 61 72 67 65 74 0a 20 target.
4ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ed0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6a 20 28 (let ((j (
4ee0: 2d 20 69 20 31 29 29 29 0a 20 20 20 20 20 20 20 - i 1))).
4ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f00: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 (vector-set! t
4f10: 61 72 67 65 74 20 6a 0a 20 20 20 20 20 20 20 20 arget j.
4f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f30: 20 20 20 28 61 70 70 6c 79 20 66 20 6a 20 28 76 (apply f j (v
4f40: 65 63 74 6f 72 73 2d 72 65 66 20 76 65 63 74 6f ectors-ref vecto
4f50: 72 73 20 6a 29 29 29 0a 20 20 20 20 20 20 20 20 rs j))).
4f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f70: 20 28 6c 6f 6f 70 20 66 20 74 61 72 67 65 74 20 (loop f target
4f80: 76 65 63 74 6f 72 73 20 6a 29 29 29 29 29 29 0a vectors j)))))).
4f90: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 20 74 (lambda (f t
4fa0: 61 72 67 65 74 20 76 65 63 74 6f 72 73 20 6c 65 arget vectors le
4fb0: 6e 29 0a 20 20 20 20 20 20 28 6c 6f 6f 70 20 66 n). (loop f
4fc0: 20 74 61 72 67 65 74 20 76 65 63 74 6f 72 73 20 target vectors
4fd0: 6c 65 6e 29 29 29 29 0a 0a 0c 0a 0a 3b 3b 3b 3b len)))).....;;;;
4fe0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4ff0: 3b 3b 3b 3b 20 2a 2a 2a 2a 2a 20 76 65 63 74 6f ;;;; ***** vecto
5000: 72 2d 6c 69 62 20 2a 2a 2a 2a 2a 20 3b 3b 3b 3b r-lib ***** ;;;;
5010: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5020: 3b 3b 3b 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d ;;;..;;; -------
5030: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b -------------.;;
5040: 3b 20 43 6f 6e 73 74 72 75 63 74 6f 72 73 0a 0a ; Constructors..
5050: 3b 3b 3b 20 28 4d 41 4b 45 2d 56 45 43 54 4f 52 ;;; (MAKE-VECTOR
5060: 20 3c 73 69 7a 65 3e 20 5b 3c 66 69 6c 6c 3e 5d <size> [<fill>]
5070: 29 20 2d 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 ) -> vector.;;;
5080: 20 20 5b 52 35 52 53 5d 20 43 72 65 61 74 65 20 [R5RS] Create
5090: 61 20 76 65 63 74 6f 72 20 6f 66 20 6c 65 6e 67 a vector of leng
50a0: 74 68 20 4c 45 4e 47 54 48 2e 20 20 49 66 20 46 th LENGTH. If F
50b0: 49 4c 4c 20 69 73 20 70 72 65 73 65 6e 74 2c 0a ILL is present,.
50c0: 3b 3b 3b 20 20 20 69 6e 69 74 69 61 6c 69 7a 65 ;;; initialize
50d0: 20 65 61 63 68 20 73 6c 6f 74 20 69 6e 20 74 68 each slot in th
50e0: 65 20 76 65 63 74 6f 72 20 77 69 74 68 20 69 74 e vector with it
50f0: 3b 20 69 66 20 6e 6f 74 2c 20 74 68 65 20 76 65 ; if not, the ve
5100: 63 74 6f 72 27 73 0a 3b 3b 3b 20 20 20 69 6e 69 ctor's.;;; ini
5110: 74 69 61 6c 20 63 6f 6e 74 65 6e 74 73 20 61 72 tial contents ar
5120: 65 20 75 6e 73 70 65 63 69 66 69 65 64 2e 0a 3b e unspecified..;
5130: 3b 20 28 64 65 66 69 6e 65 20 6d 61 6b 65 2d 76 ; (define make-v
5140: 65 63 74 6f 72 20 6d 61 6b 65 2d 76 65 63 74 6f ector make-vecto
5150: 72 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 20 r)..;;; (VECTOR
5160: 3c 65 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 76 65 <elt> ...) -> ve
5170: 63 74 6f 72 0a 3b 3b 3b 20 20 20 5b 52 35 52 53 ctor.;;; [R5RS
5180: 5d 20 43 72 65 61 74 65 20 61 20 76 65 63 74 6f ] Create a vecto
5190: 72 20 63 6f 6e 74 61 69 6e 69 6e 67 20 45 4c 45 r containing ELE
51a0: 4d 45 4e 54 20 2e 2e 2e 2c 20 69 6e 20 6f 72 64 MENT ..., in ord
51b0: 65 72 2e 0a 3b 3b 20 28 64 65 66 69 6e 65 20 76 er..;; (define v
51c0: 65 63 74 6f 72 20 76 65 63 74 6f 72 29 0a 0a 3b ector vector)..;
51d0: 3b 3b 20 54 68 69 73 20 6f 75 67 68 74 20 74 6f ;; This ought to
51e0: 20 62 65 20 61 62 6c 65 20 74 6f 20 62 65 20 69 be able to be i
51f0: 6d 70 6c 65 6d 65 6e 74 65 64 20 6d 75 63 68 20 mplemented much
5200: 6d 6f 72 65 20 65 66 66 69 63 69 65 6e 74 6c 79 more efficiently
5210: 20 2d 2d 20 69 66 0a 3b 3b 3b 20 77 65 20 68 61 -- if.;;; we ha
5220: 76 65 20 74 68 65 20 6e 75 6d 62 65 72 20 6f 66 ve the number of
5230: 20 61 72 67 75 6d 65 6e 74 73 20 61 76 61 69 6c arguments avail
5240: 61 62 6c 65 20 74 6f 20 75 73 2c 20 77 65 20 63 able to us, we c
5250: 61 6e 20 63 72 65 61 74 65 20 74 68 65 0a 3b 3b an create the.;;
5260: 3b 20 76 65 63 74 6f 72 20 77 69 74 68 6f 75 74 ; vector without
5270: 20 75 73 69 6e 67 20 4c 45 4e 47 54 48 20 74 6f using LENGTH to
5280: 20 64 65 74 65 72 6d 69 6e 65 20 74 68 65 20 6e determine the n
5290: 75 6d 62 65 72 20 6f 66 20 65 6c 65 6d 65 6e 74 umber of element
52a0: 73 20 69 74 0a 3b 3b 3b 20 73 68 6f 75 6c 64 20 s it.;;; should
52b0: 68 61 76 65 2e 0a 3b 28 64 65 66 69 6e 65 20 28 have..;(define (
52c0: 76 65 63 74 6f 72 20 2e 20 65 6c 65 6d 65 6e 74 vector . element
52d0: 73 29 20 28 6c 69 73 74 2d 3e 76 65 63 74 6f 72 s) (list->vector
52e0: 20 65 6c 65 6d 65 6e 74 73 29 29 0a 0a 3b 3b 3b elements))..;;;
52f0: 20 28 56 45 43 54 4f 52 2d 55 4e 46 4f 4c 44 20 (VECTOR-UNFOLD
5300: 3c 66 3e 20 3c 6c 65 6e 67 74 68 3e 20 3c 69 6e <f> <length> <in
5310: 69 74 69 61 6c 2d 73 65 65 64 3e 20 2e 2e 2e 29 itial-seed> ...)
5320: 20 2d 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 -> vector.;;;
5330: 20 20 20 28 46 20 3c 69 6e 64 65 78 3e 20 3c 73 (F <index> <s
5340: 65 65 64 3e 20 2e 2e 2e 29 20 2d 3e 20 5b 65 6c eed> ...) -> [el
5350: 74 20 73 65 65 64 27 20 2e 2e 2e 5d 0a 3b 3b 3b t seed' ...].;;;
5360: 20 20 20 54 68 65 20 66 75 6e 64 61 6d 65 6e 74 The fundament
5370: 61 6c 20 76 65 63 74 6f 72 20 63 6f 6e 73 74 72 al vector constr
5380: 75 63 74 6f 72 2e 20 20 43 72 65 61 74 65 73 20 uctor. Creates
5390: 61 20 76 65 63 74 6f 72 20 77 68 6f 73 65 0a 3b a vector whose.;
53a0: 3b 3b 20 20 20 6c 65 6e 67 74 68 20 69 73 20 4c ;; length is L
53b0: 45 4e 47 54 48 20 61 6e 64 20 69 74 65 72 61 74 ENGTH and iterat
53c0: 65 73 20 61 63 72 6f 73 73 20 65 61 63 68 20 69 es across each i
53d0: 6e 64 65 78 20 4b 20 62 65 74 77 65 65 6e 20 30 ndex K between 0
53e0: 20 61 6e 64 0a 3b 3b 3b 20 20 20 4c 45 4e 47 54 and.;;; LENGT
53f0: 48 2c 20 61 70 70 6c 79 69 6e 67 20 46 20 61 74 H, applying F at
5400: 20 65 61 63 68 20 69 74 65 72 61 74 69 6f 6e 20 each iteration
5410: 74 6f 20 74 68 65 20 63 75 72 72 65 6e 74 20 69 to the current i
5420: 6e 64 65 78 20 61 6e 64 20 74 68 65 0a 3b 3b 3b ndex and the.;;;
5430: 20 20 20 63 75 72 72 65 6e 74 20 73 65 65 64 73 current seeds
5440: 20 74 6f 20 72 65 63 65 69 76 65 20 4e 2b 31 20 to receive N+1
5450: 76 61 6c 75 65 73 3a 20 66 69 72 73 74 2c 20 74 values: first, t
5460: 68 65 20 65 6c 65 6d 65 6e 74 20 74 6f 20 70 75 he element to pu
5470: 74 20 69 6e 0a 3b 3b 3b 20 20 20 74 68 65 20 4b t in.;;; the K
5480: 74 68 20 73 6c 6f 74 20 61 6e 64 20 74 68 65 6e th slot and then
5490: 20 4e 20 6e 65 77 20 73 65 65 64 73 20 66 6f 72 N new seeds for
54a0: 20 74 68 65 20 6e 65 78 74 20 69 74 65 72 61 74 the next iterat
54b0: 69 6f 6e 2e 0a 28 64 65 66 69 6e 65 20 76 65 63 ion..(define vec
54c0: 74 6f 72 2d 75 6e 66 6f 6c 64 0a 20 20 28 6c 65 tor-unfold. (le
54d0: 74 72 65 63 20 28 28 74 61 62 75 6c 61 74 65 21 trec ((tabulate!
54e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54f0: 20 20 20 3b 20 53 70 65 63 69 61 6c 20 7a 65 72 ; Special zer
5500: 6f 2d 73 65 65 64 20 63 61 73 65 2e 0a 20 20 20 o-seed case..
5510: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
5520: 20 28 66 20 76 65 63 20 69 20 6c 65 6e 29 0a 20 (f vec i len).
5530: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
5540: 6e 64 20 28 28 3c 20 69 20 6c 65 6e 29 0a 20 20 nd ((< i len).
5550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5560: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
5570: 76 65 63 20 69 20 28 66 20 69 29 29 0a 20 20 20 vec i (f i)).
5580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5590: 20 20 28 74 61 62 75 6c 61 74 65 21 20 66 20 76 (tabulate! f v
55a0: 65 63 20 28 2b 20 69 20 31 29 20 6c 65 6e 29 29 ec (+ i 1) len))
55b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
55c0: 75 6e 66 6f 6c 64 31 21 20 20 20 20 20 20 20 20 unfold1!
55d0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 46 61 ; Fa
55e0: 73 74 20 70 61 74 68 20 66 6f 72 20 6f 6e 65 20 st path for one
55f0: 73 65 65 64 2e 0a 20 20 20 20 20 20 20 20 20 20 seed..
5600: 20 20 28 6c 61 6d 62 64 61 20 28 66 20 76 65 63 (lambda (f vec
5610: 20 69 20 6c 65 6e 20 73 65 65 64 29 0a 20 20 20 i len seed).
5620: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
5630: 3c 20 69 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 < i len).
5640: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 63 65 (rece
5650: 69 76 65 20 28 65 6c 74 20 6e 65 77 2d 73 65 65 ive (elt new-see
5660: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
5670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
5680: 20 69 20 73 65 65 64 29 0a 20 20 20 20 20 20 20 i seed).
5690: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
56a0: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 69 20 ctor-set! vec i
56b0: 65 6c 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 elt).
56c0: 20 20 20 20 20 20 20 20 20 28 75 6e 66 6f 6c 64 (unfold
56d0: 31 21 20 66 20 76 65 63 20 28 2b 20 69 20 31 29 1! f vec (+ i 1)
56e0: 20 6c 65 6e 20 6e 65 77 2d 73 65 65 64 29 29 29 len new-seed)))
56f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 75 )). (u
5700: 6e 66 6f 6c 64 32 2b 21 20 20 20 20 20 20 20 20 nfold2+!
5710: 20 20 20 20 20 20 20 20 20 20 20 3b 20 53 6c 6f ; Slo
5720: 77 65 72 20 76 61 72 69 61 6e 74 20 66 6f 72 20 wer variant for
5730: 4e 20 73 65 65 64 73 2e 0a 20 20 20 20 20 20 20 N seeds..
5740: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 20 (lambda (f
5750: 76 65 63 20 69 20 6c 65 6e 20 73 65 65 64 73 29 vec i len seeds)
5760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
5770: 69 66 20 28 3c 20 69 20 6c 65 6e 29 0a 20 20 20 if (< i len).
5780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5790: 72 65 63 65 69 76 65 20 28 65 6c 74 20 2e 20 6e receive (elt . n
57a0: 65 77 2d 73 65 65 64 73 29 0a 20 20 20 20 20 20 ew-seeds).
57b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57c0: 20 20 20 20 20 28 61 70 70 6c 79 20 66 20 69 20 (apply f i
57d0: 73 65 65 64 73 29 0a 20 20 20 20 20 20 20 20 20 seeds).
57e0: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
57f0: 6f 72 2d 73 65 74 21 20 76 65 63 20 69 20 65 6c or-set! vec i el
5800: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
5810: 20 20 20 20 20 20 20 28 75 6e 66 6f 6c 64 32 2b (unfold2+
5820: 21 20 66 20 76 65 63 20 28 2b 20 69 20 31 29 20 ! f vec (+ i 1)
5830: 6c 65 6e 20 6e 65 77 2d 73 65 65 64 73 29 29 29 len new-seeds)))
5840: 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 ))). (lambda
5850: 28 66 20 6c 65 6e 20 2e 20 69 6e 69 74 69 61 6c (f len . initial
5860: 2d 73 65 65 64 73 29 0a 20 20 20 20 20 20 28 6c -seeds). (l
5870: 65 74 20 28 28 66 20 20 20 28 63 68 65 63 6b 2d et ((f (check-
5880: 74 79 70 65 20 70 72 6f 63 65 64 75 72 65 3f 20 type procedure?
5890: 20 66 20 20 20 76 65 63 74 6f 72 2d 75 6e 66 6f f vector-unfo
58a0: 6c 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ld)).
58b0: 20 28 6c 65 6e 20 28 63 68 65 63 6b 2d 74 79 70 (len (check-typ
58c0: 65 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 6c 65 e nonneg-int? le
58d0: 6e 20 76 65 63 74 6f 72 2d 75 6e 66 6f 6c 64 29 n vector-unfold)
58e0: 29 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 )). (let
58f0: 28 28 76 65 63 20 28 6d 61 6b 65 2d 76 65 63 74 ((vec (make-vect
5900: 6f 72 20 6c 65 6e 29 29 29 0a 20 20 20 20 20 20 or len))).
5910: 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c (cond ((null
5920: 3f 20 69 6e 69 74 69 61 6c 2d 73 65 65 64 73 29 ? initial-seeds)
5930: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5940: 20 20 28 74 61 62 75 6c 61 74 65 21 20 66 20 76 (tabulate! f v
5950: 65 63 20 30 20 6c 65 6e 29 29 0a 20 20 20 20 20 ec 0 len)).
5960: 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c ((nul
5970: 6c 3f 20 28 63 64 72 20 69 6e 69 74 69 61 6c 2d l? (cdr initial-
5980: 73 65 65 64 73 29 29 0a 20 20 20 20 20 20 20 20 seeds)).
5990: 20 20 20 20 20 20 20 20 20 28 75 6e 66 6f 6c 64 (unfold
59a0: 31 21 20 66 20 76 65 63 20 30 20 6c 65 6e 20 28 1! f vec 0 len (
59b0: 63 61 72 20 69 6e 69 74 69 61 6c 2d 73 65 65 64 car initial-seed
59c0: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
59d0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
59e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 75 6e 66 (unf
59f0: 6f 6c 64 32 2b 21 20 66 20 76 65 63 20 30 20 6c old2+! f vec 0 l
5a00: 65 6e 20 69 6e 69 74 69 61 6c 2d 73 65 65 64 73 en initial-seeds
5a10: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 76 65 ))). ve
5a20: 63 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 c)))))..;;; (VEC
5a30: 54 4f 52 2d 55 4e 46 4f 4c 44 2d 52 49 47 48 54 TOR-UNFOLD-RIGHT
5a40: 20 3c 66 3e 20 3c 6c 65 6e 67 74 68 3e 20 3c 69 <f> <length> <i
5a50: 6e 69 74 69 61 6c 2d 73 65 65 64 3e 20 2e 2e 2e nitial-seed> ...
5a60: 29 20 2d 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 ) -> vector.;;;
5a70: 20 20 20 20 28 46 20 3c 73 65 65 64 3e 20 2e 2e (F <seed> ..
5a80: 2e 29 20 2d 3e 20 5b 73 65 65 64 27 20 2e 2e 2e .) -> [seed' ...
5a90: 5d 0a 3b 3b 3b 20 20 20 4c 69 6b 65 20 56 45 43 ].;;; Like VEC
5aa0: 54 4f 52 2d 55 4e 46 4f 4c 44 2c 20 62 75 74 20 TOR-UNFOLD, but
5ab0: 69 74 20 67 65 6e 65 72 61 74 65 73 20 65 6c 65 it generates ele
5ac0: 6d 65 6e 74 73 20 66 72 6f 6d 20 4c 45 4e 47 54 ments from LENGT
5ad0: 48 20 74 6f 20 30 0a 3b 3b 3b 20 20 20 28 73 74 H to 0.;;; (st
5ae0: 69 6c 6c 20 65 78 63 6c 75 73 69 76 65 20 77 69 ill exclusive wi
5af0: 74 68 20 20 4c 45 4e 47 54 48 20 61 6e 64 20 69 th LENGTH and i
5b00: 6e 63 6c 75 73 69 76 65 20 77 69 74 68 20 30 29 nclusive with 0)
5b10: 2c 20 6e 6f 74 20 30 20 74 6f 0a 3b 3b 3b 20 20 , not 0 to.;;;
5b20: 20 4c 45 4e 47 54 48 20 61 73 20 77 69 74 68 20 LENGTH as with
5b30: 56 45 43 54 4f 52 2d 55 4e 46 4f 4c 44 2e 0a 28 VECTOR-UNFOLD..(
5b40: 64 65 66 69 6e 65 20 76 65 63 74 6f 72 2d 75 6e define vector-un
5b50: 66 6f 6c 64 2d 72 69 67 68 74 0a 20 20 28 6c 65 fold-right. (le
5b60: 74 72 65 63 20 28 28 74 61 62 75 6c 61 74 65 21 trec ((tabulate!
5b70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 . (la
5b80: 6d 62 64 61 20 28 66 20 76 65 63 20 69 29 0a 20 mbda (f vec i).
5b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
5ba0: 6e 64 20 28 28 3e 3d 20 69 20 30 29 0a 20 20 20 nd ((>= i 0).
5bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bc0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 (vector-set! v
5bd0: 65 63 20 69 20 28 66 20 69 29 29 0a 20 20 20 20 ec i (f i)).
5be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bf0: 20 28 74 61 62 75 6c 61 74 65 21 20 66 20 76 65 (tabulate! f ve
5c00: 63 20 28 2d 20 69 20 31 29 29 29 29 29 29 0a 20 c (- i 1)))))).
5c10: 20 20 20 20 20 20 20 20 20 20 28 75 6e 66 6f 6c (unfol
5c20: 64 31 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 d1!.
5c30: 28 6c 61 6d 62 64 61 20 28 66 20 76 65 63 20 69 (lambda (f vec i
5c40: 20 73 65 65 64 29 0a 20 20 20 20 20 20 20 20 20 seed).
5c50: 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 20 30 (if (>= i 0
5c60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5c70: 20 20 20 20 28 72 65 63 65 69 76 65 20 28 65 6c (receive (el
5c80: 74 20 6e 65 77 2d 73 65 65 64 29 0a 20 20 20 20 t new-seed).
5c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ca0: 20 20 20 20 20 20 20 28 66 20 69 20 73 65 65 64 (f i seed
5cb0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5cc0: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
5cd0: 74 21 20 76 65 63 20 69 20 65 6c 74 29 0a 20 20 t! vec i elt).
5ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cf0: 20 20 28 75 6e 66 6f 6c 64 31 21 20 66 20 76 65 (unfold1! f ve
5d00: 63 20 28 2d 20 69 20 31 29 20 6e 65 77 2d 73 65 c (- i 1) new-se
5d10: 65 64 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ed))))).
5d20: 20 20 20 28 75 6e 66 6f 6c 64 32 2b 21 0a 20 20 (unfold2+!.
5d30: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
5d40: 61 20 28 66 20 76 65 63 20 69 20 73 65 65 64 73 a (f vec i seeds
5d50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5d60: 28 69 66 20 28 3e 3d 20 69 20 30 29 0a 20 20 20 (if (>= i 0).
5d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5d80: 72 65 63 65 69 76 65 20 28 65 6c 74 20 2e 20 6e receive (elt . n
5d90: 65 77 2d 73 65 65 64 73 29 0a 20 20 20 20 20 20 ew-seeds).
5da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5db0: 20 20 20 20 20 28 61 70 70 6c 79 20 66 20 69 20 (apply f i
5dc0: 73 65 65 64 73 29 0a 20 20 20 20 20 20 20 20 20 seeds).
5dd0: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
5de0: 6f 72 2d 73 65 74 21 20 76 65 63 20 69 20 65 6c or-set! vec i el
5df0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
5e00: 20 20 20 20 20 20 20 28 75 6e 66 6f 6c 64 32 2b (unfold2+
5e10: 21 20 66 20 76 65 63 20 28 2d 20 69 20 31 29 20 ! f vec (- i 1)
5e20: 6e 65 77 2d 73 65 65 64 73 29 29 29 29 29 29 0a new-seeds)))))).
5e30: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 20 6c (lambda (f l
5e40: 65 6e 20 2e 20 69 6e 69 74 69 61 6c 2d 73 65 65 en . initial-see
5e50: 64 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 ds). (let (
5e60: 28 66 20 20 20 28 63 68 65 63 6b 2d 74 79 70 65 (f (check-type
5e70: 20 70 72 6f 63 65 64 75 72 65 3f 20 20 66 20 20 procedure? f
5e80: 20 76 65 63 74 6f 72 2d 75 6e 66 6f 6c 64 2d 72 vector-unfold-r
5e90: 69 67 68 74 29 29 0a 20 20 20 20 20 20 20 20 20 ight)).
5ea0: 20 20 20 28 6c 65 6e 20 28 63 68 65 63 6b 2d 74 (len (check-t
5eb0: 79 70 65 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 ype nonneg-int?
5ec0: 6c 65 6e 20 76 65 63 74 6f 72 2d 75 6e 66 6f 6c len vector-unfol
5ed0: 64 2d 72 69 67 68 74 29 29 29 0a 20 20 20 20 20 d-right))).
5ee0: 20 20 20 28 6c 65 74 20 28 28 76 65 63 20 28 6d (let ((vec (m
5ef0: 61 6b 65 2d 76 65 63 74 6f 72 20 6c 65 6e 29 29 ake-vector len))
5f00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
5f10: 69 20 28 2d 20 6c 65 6e 20 31 29 29 29 0a 20 20 i (- len 1))).
5f20: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 (cond ((
5f30: 6e 75 6c 6c 3f 20 69 6e 69 74 69 61 6c 2d 73 65 null? initial-se
5f40: 65 64 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 eds).
5f50: 20 20 20 20 20 20 28 74 61 62 75 6c 61 74 65 21 (tabulate!
5f60: 20 66 20 76 65 63 20 69 29 29 0a 20 20 20 20 20 f vec i)).
5f70: 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c ((nul
5f80: 6c 3f 20 28 63 64 72 20 69 6e 69 74 69 61 6c 2d l? (cdr initial-
5f90: 73 65 65 64 73 29 29 0a 20 20 20 20 20 20 20 20 seeds)).
5fa0: 20 20 20 20 20 20 20 20 20 28 75 6e 66 6f 6c 64 (unfold
5fb0: 31 21 20 20 66 20 76 65 63 20 69 20 28 63 61 72 1! f vec i (car
5fc0: 20 69 6e 69 74 69 61 6c 2d 73 65 65 64 73 29 29 initial-seeds))
5fd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5fe0: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
5ff0: 20 20 20 20 20 20 20 20 20 28 75 6e 66 6f 6c 64 (unfold
6000: 32 2b 21 20 66 20 76 65 63 20 69 20 69 6e 69 74 2+! f vec i init
6010: 69 61 6c 2d 73 65 65 64 73 29 29 29 0a 20 20 20 ial-seeds))).
6020: 20 20 20 20 20 20 20 76 65 63 29 29 29 29 29 0a vec))))).
6030: 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 43 4f 50 .;;; (VECTOR-COP
6040: 59 20 3c 76 65 63 74 6f 72 3e 20 5b 3c 73 74 61 Y <vector> [<sta
6050: 72 74 3e 20 3c 65 6e 64 3e 20 3c 66 69 6c 6c 3e rt> <end> <fill>
6060: 5d 29 20 2d 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b ]) -> vector.;;;
6070: 20 20 20 43 72 65 61 74 65 20 61 20 6e 65 77 6c Create a newl
6080: 79 20 61 6c 6c 6f 63 61 74 65 64 20 76 65 63 74 y allocated vect
6090: 6f 72 20 63 6f 6e 74 61 69 6e 69 6e 67 20 74 68 or containing th
60a0: 65 20 65 6c 65 6d 65 6e 74 73 20 66 72 6f 6d 20 e elements from
60b0: 74 68 65 0a 3b 3b 3b 20 20 20 72 61 6e 67 65 20 the.;;; range
60c0: 5b 53 54 41 52 54 2c 45 4e 44 29 20 69 6e 20 56 [START,END) in V
60d0: 45 43 54 4f 52 2e 20 20 53 54 41 52 54 20 64 65 ECTOR. START de
60e0: 66 61 75 6c 74 73 20 74 6f 20 30 3b 20 45 4e 44 faults to 0; END
60f0: 20 64 65 66 61 75 6c 74 73 0a 3b 3b 3b 20 20 20 defaults.;;;
6100: 74 6f 20 74 68 65 20 6c 65 6e 67 74 68 20 6f 66 to the length of
6110: 20 56 45 43 54 4f 52 2e 20 20 45 4e 44 20 6d 61 VECTOR. END ma
6120: 79 20 62 65 20 67 72 65 61 74 65 72 20 74 68 61 y be greater tha
6130: 6e 20 74 68 65 20 6c 65 6e 67 74 68 20 6f 66 0a n the length of.
6140: 3b 3b 3b 20 20 20 56 45 43 54 4f 52 2c 20 69 6e ;;; VECTOR, in
6150: 20 77 68 69 63 68 20 63 61 73 65 20 74 68 65 20 which case the
6160: 76 65 63 74 6f 72 20 69 73 20 65 6e 6c 61 72 67 vector is enlarg
6170: 65 64 3b 20 69 66 20 46 49 4c 4c 20 69 73 20 70 ed; if FILL is p
6180: 61 73 73 65 64 2c 0a 3b 3b 3b 20 20 20 74 68 65 assed,.;;; the
6190: 20 6e 65 77 20 6c 6f 63 61 74 69 6f 6e 73 20 66 new locations f
61a0: 72 6f 6d 20 77 68 69 63 68 20 74 68 65 72 65 20 rom which there
61b0: 69 73 20 6e 6f 20 72 65 73 70 65 63 74 69 76 65 is no respective
61c0: 20 65 6c 65 6d 65 6e 74 20 69 6e 0a 3b 3b 3b 20 element in.;;;
61d0: 20 20 56 45 43 54 4f 52 20 61 72 65 20 66 69 6c VECTOR are fil
61e0: 6c 65 64 20 77 69 74 68 20 46 49 4c 4c 2e 0a 0a led with FILL...
61f0: 28 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 2d (define (vector-
6200: 63 6f 70 79 20 76 65 63 20 2e 20 61 72 67 73 29 copy vec . args)
6210: 0a 20 20 28 6c 65 74 20 28 28 76 65 63 20 28 63 . (let ((vec (c
6220: 68 65 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 heck-type vector
6230: 3f 20 76 65 63 20 76 65 63 74 6f 72 2d 63 6f 70 ? vec vector-cop
6240: 79 29 29 29 0a 20 20 20 20 3b 3b 20 57 65 20 63 y))). ;; We c
6250: 61 6e 27 74 20 75 73 65 20 4c 45 54 2d 56 45 43 an't use LET-VEC
6260: 54 4f 52 2d 53 54 41 52 54 2b 45 4e 44 2c 20 62 TOR-START+END, b
6270: 65 63 61 75 73 65 20 77 65 20 68 61 76 65 20 6f ecause we have o
6280: 6e 65 20 6d 6f 72 65 0a 20 20 20 20 3b 3b 20 61 ne more. ;; a
6290: 72 67 75 6d 65 6e 74 2c 20 61 6e 64 20 77 65 20 rgument, and we
62a0: 77 61 6e 74 20 66 69 6e 65 72 20 63 6f 6e 74 72 want finer contr
62b0: 6f 6c 2c 20 74 6f 6f 2e 0a 20 20 20 20 3b 3b 0a ol, too.. ;;.
62c0: 20 20 20 20 3b 3b 20 4f 6c 69 6e 27 73 20 69 6d ;; Olin's im
62d0: 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 6f 66 20 plementation of
62e0: 4c 45 54 2a 2d 4f 50 54 49 4f 4e 41 4c 53 20 77 LET*-OPTIONALS w
62f0: 6f 75 6c 64 20 70 72 6f 76 65 20 75 73 65 66 75 ould prove usefu
6300: 6c 20 68 65 72 65 3a 0a 20 20 20 20 3b 3b 20 74 l here:. ;; t
6310: 68 65 20 62 75 69 6c 74 2d 69 6e 20 61 72 67 75 he built-in argu
6320: 6d 65 6e 74 2d 63 68 65 63 6b 73 2d 61 73 2d 79 ment-checks-as-y
6330: 6f 75 2d 67 6f 2d 61 6c 6f 6e 67 20 70 72 6f 64 ou-go-along prod
6340: 75 63 65 73 20 61 6c 6d 6f 73 74 0a 20 20 20 20 uces almost.
6350: 3b 3b 20 5f 65 78 61 63 74 6c 79 5f 20 74 68 65 ;; _exactly_ the
6360: 20 73 61 6d 65 20 63 6f 64 65 20 61 73 20 56 45 same code as VE
6370: 43 54 4f 52 2d 43 4f 50 59 3a 50 41 52 53 45 2d CTOR-COPY:PARSE-
6380: 41 52 47 53 2e 0a 20 20 20 20 28 72 65 63 65 69 ARGS.. (recei
6390: 76 65 20 28 73 74 61 72 74 20 65 6e 64 20 66 69 ve (start end fi
63a0: 6c 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ll).
63b0: 20 28 76 65 63 74 6f 72 2d 63 6f 70 79 3a 70 61 (vector-copy:pa
63c0: 72 73 65 2d 61 72 67 73 20 76 65 63 20 61 72 67 rse-args vec arg
63d0: 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 s). (let ((
63e0: 6e 65 77 2d 76 65 63 74 6f 72 20 28 6d 61 6b 65 new-vector (make
63f0: 2d 76 65 63 74 6f 72 20 28 2d 20 65 6e 64 20 73 -vector (- end s
6400: 74 61 72 74 29 20 66 69 6c 6c 29 29 29 0a 20 20 tart) fill))).
6410: 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 2d 63 (%vector-c
6420: 6f 70 79 21 20 6e 65 77 2d 76 65 63 74 6f 72 20 opy! new-vector
6430: 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
6440: 20 20 20 20 20 20 20 20 20 76 65 63 20 20 20 20 vec
6450: 20 20 20 20 73 74 61 72 74 0a 20 20 20 20 20 20 start.
6460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6470: 20 28 69 66 20 28 3e 20 65 6e 64 20 28 76 65 63 (if (> end (vec
6480: 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 29 tor-length vec))
6490: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
64a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec
64b0: 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a tor-length vec).
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 65 6e 64 29 29 end))
64e0: 0a 20 20 20 20 20 20 20 20 6e 65 77 2d 76 65 63 . new-vec
64f0: 74 6f 72 29 29 29 29 0a 0a 3b 3b 3b 20 41 75 78 tor))))..;;; Aux
6500: 69 6c 69 61 72 79 20 66 6f 72 20 56 45 43 54 4f iliary for VECTO
6510: 52 2d 43 4f 50 59 2e 0a 3b 3b 3b 20 5b 77 64 63 R-COPY..;;; [wdc
6520: 5d 20 43 6f 72 72 65 63 74 65 64 20 74 6f 20 61 ] Corrected to a
6530: 6c 6c 6f 77 20 30 20 3c 3d 20 73 74 61 72 74 20 llow 0 <= start
6540: 3c 3d 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 <= (vector-lengt
6550: 68 20 76 65 63 29 2e 0a 28 64 65 66 69 6e 65 20 h vec)..(define
6560: 28 76 65 63 74 6f 72 2d 63 6f 70 79 3a 70 61 72 (vector-copy:par
6570: 73 65 2d 61 72 67 73 20 76 65 63 20 61 72 67 73 se-args vec args
6580: 29 0a 20 20 28 64 65 66 69 6e 65 20 28 70 61 72 ). (define (par
6590: 73 65 2d 61 72 67 73 20 73 74 61 72 74 20 65 6e se-args start en
65a0: 64 20 6e 20 66 69 6c 6c 29 0a 20 20 20 20 28 6c d n fill). (l
65b0: 65 74 20 28 28 73 74 61 72 74 20 28 63 68 65 63 et ((start (chec
65c0: 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 67 2d 69 6e k-type nonneg-in
65d0: 74 3f 20 73 74 61 72 74 20 76 65 63 74 6f 72 2d t? start vector-
65e0: 63 6f 70 79 29 29 0a 20 20 20 20 20 20 20 20 20 copy)).
65f0: 20 28 65 6e 64 20 20 20 28 63 68 65 63 6b 2d 74 (end (check-t
6600: 79 70 65 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 ype nonneg-int?
6610: 65 6e 64 20 76 65 63 74 6f 72 2d 63 6f 70 79 29 end vector-copy)
6620: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 28 )). (cond (
6630: 28 61 6e 64 20 28 3c 3d 20 30 20 73 74 61 72 74 (and (<= 0 start
6640: 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 end).
6650: 20 20 20 20 20 20 20 20 28 3c 3d 20 73 74 61 72 (<= star
6660: 74 20 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 t n)).
6670: 20 20 20 28 76 61 6c 75 65 73 20 73 74 61 72 74 (values start
6680: 20 65 6e 64 20 66 69 6c 6c 29 29 0a 20 20 20 20 end fill)).
6690: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
66a0: 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f (erro
66b0: 72 20 22 69 6c 6c 65 67 61 6c 20 61 72 67 75 6d r "illegal argum
66c0: 65 6e 74 73 22 0a 20 20 20 20 20 20 20 20 20 20 ents".
66d0: 20 20 20 20 20 20 20 20 20 20 60 28 77 68 69 6c `(whil
66e0: 65 20 63 61 6c 6c 69 6e 67 20 2c 76 65 63 74 6f e calling ,vecto
66f0: 72 2d 63 6f 70 79 29 0a 20 20 20 20 20 20 20 20 r-copy).
6700: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 73 74 `(st
6710: 61 72 74 20 77 61 73 20 2c 73 74 61 72 74 29 0a art was ,start).
6720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6730: 20 20 20 20 60 28 65 6e 64 20 77 61 73 20 2c 65 `(end was ,e
6740: 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
6750: 20 20 20 20 20 20 20 20 60 28 76 65 63 74 6f 72 `(vector
6760: 20 77 61 73 20 2c 76 65 63 29 29 29 29 29 29 0a was ,vec)))))).
6770: 20 20 28 6c 65 74 20 28 28 6e 20 28 76 65 63 74 (let ((n (vect
6780: 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 29 29 or-length vec)))
6790: 0a 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c . (cond ((nul
67a0: 6c 3f 20 61 72 67 73 29 0a 20 20 20 20 20 20 20 l? args).
67b0: 20 20 20 20 28 70 61 72 73 65 2d 61 72 67 73 20 (parse-args
67c0: 30 20 6e 20 6e 20 28 75 6e 73 70 65 63 69 66 69 0 n n (unspecifi
67d0: 65 64 2d 76 61 6c 75 65 29 29 29 0a 20 20 20 20 ed-value))).
67e0: 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 ((null? (c
67f0: 64 72 20 61 72 67 73 29 29 0a 20 20 20 20 20 20 dr args)).
6800: 20 20 20 20 20 28 70 61 72 73 65 2d 61 72 67 73 (parse-args
6810: 20 28 63 61 72 20 61 72 67 73 29 20 6e 20 6e 20 (car args) n n
6820: 28 75 6e 73 70 65 63 69 66 69 65 64 2d 76 61 6c (unspecified-val
6830: 75 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ue))).
6840: 28 28 6e 75 6c 6c 3f 20 28 63 64 64 72 20 61 72 ((null? (cddr ar
6850: 67 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 gs)).
6860: 28 70 61 72 73 65 2d 61 72 67 73 20 28 63 61 72 (parse-args (car
6870: 20 61 72 67 73 29 20 28 63 61 64 72 20 61 72 67 args) (cadr arg
6880: 73 29 20 6e 20 28 75 6e 73 70 65 63 69 66 69 65 s) n (unspecifie
6890: 64 2d 76 61 6c 75 65 29 29 29 0a 20 20 20 20 20 d-value))).
68a0: 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 ((null? (cd
68b0: 64 64 72 20 61 72 67 73 29 29 0a 20 20 20 20 20 ddr args)).
68c0: 20 20 20 20 20 20 28 70 61 72 73 65 2d 61 72 67 (parse-arg
68d0: 73 20 28 63 61 72 20 61 72 67 73 29 20 28 63 61 s (car args) (ca
68e0: 64 72 20 61 72 67 73 29 20 6e 20 28 63 61 64 64 dr args) n (cadd
68f0: 72 20 61 72 67 73 29 29 29 0a 20 20 20 20 20 20 r args))).
6900: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
6910: 20 20 20 20 20 28 65 72 72 6f 72 20 22 74 6f 6f (error "too
6920: 20 6d 61 6e 79 20 61 72 67 75 6d 65 6e 74 73 22 many arguments"
6930: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6940: 20 20 20 76 65 63 74 6f 72 2d 63 6f 70 79 0a 20 vector-copy.
6950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6960: 20 28 63 64 64 64 72 20 61 72 67 73 29 29 29 29 (cdddr args))))
6970: 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d ))..;;; (VECTOR-
6980: 52 45 56 45 52 53 45 2d 43 4f 50 59 20 3c 76 65 REVERSE-COPY <ve
6990: 63 74 6f 72 3e 20 5b 3c 73 74 61 72 74 3e 20 3c ctor> [<start> <
69a0: 65 6e 64 3e 5d 29 20 2d 3e 20 76 65 63 74 6f 72 end>]) -> vector
69b0: 0a 3b 3b 3b 20 20 20 43 72 65 61 74 65 20 61 20 .;;; Create a
69c0: 6e 65 77 6c 79 20 61 6c 6c 6f 63 61 74 65 64 20 newly allocated
69d0: 76 65 63 74 6f 72 20 77 68 6f 73 65 20 65 6c 65 vector whose ele
69e0: 6d 65 6e 74 73 20 61 72 65 20 74 68 65 20 72 65 ments are the re
69f0: 76 65 72 73 65 64 0a 3b 3b 3b 20 20 20 73 65 71 versed.;;; seq
6a00: 75 65 6e 63 65 20 6f 66 20 65 6c 65 6d 65 6e 74 uence of element
6a10: 73 20 62 65 74 77 65 65 6e 20 53 54 41 52 54 20 s between START
6a20: 61 6e 64 20 45 4e 44 20 69 6e 20 56 45 43 54 4f and END in VECTO
6a30: 52 2e 20 20 53 54 41 52 54 27 73 0a 3b 3b 3b 20 R. START's.;;;
6a40: 20 20 64 65 66 61 75 6c 74 20 69 73 20 30 3b 20 default is 0;
6a50: 45 4e 44 27 73 20 64 65 66 61 75 6c 74 20 69 73 END's default is
6a60: 20 74 68 65 20 6c 65 6e 67 74 68 20 6f 66 20 56 the length of V
6a70: 45 43 54 4f 52 2e 0a 28 64 65 66 69 6e 65 20 28 ECTOR..(define (
6a80: 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 2d 63 vector-reverse-c
6a90: 6f 70 79 20 76 65 63 20 2e 20 6d 61 79 62 65 2d opy vec . maybe-
6aa0: 73 74 61 72 74 2b 65 6e 64 29 0a 20 20 28 6c 65 start+end). (le
6ab0: 74 2d 76 65 63 74 6f 72 2d 73 74 61 72 74 2b 65 t-vector-start+e
6ac0: 6e 64 20 76 65 63 74 6f 72 2d 72 65 76 65 72 73 nd vector-revers
6ad0: 65 2d 63 6f 70 79 20 76 65 63 20 6d 61 79 62 65 e-copy vec maybe
6ae0: 2d 73 74 61 72 74 2b 65 6e 64 0a 20 20 20 20 20 -start+end.
6af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b00: 20 20 20 28 73 74 61 72 74 20 65 6e 64 29 0a 20 (start end).
6b10: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 20 28 6d (let ((new (m
6b20: 61 6b 65 2d 76 65 63 74 6f 72 20 28 2d 20 65 6e ake-vector (- en
6b30: 64 20 73 74 61 72 74 29 29 29 29 0a 20 20 20 20 d start)))).
6b40: 20 20 28 25 76 65 63 74 6f 72 2d 72 65 76 65 72 (%vector-rever
6b50: 73 65 2d 63 6f 70 79 21 20 6e 65 77 20 30 20 76 se-copy! new 0 v
6b60: 65 63 20 73 74 61 72 74 20 65 6e 64 29 0a 20 20 ec start end).
6b70: 20 20 20 20 6e 65 77 29 29 29 0a 0a 3b 3b 3b 20 new)))..;;;
6b80: 28 56 45 43 54 4f 52 2d 41 50 50 45 4e 44 20 3c (VECTOR-APPEND <
6b90: 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d 3e 20 vector> ...) ->
6ba0: 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 20 41 70 70 vector.;;; App
6bb0: 65 6e 64 20 56 45 43 54 4f 52 20 2e 2e 2e 20 69 end VECTOR ... i
6bc0: 6e 74 6f 20 61 20 6e 65 77 6c 79 20 61 6c 6c 6f nto a newly allo
6bd0: 63 61 74 65 64 20 76 65 63 74 6f 72 20 61 6e 64 cated vector and
6be0: 20 72 65 74 75 72 6e 20 74 68 61 74 0a 3b 3b 3b return that.;;;
6bf0: 20 20 20 6e 65 77 20 76 65 63 74 6f 72 2e 0a 28 new vector..(
6c00: 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 2d 61 define (vector-a
6c10: 70 70 65 6e 64 20 2e 20 76 65 63 74 6f 72 73 29 ppend . vectors)
6c20: 0a 20 20 28 76 65 63 74 6f 72 2d 63 6f 6e 63 61 . (vector-conca
6c30: 74 65 6e 61 74 65 3a 61 75 78 20 76 65 63 74 6f tenate:aux vecto
6c40: 72 73 20 76 65 63 74 6f 72 2d 61 70 70 65 6e 64 rs vector-append
6c50: 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d ))..;;; (VECTOR-
6c60: 43 4f 4e 43 41 54 45 4e 41 54 45 20 3c 76 65 63 CONCATENATE <vec
6c70: 74 6f 72 2d 6c 69 73 74 3e 29 20 2d 3e 20 76 65 tor-list>) -> ve
6c80: 63 74 6f 72 0a 3b 3b 3b 20 20 20 43 6f 6e 63 61 ctor.;;; Conca
6c90: 74 65 6e 61 74 65 20 74 68 65 20 76 65 63 74 6f tenate the vecto
6ca0: 72 73 20 69 6e 20 56 45 43 54 4f 52 2d 4c 49 53 rs in VECTOR-LIS
6cb0: 54 2e 20 20 54 68 69 73 20 69 73 20 65 71 75 69 T. This is equi
6cc0: 76 61 6c 65 6e 74 20 74 6f 0a 3b 3b 3b 20 20 20 valent to.;;;
6cd0: 20 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 2d (apply vector-
6ce0: 61 70 70 65 6e 64 20 56 45 43 54 4f 52 2d 4c 49 append VECTOR-LI
6cf0: 53 54 29 0a 3b 3b 3b 20 20 20 62 75 74 20 56 45 ST).;;; but VE
6d00: 43 54 4f 52 2d 41 50 50 45 4e 44 20 74 65 6e 64 CTOR-APPEND tend
6d10: 73 20 74 6f 20 62 65 20 69 6d 70 6c 65 6d 65 6e s to be implemen
6d20: 74 65 64 20 69 6e 20 74 65 72 6d 73 20 6f 66 0a ted in terms of.
6d30: 3b 3b 3b 20 20 20 56 45 43 54 4f 52 2d 43 4f 4e ;;; VECTOR-CON
6d40: 43 41 54 45 4e 41 54 45 2c 20 61 6e 64 20 73 6f CATENATE, and so
6d50: 6d 65 20 53 63 68 65 6d 65 73 20 62 6f 72 6b 20 me Schemes bork
6d60: 77 68 65 6e 20 74 68 65 20 6c 69 73 74 20 74 6f when the list to
6d70: 20 61 70 70 6c 79 0a 3b 3b 3b 20 20 20 61 20 66 apply.;;; a f
6d80: 75 6e 63 74 69 6f 6e 20 74 6f 20 69 73 20 74 6f unction to is to
6d90: 6f 20 6c 6f 6e 67 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 o long..;;;.;;;
6da0: 41 63 74 75 61 6c 6c 79 2c 20 74 68 65 79 27 72 Actually, they'r
6db0: 65 20 62 6f 74 68 20 69 6d 70 6c 65 6d 65 6e 74 e both implement
6dc0: 65 64 20 69 6e 20 74 65 72 6d 73 20 6f 66 20 61 ed in terms of a
6dd0: 6e 20 69 6e 74 65 72 6e 61 6c 20 72 6f 75 74 69 n internal routi
6de0: 6e 65 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 63 ne..(define (vec
6df0: 74 6f 72 2d 63 6f 6e 63 61 74 65 6e 61 74 65 20 tor-concatenate
6e00: 76 65 63 74 6f 72 2d 6c 69 73 74 29 0a 20 20 28 vector-list). (
6e10: 76 65 63 74 6f 72 2d 63 6f 6e 63 61 74 65 6e 61 vector-concatena
6e20: 74 65 3a 61 75 78 20 76 65 63 74 6f 72 2d 6c 69 te:aux vector-li
6e30: 73 74 20 76 65 63 74 6f 72 2d 63 6f 6e 63 61 74 st vector-concat
6e40: 65 6e 61 74 65 29 29 0a 0a 3b 3b 3b 20 41 75 78 enate))..;;; Aux
6e50: 69 6c 69 61 72 79 20 66 6f 72 20 56 45 43 54 4f iliary for VECTO
6e60: 52 2d 41 50 50 45 4e 44 20 61 6e 64 20 56 45 43 R-APPEND and VEC
6e70: 54 4f 52 2d 43 4f 4e 43 41 54 45 4e 41 54 45 0a TOR-CONCATENATE.
6e80: 28 64 65 66 69 6e 65 20 76 65 63 74 6f 72 2d 63 (define vector-c
6e90: 6f 6e 63 61 74 65 6e 61 74 65 3a 61 75 78 0a 20 oncatenate:aux.
6ea0: 20 28 6c 65 74 72 65 63 20 28 28 63 6f 6d 70 75 (letrec ((compu
6eb0: 74 65 2d 6c 65 6e 67 74 68 0a 20 20 20 20 20 20 te-length.
6ec0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 (lambda (v
6ed0: 65 63 74 6f 72 73 20 6c 65 6e 20 63 61 6c 6c 65 ectors len calle
6ee0: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e).
6ef0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 76 65 63 74 (if (null? vect
6f00: 6f 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ors).
6f10: 20 20 20 20 20 20 20 6c 65 6e 0a 20 20 20 20 20 len.
6f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
6f30: 74 20 28 28 76 65 63 20 28 63 68 65 63 6b 2d 74 t ((vec (check-t
6f40: 79 70 65 20 76 65 63 74 6f 72 3f 20 28 63 61 72 ype vector? (car
6f50: 20 76 65 63 74 6f 72 73 29 0a 20 20 20 20 20 20 vectors).
6f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f80: 20 20 20 63 61 6c 6c 65 65 29 29 29 0a 20 20 20 callee))).
6f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fa0: 20 28 63 6f 6d 70 75 74 65 2d 6c 65 6e 67 74 68 (compute-length
6fb0: 20 28 63 64 72 20 76 65 63 74 6f 72 73 29 0a 20 (cdr vectors).
6fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fe0: 20 20 20 28 2b 20 28 76 65 63 74 6f 72 2d 6c 65 (+ (vector-le
6ff0: 6e 67 74 68 20 76 65 63 29 20 6c 65 6e 29 0a 20 ngth vec) len).
7000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7020: 20 20 20 63 61 6c 6c 65 65 29 29 29 29 29 0a 20 callee))))).
7030: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 61 (conca
7040: 74 65 6e 61 74 65 21 0a 20 20 20 20 20 20 20 20 tenate!.
7050: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 65 63 (lambda (vec
7060: 74 6f 72 73 20 74 61 72 67 65 74 20 74 6f 29 0a tors target to).
7070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
7080: 66 20 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 73 f (null? vectors
7090: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
70a0: 20 20 20 20 74 61 72 67 65 74 0a 20 20 20 20 20 target.
70b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
70c0: 74 2a 20 28 28 76 65 63 31 20 28 63 61 72 20 76 t* ((vec1 (car v
70d0: 65 63 74 6f 72 73 29 29 0a 20 20 20 20 20 20 20 ectors)).
70e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70f0: 20 20 28 6c 65 6e 20 28 76 65 63 74 6f 72 2d 6c (len (vector-l
7100: 65 6e 67 74 68 20 76 65 63 31 29 29 29 0a 20 20 ength vec1))).
7110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7120: 20 20 28 25 76 65 63 74 6f 72 2d 63 6f 70 79 21 (%vector-copy!
7130: 20 74 61 72 67 65 74 20 74 6f 20 76 65 63 31 20 target to vec1
7140: 30 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 0 len).
7150: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 (conc
7160: 61 74 65 6e 61 74 65 21 20 28 63 64 72 20 76 65 atenate! (cdr ve
7170: 63 74 6f 72 73 29 20 74 61 72 67 65 74 0a 20 20 ctors) target.
7180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71a0: 28 2b 20 74 6f 20 6c 65 6e 29 29 29 29 29 29 29 (+ to len)))))))
71b0: 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 65 . (lambda (ve
71c0: 63 74 6f 72 73 20 63 61 6c 6c 65 65 29 0a 20 20 ctors callee).
71d0: 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c (cond ((null
71e0: 3f 20 76 65 63 74 6f 72 73 29 20 20 20 20 20 20 ? vectors)
71f0: 20 20 20 20 20 20 3b 2b 2b 2b 0a 20 20 20 20 20 ;+++.
7200: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 76 65 (make-ve
7210: 63 74 6f 72 20 30 29 29 0a 20 20 20 20 20 20 20 ctor 0)).
7220: 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 ((null? (cd
7230: 72 20 76 65 63 74 6f 72 73 29 29 20 20 20 20 20 r vectors))
7240: 20 3b 2b 2b 2b 0a 20 20 20 20 20 20 20 20 20 20 ;+++.
7250: 20 20 20 3b 3b 20 42 6c 65 63 68 2c 20 77 65 20 ;; Blech, we
7260: 73 74 69 6c 6c 20 68 61 76 65 20 74 6f 20 61 6c still have to al
7270: 6c 6f 63 61 74 65 20 61 20 6e 65 77 20 6f 6e 65 locate a new one
7280: 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 .. (
7290: 6c 65 74 2a 20 28 28 76 65 63 20 28 63 68 65 63 let* ((vec (chec
72a0: 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 28 k-type vector? (
72b0: 63 61 72 20 76 65 63 74 6f 72 73 29 20 63 61 6c car vectors) cal
72c0: 6c 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 lee)).
72d0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 6e 20 28 (len (
72e0: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 vector-length ve
72f0: 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 c)).
7300: 20 20 20 20 20 20 20 20 28 6e 65 77 20 28 6d 61 (new (ma
7310: 6b 65 2d 76 65 63 74 6f 72 20 6c 65 6e 29 29 29 ke-vector len)))
7320: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7330: 28 25 76 65 63 74 6f 72 2d 63 6f 70 79 21 20 6e (%vector-copy! n
7340: 65 77 20 30 20 76 65 63 20 30 20 6c 65 6e 29 0a ew 0 vec 0 len).
7350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
7360: 65 77 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ew)).
7370: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 (else.
7380: 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 2d 76 (let ((new-v
7390: 65 63 74 6f 72 0a 20 20 20 20 20 20 20 20 20 20 ector.
73a0: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
73b0: 76 65 63 74 6f 72 20 28 63 6f 6d 70 75 74 65 2d vector (compute-
73c0: 6c 65 6e 67 74 68 20 76 65 63 74 6f 72 73 20 30 length vectors 0
73d0: 20 63 61 6c 6c 65 65 29 29 29 29 0a 20 20 20 20 callee)))).
73e0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 (conc
73f0: 61 74 65 6e 61 74 65 21 20 76 65 63 74 6f 72 73 atenate! vectors
7400: 20 6e 65 77 2d 76 65 63 74 6f 72 20 30 29 0a 20 new-vector 0).
7410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 ne
7420: 77 2d 76 65 63 74 6f 72 29 29 29 29 29 29 0a 0a w-vector))))))..
7430: 0c 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d ...;;; ---------
7440: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 -----------.;;;
7450: 50 72 65 64 69 63 61 74 65 73 0a 0a 3b 3b 3b 20 Predicates..;;;
7460: 28 56 45 43 54 4f 52 3f 20 3c 76 61 6c 75 65 3e (VECTOR? <value>
7470: 29 20 2d 3e 20 62 6f 6f 6c 65 61 6e 0a 3b 3b 3b ) -> boolean.;;;
7480: 20 20 20 5b 52 35 52 53 5d 20 52 65 74 75 72 6e [R5RS] Return
7490: 20 23 54 20 69 66 20 56 41 4c 55 45 20 69 73 20 #T if VALUE is
74a0: 61 20 76 65 63 74 6f 72 20 61 6e 64 20 23 46 20 a vector and #F
74b0: 69 66 20 6e 6f 74 2e 0a 3b 3b 20 28 64 65 66 69 if not..;; (defi
74c0: 6e 65 20 76 65 63 74 6f 72 3f 20 76 65 63 74 6f ne vector? vecto
74d0: 72 3f 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 r?)..;;; (VECTOR
74e0: 2d 45 4d 50 54 59 3f 20 3c 76 65 63 74 6f 72 3e -EMPTY? <vector>
74f0: 29 20 2d 3e 20 62 6f 6f 6c 65 61 6e 0a 3b 3b 3b ) -> boolean.;;;
7500: 20 20 20 52 65 74 75 72 6e 20 23 54 20 69 66 20 Return #T if
7510: 56 45 43 54 4f 52 20 68 61 73 20 7a 65 72 6f 20 VECTOR has zero
7520: 65 6c 65 6d 65 6e 74 73 20 69 6e 20 69 74 2c 20 elements in it,
7530: 69 2e 65 2e 20 56 45 43 54 4f 52 27 73 20 6c 65 i.e. VECTOR's le
7540: 6e 67 74 68 0a 3b 3b 3b 20 20 20 69 73 20 30 2c ngth.;;; is 0,
7550: 20 61 6e 64 20 23 46 20 69 66 20 6e 6f 74 2e 0a and #F if not..
7560: 28 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 2d (define (vector-
7570: 65 6d 70 74 79 3f 20 76 65 63 29 0a 20 20 28 6c empty? vec). (l
7580: 65 74 20 28 28 76 65 63 20 28 63 68 65 63 6b 2d et ((vec (check-
7590: 74 79 70 65 20 76 65 63 74 6f 72 3f 20 76 65 63 type vector? vec
75a0: 20 76 65 63 74 6f 72 2d 65 6d 70 74 79 3f 29 29 vector-empty?))
75b0: 29 0a 20 20 20 20 28 7a 65 72 6f 3f 20 28 76 65 ). (zero? (ve
75c0: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 ctor-length vec)
75d0: 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 )))..;;; (VECTOR
75e0: 3d 20 3c 65 6c 74 3d 3f 3e 20 3c 76 65 63 74 6f = <elt=?> <vecto
75f0: 72 3e 20 2e 2e 2e 29 20 2d 3e 20 62 6f 6f 6c 65 r> ...) -> boole
7600: 61 6e 0a 3b 3b 3b 20 20 20 20 20 28 45 4c 54 3d an.;;; (ELT=
7610: 3f 20 3c 76 61 6c 75 65 3e 20 3c 76 61 6c 75 65 ? <value> <value
7620: 3e 29 20 2d 3e 20 62 6f 6f 6c 65 61 6e 0a 3b 3b >) -> boolean.;;
7630: 3b 20 20 20 44 65 74 65 72 6d 69 6e 65 20 76 65 ; Determine ve
7640: 63 74 6f 72 20 65 71 75 61 6c 69 74 79 20 67 65 ctor equality ge
7650: 6e 65 72 61 6c 69 7a 65 64 20 61 63 72 6f 73 73 neralized across
7660: 20 65 6c 65 6d 65 6e 74 20 63 6f 6d 70 61 72 61 element compara
7670: 74 6f 72 73 2e 0a 3b 3b 3b 20 20 20 56 65 63 74 tors..;;; Vect
7680: 6f 72 73 20 41 20 61 6e 64 20 42 20 61 72 65 20 ors A and B are
7690: 65 71 75 61 6c 20 69 66 66 20 74 68 65 69 72 20 equal iff their
76a0: 6c 65 6e 67 74 68 73 20 61 72 65 20 74 68 65 20 lengths are the
76b0: 73 61 6d 65 20 61 6e 64 20 66 6f 72 0a 3b 3b 3b same and for.;;;
76c0: 20 20 20 65 61 63 68 20 72 65 73 70 65 63 74 69 each respecti
76d0: 76 65 20 65 6c 65 6d 65 6e 74 73 20 45 5f 61 20 ve elements E_a
76e0: 61 6e 64 20 45 5f 62 20 28 65 6c 65 6d 65 6e 74 and E_b (element
76f0: 3d 3f 20 45 5f 61 20 45 5f 62 29 20 72 65 74 75 =? E_a E_b) retu
7700: 72 6e 73 0a 3b 3b 3b 20 20 20 61 20 74 72 75 65 rns.;;; a true
7710: 20 76 61 6c 75 65 2e 20 20 45 4c 54 3d 3f 20 69 value. ELT=? i
7720: 73 20 61 6c 77 61 79 73 20 61 70 70 6c 69 65 64 s always applied
7730: 20 74 6f 20 74 77 6f 20 61 72 67 75 6d 65 6e 74 to two argument
7740: 73 2e 20 20 45 6c 65 6d 65 6e 74 0a 3b 3b 3b 20 s. Element.;;;
7750: 20 20 63 6f 6d 70 61 72 69 73 6f 6e 20 6d 75 73 comparison mus
7760: 74 20 62 65 20 63 6f 6e 73 69 73 74 65 6e 74 20 t be consistent
7770: 77 74 69 68 20 45 51 3f 3b 20 74 68 61 74 20 69 wtih EQ?; that i
7780: 73 2c 20 69 66 20 28 65 71 3f 20 45 5f 61 20 45 s, if (eq? E_a E
7790: 5f 62 29 0a 3b 3b 3b 20 20 20 72 65 73 75 6c 74 _b).;;; result
77a0: 73 20 69 6e 20 61 20 74 72 75 65 20 76 61 6c 75 s in a true valu
77b0: 65 2c 20 74 68 65 6e 20 28 45 4c 45 4d 45 4e 54 e, then (ELEMENT
77c0: 3d 3f 20 45 5f 61 20 45 5f 62 29 20 6d 75 73 74 =? E_a E_b) must
77d0: 20 72 65 73 75 6c 74 20 69 6e 20 61 0a 3b 3b 3b result in a.;;;
77e0: 20 20 20 74 72 75 65 20 76 61 6c 75 65 2e 20 20 true value.
77f0: 54 68 69 73 20 6d 61 79 20 62 65 20 65 78 70 6c This may be expl
7800: 6f 69 74 65 64 20 74 6f 20 61 76 6f 69 64 20 6d oited to avoid m
7810: 75 6c 74 69 70 6c 65 20 75 6e 6e 65 63 65 73 73 ultiple unnecess
7820: 61 72 79 0a 3b 3b 3b 20 20 20 65 6c 65 6d 65 6e ary.;;; elemen
7830: 74 20 63 6f 6d 70 61 72 69 73 6f 6e 73 2e 20 20 t comparisons.
7840: 28 54 68 69 73 20 69 6d 70 6c 65 6d 65 6e 74 61 (This implementa
7850: 74 69 6f 6e 20 64 6f 65 73 2c 20 62 75 74 20 64 tion does, but d
7860: 6f 65 73 20 6e 6f 74 20 64 65 61 6c 0a 3b 3b 3b oes not deal.;;;
7870: 20 20 20 77 69 74 68 20 74 68 65 20 73 69 74 75 with the situ
7880: 61 74 69 6f 6e 20 74 68 61 74 20 45 4c 45 4d 45 ation that ELEME
7890: 4e 54 3d 3f 20 69 73 20 45 51 3f 20 74 6f 20 61 NT=? is EQ? to a
78a0: 76 6f 69 64 20 6d 6f 72 65 20 75 6e 6e 65 63 65 void more unnece
78b0: 73 73 61 72 79 0a 3b 3b 3b 20 20 20 63 6f 6d 70 ssary.;;; comp
78c0: 61 72 69 73 6f 6e 73 2c 20 62 75 74 20 49 20 62 arisons, but I b
78d0: 65 6c 69 65 76 65 20 74 68 69 73 20 6f 70 74 69 elieve this opti
78e0: 6d 69 7a 61 74 69 6f 6e 20 69 73 20 70 72 6f 62 mization is prob
78f0: 61 62 6c 79 20 66 61 69 72 6c 79 0a 3b 3b 3b 20 ably fairly.;;;
7900: 20 20 69 6e 73 69 67 6e 69 66 69 63 61 6e 74 2e insignificant.
7910: 29 0a 3b 3b 3b 20 20 20 0a 3b 3b 3b 20 20 20 49 ).;;; .;;; I
7920: 66 20 74 68 65 20 6e 75 6d 62 65 72 20 6f 66 20 f the number of
7930: 76 65 63 74 6f 72 20 61 72 67 75 6d 65 6e 74 73 vector arguments
7940: 20 69 73 20 7a 65 72 6f 20 6f 72 20 6f 6e 65 2c is zero or one,
7950: 20 74 68 65 6e 20 23 54 20 69 73 0a 3b 3b 3b 20 then #T is.;;;
7960: 20 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 automatically
7970: 72 65 74 75 72 6e 65 64 2e 20 20 49 66 20 74 68 returned. If th
7980: 65 72 65 20 61 72 65 20 4e 20 76 65 63 74 6f 72 ere are N vector
7990: 20 61 72 67 75 6d 65 6e 74 73 2c 0a 3b 3b 3b 20 arguments,.;;;
79a0: 20 20 56 45 43 54 4f 52 5f 31 20 56 45 43 54 4f VECTOR_1 VECTO
79b0: 52 5f 32 20 2e 2e 2e 20 56 45 43 54 4f 52 5f 4e R_2 ... VECTOR_N
79c0: 2c 20 74 68 65 6e 20 56 45 43 54 4f 52 5f 31 20 , then VECTOR_1
79d0: 26 20 56 45 43 54 4f 52 5f 32 20 61 72 65 0a 3b & VECTOR_2 are.;
79e0: 3b 3b 20 20 20 63 6f 6d 70 61 72 65 64 3b 20 69 ;; compared; i
79f0: 66 20 74 68 65 79 20 61 72 65 20 65 71 75 61 6c f they are equal
7a00: 2c 20 74 68 65 20 76 65 63 74 6f 72 73 20 56 45 , the vectors VE
7a10: 43 54 4f 52 5f 32 20 2e 2e 2e 20 56 45 43 54 4f CTOR_2 ... VECTO
7a20: 52 5f 4e 0a 3b 3b 3b 20 20 20 61 72 65 20 63 6f R_N.;;; are co
7a30: 6d 70 61 72 65 64 2e 20 20 54 68 65 20 70 72 65 mpared. The pre
7a40: 63 69 73 65 20 6f 72 64 65 72 20 69 6e 20 77 68 cise order in wh
7a50: 69 63 68 20 45 4c 54 3d 3f 20 69 73 20 61 70 70 ich ELT=? is app
7a60: 6c 69 65 64 20 69 73 20 6e 6f 74 0a 3b 3b 3b 20 lied is not.;;;
7a70: 20 20 73 70 65 63 69 66 69 65 64 2e 0a 28 64 65 specified..(de
7a80: 66 69 6e 65 20 28 76 65 63 74 6f 72 3d 20 65 6c fine (vector= el
7a90: 74 3d 3f 20 2e 20 76 65 63 74 6f 72 73 29 0a 20 t=? . vectors).
7aa0: 20 28 6c 65 74 20 28 28 65 6c 74 3d 3f 20 28 63 (let ((elt=? (c
7ab0: 68 65 63 6b 2d 74 79 70 65 20 70 72 6f 63 65 64 heck-type proced
7ac0: 75 72 65 3f 20 65 6c 74 3d 3f 20 76 65 63 74 6f ure? elt=? vecto
7ad0: 72 3d 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 20 r=))). (cond
7ae0: 28 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 ((null? vectors)
7af0: 0a 20 20 20 20 20 20 20 20 20 20 20 23 74 29 0a . #t).
7b00: 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c ((null
7b10: 3f 20 28 63 64 72 20 76 65 63 74 6f 72 73 29 29 ? (cdr vectors))
7b20: 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 68 65 . (che
7b30: 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 ck-type vector?
7b40: 28 63 61 72 20 76 65 63 74 6f 72 73 29 20 76 65 (car vectors) ve
7b50: 63 74 6f 72 3d 29 0a 20 20 20 20 20 20 20 20 20 ctor=).
7b60: 20 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 #t).
7b70: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
7b80: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 76 65 63 (let loop ((vec
7b90: 73 20 76 65 63 74 6f 72 73 29 29 0a 20 20 20 20 s vectors)).
7ba0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
7bb0: 76 65 63 31 20 28 63 68 65 63 6b 2d 74 79 70 65 vec1 (check-type
7bc0: 20 76 65 63 74 6f 72 3f 20 28 63 61 72 20 76 65 vector? (car ve
7bd0: 63 73 29 20 76 65 63 74 6f 72 3d 29 29 0a 20 20 cs) vector=)).
7be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7bf0: 20 28 76 65 63 32 2b 20 28 63 64 72 20 76 65 63 (vec2+ (cdr vec
7c00: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
7c10: 20 20 20 20 28 6f 72 20 28 6e 75 6c 6c 3f 20 76 (or (null? v
7c20: 65 63 32 2b 29 0a 20 20 20 20 20 20 20 20 20 20 ec2+).
7c30: 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 62 (and (b
7c40: 69 6e 61 72 79 2d 76 65 63 74 6f 72 3d 20 65 6c inary-vector= el
7c50: 74 3d 3f 20 76 65 63 31 20 28 63 61 72 20 76 65 t=? vec1 (car ve
7c60: 63 32 2b 29 29 0a 20 20 20 20 20 20 20 20 20 20 c2+)).
7c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
7c80: 6f 6f 70 20 76 65 63 32 2b 29 29 29 29 29 29 29 oop vec2+)))))))
7c90: 29 29 0a 28 64 65 66 69 6e 65 20 28 62 69 6e 61 )).(define (bina
7ca0: 72 79 2d 76 65 63 74 6f 72 3d 20 65 6c 74 3d 3f ry-vector= elt=?
7cb0: 20 76 65 63 74 6f 72 2d 61 20 76 65 63 74 6f 72 vector-a vector
7cc0: 2d 62 29 0a 20 20 28 6f 72 20 28 65 71 3f 20 76 -b). (or (eq? v
7cd0: 65 63 74 6f 72 2d 61 20 76 65 63 74 6f 72 2d 62 ector-a vector-b
7ce0: 29 20 20 20 20 20 20 20 20 20 20 20 3b 2b 2b 2b ) ;+++
7cf0: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 . (let ((le
7d00: 6e 67 74 68 2d 61 20 28 76 65 63 74 6f 72 2d 6c ngth-a (vector-l
7d10: 65 6e 67 74 68 20 76 65 63 74 6f 72 2d 61 29 29 ength vector-a))
7d20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 . (le
7d30: 6e 67 74 68 2d 62 20 28 76 65 63 74 6f 72 2d 6c ngth-b (vector-l
7d40: 65 6e 67 74 68 20 76 65 63 74 6f 72 2d 62 29 29 ength vector-b))
7d50: 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 72 65 ). (letre
7d60: 63 20 28 28 6c 6f 6f 70 20 28 6c 61 6d 62 64 61 c ((loop (lambda
7d70: 20 28 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 (i).
7d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o
7d90: 72 20 28 3d 20 69 20 6c 65 6e 67 74 68 2d 61 29 r (= i length-a)
7da0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
7dc0: 6e 64 20 28 3c 20 69 20 6c 65 6e 67 74 68 2d 62 nd (< i length-b
7dd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7df0: 20 20 20 20 28 74 65 73 74 20 28 76 65 63 74 6f (test (vecto
7e00: 72 2d 72 65 66 20 76 65 63 74 6f 72 2d 61 20 69 r-ref vector-a i
7e10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e30: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
7e40: 72 2d 72 65 66 20 76 65 63 74 6f 72 2d 62 20 69 r-ref vector-b i
7e50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e70: 20 20 20 20 20 20 20 20 20 20 69 29 29 29 29 29 i)))))
7e80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7e90: 20 20 28 74 65 73 74 20 28 6c 61 6d 62 64 61 20 (test (lambda
7ea0: 28 65 6c 74 2d 61 20 65 6c 74 2d 62 20 69 29 0a (elt-a elt-b i).
7eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ec0: 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 6f (and (o
7ed0: 72 20 28 65 71 3f 20 65 6c 74 2d 61 20 65 6c 74 r (eq? elt-a elt
7ee0: 2d 62 29 20 3b 2b 2b 2b 0a 20 20 20 20 20 20 20 -b) ;+++.
7ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f00: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 74 3d (elt=
7f10: 3f 20 65 6c 74 2d 61 20 65 6c 74 2d 62 29 29 0a ? elt-a elt-b)).
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 20 20 20 20 20 28 6c (l
7f40: 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29 29 oop (+ i 1))))))
7f50: 0a 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 . (and
7f60: 28 3d 20 6c 65 6e 67 74 68 2d 61 20 6c 65 6e 67 (= length-a leng
7f70: 74 68 2d 62 29 0a 20 20 20 20 20 20 20 20 20 20 th-b).
7f80: 20 20 20 20 20 28 6c 6f 6f 70 20 30 29 29 29 29 (loop 0))))
7f90: 29 29 0a 0a 0c 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d )).....;;; -----
7fa0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a ---------------.
7fb0: 3b 3b 3b 20 53 65 6c 65 63 74 6f 72 73 0a 0a 3b ;;; Selectors..;
7fc0: 3b 3b 20 28 56 45 43 54 4f 52 2d 52 45 46 20 3c ;; (VECTOR-REF <
7fd0: 76 65 63 74 6f 72 3e 20 3c 69 6e 64 65 78 3e 29 vector> <index>)
7fe0: 20 2d 3e 20 76 61 6c 75 65 0a 3b 3b 3b 20 20 20 -> value.;;;
7ff0: 5b 52 35 52 53 5d 20 52 65 74 75 72 6e 20 74 68 [R5RS] Return th
8000: 65 20 76 61 6c 75 65 20 74 68 61 74 20 74 68 65 e value that the
8010: 20 6c 6f 63 61 74 69 6f 6e 20 69 6e 20 56 45 43 location in VEC
8020: 54 4f 52 20 61 74 20 49 4e 44 45 58 20 69 73 0a TOR at INDEX is.
8030: 3b 3b 3b 20 20 20 6d 61 70 70 65 64 20 74 6f 20 ;;; mapped to
8040: 69 6e 20 74 68 65 20 73 74 6f 72 65 2e 0a 3b 3b in the store..;;
8050: 20 28 64 65 66 69 6e 65 20 76 65 63 74 6f 72 2d (define vector-
8060: 72 65 66 20 76 65 63 74 6f 72 2d 72 65 66 29 0a ref vector-ref).
8070: 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 4c 45 4e .;;; (VECTOR-LEN
8080: 47 54 48 20 3c 76 65 63 74 6f 72 3e 29 20 2d 3e GTH <vector>) ->
8090: 20 65 78 61 63 74 2c 20 6e 6f 6e 6e 65 67 61 74 exact, nonnegat
80a0: 69 76 65 20 69 6e 74 65 67 65 72 0a 3b 3b 3b 20 ive integer.;;;
80b0: 20 20 5b 52 35 52 53 5d 20 52 65 74 75 72 6e 20 [R5RS] Return
80c0: 74 68 65 20 6c 65 6e 67 74 68 20 6f 66 20 56 45 the length of VE
80d0: 43 54 4f 52 2e 0a 3b 3b 20 28 64 65 66 69 6e 65 CTOR..;; (define
80e0: 20 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 vector-length v
80f0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 29 0a 0a 0c ector-length)...
8100: 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ..;;; ----------
8110: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 49 ----------.;;; I
8120: 74 65 72 61 74 69 6f 6e 0a 0a 3b 3b 3b 20 28 56 teration..;;; (V
8130: 45 43 54 4f 52 2d 46 4f 4c 44 20 3c 6b 6f 6e 73 ECTOR-FOLD <kons
8140: 3e 20 3c 69 6e 69 74 69 61 6c 2d 6b 6e 69 6c 3e > <initial-knil>
8150: 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d <vector> ...) -
8160: 3e 20 6b 6e 69 6c 0a 3b 3b 3b 20 20 20 20 20 28 > knil.;;; (
8170: 4b 4f 4e 53 20 3c 6b 6e 69 6c 3e 20 3c 65 6c 74 KONS <knil> <elt
8180: 3e 20 2e 2e 2e 29 20 2d 3e 20 6b 6e 69 6c 27 20 > ...) -> knil'
8190: 3b 20 4e 20 76 65 63 74 6f 72 73 20 2d 3e 20 4e ; N vectors -> N
81a0: 2b 31 20 61 72 67 73 0a 3b 3b 3b 20 20 20 54 68 +1 args.;;; Th
81b0: 65 20 66 75 6e 64 61 6d 65 6e 74 61 6c 20 76 65 e fundamental ve
81c0: 63 74 6f 72 20 69 74 65 72 61 74 6f 72 2e 20 20 ctor iterator.
81d0: 4b 4f 4e 53 20 69 73 20 69 74 65 72 61 74 65 64 KONS is iterated
81e0: 20 6f 76 65 72 20 65 61 63 68 0a 3b 3b 3b 20 20 over each.;;;
81f0: 20 69 6e 64 65 78 20 69 6e 20 61 6c 6c 20 6f 66 index in all of
8200: 20 74 68 65 20 76 65 63 74 6f 72 73 20 69 6e 20 the vectors in
8210: 70 61 72 61 6c 6c 65 6c 2c 20 73 74 6f 70 70 69 parallel, stoppi
8220: 6e 67 20 61 74 20 74 68 65 20 65 6e 64 20 6f 66 ng at the end of
8230: 0a 3b 3b 3b 20 20 20 74 68 65 20 73 68 6f 72 74 .;;; the short
8240: 65 73 74 3b 20 4b 4f 4e 53 20 69 73 20 61 70 70 est; KONS is app
8250: 6c 69 65 64 20 74 6f 20 61 6e 20 61 72 67 75 6d lied to an argum
8260: 65 6e 74 20 6c 69 73 74 20 6f 66 20 28 6c 69 73 ent list of (lis
8270: 74 20 49 0a 3b 3b 3b 20 20 20 53 54 41 54 45 20 t I.;;; STATE
8280: 28 76 65 63 74 6f 72 2d 72 65 66 20 56 45 43 20 (vector-ref VEC
8290: 49 29 20 2e 2e 2e 29 2c 20 77 68 65 72 65 20 53 I) ...), where S
82a0: 54 41 54 45 20 69 73 20 74 68 65 20 63 75 72 72 TATE is the curr
82b0: 65 6e 74 20 73 74 61 74 65 0a 3b 3b 3b 20 20 20 ent state.;;;
82c0: 76 61 6c 75 65 20 2d 2d 20 74 68 65 20 73 74 61 value -- the sta
82d0: 74 65 20 76 61 6c 75 65 20 62 65 67 69 6e 73 20 te value begins
82e0: 77 69 74 68 20 4b 4e 49 4c 20 61 6e 64 20 62 65 with KNIL and be
82f0: 63 6f 6d 65 73 20 77 68 61 74 65 76 65 72 0a 3b comes whatever.;
8300: 3b 3b 20 20 20 4b 4f 4e 53 20 72 65 74 75 72 6e ;; KONS return
8310: 65 64 20 61 74 20 74 68 65 20 72 65 73 70 65 63 ed at the respec
8320: 74 69 76 65 20 69 74 65 72 61 74 69 6f 6e 20 2d tive iteration -
8330: 2d 2c 20 61 6e 64 20 49 20 69 73 20 74 68 65 0a -, and I is the.
8340: 3b 3b 3b 20 20 20 63 75 72 72 65 6e 74 20 69 6e ;;; current in
8350: 64 65 78 20 69 6e 20 74 68 65 20 69 74 65 72 61 dex in the itera
8360: 74 69 6f 6e 2e 20 20 54 68 65 20 69 74 65 72 61 tion. The itera
8370: 74 69 6f 6e 20 69 73 20 73 74 72 69 63 74 6c 79 tion is strictly
8380: 20 6c 65 66 74 2d 0a 3b 3b 3b 20 20 20 74 6f 2d left-.;;; to-
8390: 72 69 67 68 74 2e 0a 3b 3b 3b 20 20 20 20 20 28 right..;;; (
83a0: 76 65 63 74 6f 72 2d 66 6f 6c 64 20 4b 4f 4e 53 vector-fold KONS
83b0: 20 4b 4e 49 4c 20 28 76 65 63 74 6f 72 20 45 5f KNIL (vector E_
83c0: 31 20 45 5f 32 20 2e 2e 2e 20 45 5f 4e 29 29 0a 1 E_2 ... E_N)).
83d0: 3b 3b 3b 20 20 20 20 20 20 20 3c 3d 3e 0a 3b 3b ;;; <=>.;;
83e0: 3b 20 20 20 20 20 28 4b 4f 4e 53 20 28 2e 2e 2e ; (KONS (...
83f0: 20 28 4b 4f 4e 53 20 28 4b 4f 4e 53 20 4b 4e 49 (KONS (KONS KNI
8400: 4c 20 45 5f 31 29 20 45 5f 32 29 20 2e 2e 2e 20 L E_1) E_2) ...
8410: 45 5f 4e 2d 31 29 20 45 5f 4e 29 0a 28 64 65 66 E_N-1) E_N).(def
8420: 69 6e 65 20 28 76 65 63 74 6f 72 2d 66 6f 6c 64 ine (vector-fold
8430: 20 6b 6f 6e 73 20 6b 6e 69 6c 20 76 65 63 20 2e kons knil vec .
8440: 20 76 65 63 74 6f 72 73 29 0a 20 20 28 6c 65 74 vectors). (let
8450: 20 28 28 6b 6f 6e 73 20 28 63 68 65 63 6b 2d 74 ((kons (check-t
8460: 79 70 65 20 70 72 6f 63 65 64 75 72 65 3f 20 6b ype procedure? k
8470: 6f 6e 73 20 76 65 63 74 6f 72 2d 66 6f 6c 64 29 ons vector-fold)
8480: 29 0a 20 20 20 20 20 20 20 20 28 76 65 63 20 20 ). (vec
8490: 28 63 68 65 63 6b 2d 74 79 70 65 20 76 65 63 74 (check-type vect
84a0: 6f 72 3f 20 20 20 20 76 65 63 20 20 76 65 63 74 or? vec vect
84b0: 6f 72 2d 66 6f 6c 64 29 29 29 0a 20 20 20 20 28 or-fold))). (
84c0: 69 66 20 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 if (null? vector
84d0: 73 29 0a 20 20 20 20 20 20 20 20 28 25 76 65 63 s). (%vec
84e0: 74 6f 72 2d 66 6f 6c 64 31 20 6b 6f 6e 73 20 6b tor-fold1 kons k
84f0: 6e 69 6c 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 nil (vector-leng
8500: 74 68 20 76 65 63 29 20 76 65 63 29 0a 20 20 20 th vec) vec).
8510: 20 20 20 20 20 28 25 76 65 63 74 6f 72 2d 66 6f (%vector-fo
8520: 6c 64 32 2b 20 6b 6f 6e 73 20 6b 6e 69 6c 0a 20 ld2+ kons knil.
8530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8540: 20 20 20 20 20 20 20 28 25 73 6d 61 6c 6c 65 73 (%smalles
8550: 74 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f 72 73 t-length vectors
8560: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8580: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
8590: 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a 20 or-length vec).
85a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
85b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
85c0: 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d vector-
85d0: 66 6f 6c 64 29 0a 20 20 20 20 20 20 20 20 20 20 fold).
85e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
85f0: 6f 6e 73 20 76 65 63 20 76 65 63 74 6f 72 73 29 ons vec vectors)
8600: 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f ))))..;;; (VECTO
8610: 52 2d 46 4f 4c 44 2d 52 49 47 48 54 20 3c 6b 6f R-FOLD-RIGHT <ko
8620: 6e 73 3e 20 3c 69 6e 69 74 69 61 6c 2d 6b 6e 69 ns> <initial-kni
8630: 6c 3e 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 l> <vector> ...)
8640: 20 2d 3e 20 6b 6e 69 6c 0a 3b 3b 3b 20 20 20 20 -> knil.;;;
8650: 20 28 4b 4f 4e 53 20 3c 6b 6e 69 6c 3e 20 3c 65 (KONS <knil> <e
8660: 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 6b 6e 69 6c lt> ...) -> knil
8670: 27 20 3b 20 4e 20 76 65 63 74 6f 72 73 20 3d 3e ' ; N vectors =>
8680: 20 4e 2b 31 20 61 72 67 73 0a 3b 3b 3b 20 20 20 N+1 args.;;;
8690: 54 68 65 20 66 75 6e 64 61 6d 65 6e 74 61 6c 20 The fundamental
86a0: 76 65 63 74 6f 72 20 72 65 63 75 72 73 6f 72 2e vector recursor.
86b0: 20 20 49 74 65 72 61 74 65 73 20 69 6e 20 70 61 Iterates in pa
86c0: 72 61 6c 6c 65 6c 20 61 63 72 6f 73 73 0a 3b 3b rallel across.;;
86d0: 3b 20 20 20 56 45 43 54 4f 52 20 2e 2e 2e 20 72 ; VECTOR ... r
86e0: 69 67 68 74 20 74 6f 20 6c 65 66 74 2c 20 61 70 ight to left, ap
86f0: 70 6c 79 69 6e 67 20 4b 4f 4e 53 20 74 6f 20 74 plying KONS to t
8700: 68 65 20 65 6c 65 6d 65 6e 74 73 20 61 6e 64 20 he elements and
8710: 74 68 65 0a 3b 3b 3b 20 20 20 63 75 72 72 65 6e the.;;; curren
8720: 74 20 73 74 61 74 65 20 76 61 6c 75 65 3b 20 74 t state value; t
8730: 68 65 20 73 74 61 74 65 20 76 61 6c 75 65 20 62 he state value b
8740: 65 63 6f 6d 65 73 20 77 68 61 74 20 4b 4f 4e 53 ecomes what KONS
8750: 20 72 65 74 75 72 6e 73 0a 3b 3b 3b 20 20 20 61 returns.;;; a
8760: 74 20 65 61 63 68 20 6e 65 78 74 20 69 74 65 72 t each next iter
8770: 61 74 69 6f 6e 2e 20 20 4b 4e 49 4c 20 69 73 20 ation. KNIL is
8780: 74 68 65 20 69 6e 69 74 69 61 6c 20 73 74 61 74 the initial stat
8790: 65 20 76 61 6c 75 65 2e 0a 3b 3b 3b 20 20 20 20 e value..;;;
87a0: 20 28 76 65 63 74 6f 72 2d 66 6f 6c 64 2d 72 69 (vector-fold-ri
87b0: 67 68 74 20 4b 4f 4e 53 20 4b 4e 49 4c 20 28 76 ght KONS KNIL (v
87c0: 65 63 74 6f 72 20 45 5f 31 20 45 5f 32 20 2e 2e ector E_1 E_2 ..
87d0: 2e 20 45 5f 4e 29 29 0a 3b 3b 3b 20 20 20 20 20 . E_N)).;;;
87e0: 20 20 3c 3d 3e 0a 3b 3b 3b 20 20 20 20 20 28 4b <=>.;;; (K
87f0: 4f 4e 53 20 28 2e 2e 2e 20 28 4b 4f 4e 53 20 28 ONS (... (KONS (
8800: 4b 4f 4e 53 20 4b 4e 49 4c 20 45 5f 4e 29 20 45 KONS KNIL E_N) E
8810: 5f 4e 2d 31 29 20 2e 2e 2e 20 45 5f 32 29 20 45 _N-1) ... E_2) E
8820: 5f 31 29 0a 3b 3b 3b 0a 3b 3b 3b 20 4e 6f 74 20 _1).;;;.;;; Not
8830: 69 6d 70 6c 65 6d 65 6e 74 65 64 20 69 6e 20 74 implemented in t
8840: 65 72 6d 73 20 6f 66 20 61 20 6d 6f 72 65 20 70 erms of a more p
8850: 72 69 6d 69 74 69 76 65 20 6f 70 65 72 61 74 69 rimitive operati
8860: 6f 6e 73 20 74 68 61 74 20 6d 69 67 68 74 0a 3b ons that might.;
8870: 3b 3b 20 63 61 6c 6c 65 64 20 25 56 45 43 54 4f ;; called %VECTO
8880: 52 2d 46 4f 4c 44 2d 52 49 47 48 54 20 64 75 65 R-FOLD-RIGHT due
8890: 20 74 6f 20 74 68 65 20 66 61 63 74 20 74 68 61 to the fact tha
88a0: 74 20 69 74 20 77 6f 75 6c 64 6e 27 74 20 62 65 t it wouldn't be
88b0: 20 76 65 72 79 0a 3b 3b 3b 20 75 73 65 66 75 6c very.;;; useful
88c0: 20 65 6c 73 65 77 68 65 72 65 2e 0a 28 64 65 66 elsewhere..(def
88d0: 69 6e 65 20 76 65 63 74 6f 72 2d 66 6f 6c 64 2d ine vector-fold-
88e0: 72 69 67 68 74 0a 20 20 28 6c 65 74 72 65 63 20 right. (letrec
88f0: 28 28 6c 6f 6f 70 31 20 28 6c 61 6d 62 64 61 20 ((loop1 (lambda
8900: 28 6b 6f 6e 73 20 6b 6e 69 6c 20 76 65 63 20 69 (kons knil vec i
8910: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8920: 20 20 20 20 20 20 28 69 66 20 28 6e 65 67 61 74 (if (negat
8930: 69 76 65 3f 20 69 29 0a 20 20 20 20 20 20 20 20 ive? i).
8940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8950: 6b 6e 69 6c 0a 20 20 20 20 20 20 20 20 20 20 20 knil.
8960: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
8970: 6f 70 31 20 6b 6f 6e 73 20 28 6b 6f 6e 73 20 69 op1 kons (kons i
8980: 20 6b 6e 69 6c 20 28 76 65 63 74 6f 72 2d 72 65 knil (vector-re
8990: 66 20 76 65 63 20 69 29 29 0a 20 20 20 20 20 20 f vec i)).
89a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
89b0: 20 20 20 20 20 20 20 20 20 76 65 63 0a 20 20 20 vec.
89c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
89d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 69 (- i
89e0: 20 31 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 1))))).
89f0: 20 20 20 28 6c 6f 6f 70 32 2b 20 28 6c 61 6d 62 (loop2+ (lamb
8a00: 64 61 20 28 6b 6f 6e 73 20 6b 6e 69 6c 20 76 65 da (kons knil ve
8a10: 63 74 6f 72 73 20 69 29 0a 20 20 20 20 20 20 20 ctors i).
8a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
8a30: 66 20 28 6e 65 67 61 74 69 76 65 3f 20 69 29 0a f (negative? i).
8a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a50: 20 20 20 20 20 20 20 20 20 6b 6e 69 6c 0a 20 20 knil.
8a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a70: 20 20 20 20 20 20 20 28 6c 6f 6f 70 32 2b 20 6b (loop2+ k
8a80: 6f 6e 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ons.
8a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8aa0: 20 20 20 20 20 28 61 70 70 6c 79 20 6b 6f 6e 73 (apply kons
8ab0: 20 69 20 6b 6e 69 6c 0a 20 20 20 20 20 20 20 20 i knil.
8ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ae0: 28 76 65 63 74 6f 72 73 2d 72 65 66 20 76 65 63 (vectors-ref vec
8af0: 74 6f 72 73 20 69 29 29 0a 20 20 20 20 20 20 20 tors i)).
8b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b10: 20 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 vector
8b20: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
8b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b40: 20 20 20 28 2d 20 69 20 31 29 29 29 29 29 29 0a (- i 1)))))).
8b50: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 6f 6e (lambda (kon
8b60: 73 20 6b 6e 69 6c 20 76 65 63 20 2e 20 76 65 63 s knil vec . vec
8b70: 74 6f 72 73 29 0a 20 20 20 20 20 20 28 6c 65 74 tors). (let
8b80: 20 28 28 6b 6f 6e 73 20 28 63 68 65 63 6b 2d 74 ((kons (check-t
8b90: 79 70 65 20 70 72 6f 63 65 64 75 72 65 3f 20 6b ype procedure? k
8ba0: 6f 6e 73 20 76 65 63 74 6f 72 2d 66 6f 6c 64 2d ons vector-fold-
8bb0: 72 69 67 68 74 29 29 0a 20 20 20 20 20 20 20 20 right)).
8bc0: 20 20 20 20 28 76 65 63 20 20 28 63 68 65 63 6b (vec (check
8bd0: 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 20 20 -type vector?
8be0: 20 76 65 63 20 20 76 65 63 74 6f 72 2d 66 6f 6c vec vector-fol
8bf0: 64 2d 72 69 67 68 74 29 29 29 0a 20 20 20 20 20 d-right))).
8c00: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 76 65 (if (null? ve
8c10: 63 74 6f 72 73 29 0a 20 20 20 20 20 20 20 20 20 ctors).
8c20: 20 20 20 28 6c 6f 6f 70 31 20 20 6b 6f 6e 73 20 (loop1 kons
8c30: 6b 6e 69 6c 20 76 65 63 20 28 2d 20 28 76 65 63 knil vec (- (vec
8c40: 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 20 tor-length vec)
8c50: 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 1)).
8c60: 28 6c 6f 6f 70 32 2b 20 6b 6f 6e 73 20 6b 6e 69 (loop2+ kons kni
8c70: 6c 20 28 63 6f 6e 73 20 76 65 63 20 76 65 63 74 l (cons vec vect
8c80: 6f 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ors).
8c90: 20 20 20 20 20 20 20 20 20 28 2d 20 28 25 73 6d (- (%sm
8ca0: 61 6c 6c 65 73 74 2d 6c 65 6e 67 74 68 20 76 65 allest-length ve
8cb0: 63 74 6f 72 73 0a 20 20 20 20 20 20 20 20 20 20 ctors.
8cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8ce0: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 vector-length ve
8cf0: 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c).
8d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d10: 20 20 20 20 20 20 20 20 20 20 20 20 76 65 63 74 vect
8d20: 6f 72 2d 66 6f 6c 64 2d 72 69 67 68 74 29 0a 20 or-fold-right).
8d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d40: 20 20 20 20 20 20 31 29 29 29 29 29 29 29 0a 0a 1)))))))..
8d50: 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 4d 41 50 20 ;;; (VECTOR-MAP
8d60: 3c 66 3e 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e <f> <vector> ...
8d70: 29 20 2d 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 ) -> vector.;;;
8d80: 20 20 20 20 28 46 20 3c 65 6c 74 3e 20 2e 2e 2e (F <elt> ...
8d90: 29 20 2d 3e 20 76 61 6c 75 65 20 3b 20 4e 20 76 ) -> value ; N v
8da0: 65 63 74 6f 72 73 20 2d 3e 20 4e 20 61 72 67 73 ectors -> N args
8db0: 0a 3b 3b 3b 20 20 20 43 6f 6e 73 74 72 75 63 74 .;;; Construct
8dc0: 73 20 61 20 6e 65 77 20 76 65 63 74 6f 72 20 6f s a new vector o
8dd0: 66 20 74 68 65 20 73 68 6f 72 74 65 73 74 20 6c f the shortest l
8de0: 65 6e 67 74 68 20 6f 66 20 74 68 65 20 76 65 63 ength of the vec
8df0: 74 6f 72 0a 3b 3b 3b 20 20 20 61 72 67 75 6d 65 tor.;;; argume
8e00: 6e 74 73 2e 20 20 45 61 63 68 20 65 6c 65 6d 65 nts. Each eleme
8e10: 6e 74 20 61 74 20 69 6e 64 65 78 20 49 20 6f 66 nt at index I of
8e20: 20 74 68 65 20 6e 65 77 20 76 65 63 74 6f 72 20 the new vector
8e30: 69 73 20 6d 61 70 70 65 64 0a 3b 3b 3b 20 20 20 is mapped.;;;
8e40: 66 72 6f 6d 20 74 68 65 20 6f 6c 64 20 76 65 63 from the old vec
8e50: 74 6f 72 73 20 62 79 20 28 46 20 49 20 28 76 65 tors by (F I (ve
8e60: 63 74 6f 72 2d 72 65 66 20 56 45 43 54 4f 52 20 ctor-ref VECTOR
8e70: 49 29 20 2e 2e 2e 29 2e 20 20 54 68 65 0a 3b 3b I) ...). The.;;
8e80: 3b 20 20 20 64 79 6e 61 6d 69 63 20 6f 72 64 65 ; dynamic orde
8e90: 72 20 6f 66 20 61 70 70 6c 69 63 61 74 69 6f 6e r of application
8ea0: 20 6f 66 20 46 20 69 73 20 75 6e 73 70 65 63 69 of F is unspeci
8eb0: 66 69 65 64 2e 0a 28 64 65 66 69 6e 65 20 28 76 fied..(define (v
8ec0: 65 63 74 6f 72 2d 6d 61 70 20 66 20 76 65 63 20 ector-map f vec
8ed0: 2e 20 76 65 63 74 6f 72 73 29 0a 20 20 28 6c 65 . vectors). (le
8ee0: 74 20 28 28 66 20 20 20 28 63 68 65 63 6b 2d 74 t ((f (check-t
8ef0: 79 70 65 20 70 72 6f 63 65 64 75 72 65 3f 20 66 ype procedure? f
8f00: 20 20 20 76 65 63 74 6f 72 2d 6d 61 70 29 29 0a vector-map)).
8f10: 20 20 20 20 20 20 20 20 28 76 65 63 20 28 63 68 (vec (ch
8f20: 65 63 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f eck-type vector?
8f30: 20 20 20 20 76 65 63 20 76 65 63 74 6f 72 2d 6d vec vector-m
8f40: 61 70 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e ap))). (if (n
8f50: 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 ull? vectors).
8f60: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e (let ((len
8f70: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
8f80: 76 65 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 vec))).
8f90: 20 28 25 76 65 63 74 6f 72 2d 6d 61 70 31 21 20 (%vector-map1!
8fa0: 66 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6c f (make-vector l
8fb0: 65 6e 29 20 76 65 63 20 6c 65 6e 29 29 0a 20 20 en) vec len)).
8fc0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e (let ((len
8fd0: 20 28 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 6e 67 (%smallest-leng
8fe0: 74 68 20 76 65 63 74 6f 72 73 0a 20 20 20 20 20 th vectors.
8ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9010: 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 (vector-length v
9020: 65 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ec).
9030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9040: 20 20 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d vector-
9050: 6d 61 70 29 29 29 0a 20 20 20 20 20 20 20 20 20 map))).
9060: 20 28 25 76 65 63 74 6f 72 2d 6d 61 70 32 2b 21 (%vector-map2+!
9070: 20 66 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 f (make-vector
9080: 6c 65 6e 29 20 28 63 6f 6e 73 20 76 65 63 20 76 len) (cons vec v
9090: 65 63 74 6f 72 73 29 0a 20 20 20 20 20 20 20 20 ectors).
90a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90b0: 20 20 6c 65 6e 29 29 29 29 29 0a 0a 3b 3b 3b 20 len)))))..;;;
90c0: 28 56 45 43 54 4f 52 2d 4d 41 50 21 20 3c 66 3e (VECTOR-MAP! <f>
90d0: 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d <vector> ...) -
90e0: 3e 20 75 6e 73 70 65 63 69 66 69 65 64 0a 3b 3b > unspecified.;;
90f0: 3b 20 20 20 20 20 28 46 20 3c 65 6c 74 3e 20 2e ; (F <elt> .
9100: 2e 2e 29 20 2d 3e 20 65 6c 65 6d 65 6e 74 27 20 ..) -> element'
9110: 3b 20 4e 20 76 65 63 74 6f 72 73 20 2d 3e 20 4e ; N vectors -> N
9120: 20 61 72 67 73 0a 3b 3b 3b 20 20 20 53 69 6d 69 args.;;; Simi
9130: 6c 61 72 20 74 6f 20 56 45 43 54 4f 52 2d 4d 41 lar to VECTOR-MA
9140: 50 2c 20 62 75 74 20 72 61 74 68 65 72 20 74 68 P, but rather th
9150: 61 6e 20 6d 61 70 70 69 6e 67 20 74 68 65 20 6e an mapping the n
9160: 65 77 20 65 6c 65 6d 65 6e 74 73 0a 3b 3b 3b 20 ew elements.;;;
9170: 20 20 69 6e 74 6f 20 61 20 6e 65 77 20 76 65 63 into a new vec
9180: 74 6f 72 2c 20 74 68 65 20 6e 65 77 20 6d 61 70 tor, the new map
9190: 70 65 64 20 65 6c 65 6d 65 6e 74 73 20 61 72 65 ped elements are
91a0: 20 64 65 73 74 72 75 63 74 69 76 65 6c 79 0a 3b destructively.;
91b0: 3b 3b 20 20 20 69 6e 73 65 72 74 65 64 20 69 6e ;; inserted in
91c0: 74 6f 20 74 68 65 20 66 69 72 73 74 20 76 65 63 to the first vec
91d0: 74 6f 72 2e 20 20 41 67 61 69 6e 2c 20 74 68 65 tor. Again, the
91e0: 20 64 79 6e 61 6d 69 63 20 6f 72 64 65 72 20 6f dynamic order o
91f0: 66 0a 3b 3b 3b 20 20 20 61 70 70 6c 69 63 61 74 f.;;; applicat
9200: 69 6f 6e 20 6f 66 20 46 20 69 73 20 75 6e 73 70 ion of F is unsp
9210: 65 63 69 66 69 65 64 2c 20 73 6f 20 69 74 20 69 ecified, so it i
9220: 73 20 64 61 6e 67 65 72 6f 75 73 20 66 6f 72 20 s dangerous for
9230: 46 20 74 6f 0a 3b 3b 3b 20 20 20 6d 61 6e 69 70 F to.;;; manip
9240: 75 6c 61 74 65 20 74 68 65 20 66 69 72 73 74 20 ulate the first
9250: 56 45 43 54 4f 52 2e 0a 28 64 65 66 69 6e 65 20 VECTOR..(define
9260: 28 76 65 63 74 6f 72 2d 6d 61 70 21 20 66 20 76 (vector-map! f v
9270: 65 63 20 2e 20 76 65 63 74 6f 72 73 29 0a 20 20 ec . vectors).
9280: 28 6c 65 74 20 28 28 66 20 20 20 28 63 68 65 63 (let ((f (chec
9290: 6b 2d 74 79 70 65 20 70 72 6f 63 65 64 75 72 65 k-type procedure
92a0: 3f 20 66 20 20 20 76 65 63 74 6f 72 2d 6d 61 70 ? f vector-map
92b0: 21 29 29 0a 20 20 20 20 20 20 20 20 28 76 65 63 !)). (vec
92c0: 20 28 63 68 65 63 6b 2d 74 79 70 65 20 76 65 63 (check-type vec
92d0: 74 6f 72 3f 20 20 20 20 76 65 63 20 76 65 63 74 tor? vec vect
92e0: 6f 72 2d 6d 61 70 21 29 29 29 0a 20 20 20 20 28 or-map!))). (
92f0: 69 66 20 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 if (null? vector
9300: 73 29 0a 20 20 20 20 20 20 20 20 28 25 76 65 63 s). (%vec
9310: 74 6f 72 2d 6d 61 70 31 21 20 20 66 20 76 65 63 tor-map1! f vec
9320: 20 76 65 63 20 28 76 65 63 74 6f 72 2d 6c 65 6e vec (vector-len
9330: 67 74 68 20 76 65 63 29 29 0a 20 20 20 20 20 20 gth vec)).
9340: 20 20 28 25 76 65 63 74 6f 72 2d 6d 61 70 32 2b (%vector-map2+
9350: 21 20 66 20 76 65 63 20 28 63 6f 6e 73 20 76 65 ! f vec (cons ve
9360: 63 20 76 65 63 74 6f 72 73 29 0a 20 20 20 20 20 c vectors).
9370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9380: 20 20 20 28 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 (%smallest-le
9390: 6e 67 74 68 20 76 65 63 74 6f 72 73 0a 20 20 20 ngth vectors.
93a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93c0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 6c (vector-l
93d0: 65 6e 67 74 68 20 76 65 63 29 0a 20 20 20 20 20 ength vec).
93e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9400: 20 20 20 20 20 76 65 63 74 6f 72 2d 6d 61 70 21 vector-map!
9410: 29 29 29 0a 20 20 20 20 28 75 6e 73 70 65 63 69 ))). (unspeci
9420: 66 69 65 64 2d 76 61 6c 75 65 29 29 29 0a 0a 3b fied-value)))..;
9430: 3b 3b 20 28 56 45 43 54 4f 52 2d 46 4f 52 2d 45 ;; (VECTOR-FOR-E
9440: 41 43 48 20 3c 66 3e 20 3c 76 65 63 74 6f 72 3e ACH <f> <vector>
9450: 20 2e 2e 2e 29 20 2d 3e 20 75 6e 73 70 65 63 69 ...) -> unspeci
9460: 66 69 65 64 0a 3b 3b 3b 20 20 20 20 20 28 46 20 fied.;;; (F
9470: 3c 65 6c 74 3e 20 2e 2e 2e 29 20 3b 20 4e 20 76 <elt> ...) ; N v
9480: 65 63 74 6f 72 73 20 2d 3e 20 4e 20 61 72 67 73 ectors -> N args
9490: 0a 3b 3b 3b 20 20 20 53 69 6d 70 6c 65 20 76 65 .;;; Simple ve
94a0: 63 74 6f 72 20 69 74 65 72 61 74 6f 72 3a 20 61 ctor iterator: a
94b0: 70 70 6c 69 65 73 20 46 20 74 6f 20 65 61 63 68 pplies F to each
94c0: 20 69 6e 64 65 78 20 69 6e 20 74 68 65 20 72 61 index in the ra
94d0: 6e 67 65 20 5b 30 2c 0a 3b 3b 3b 20 20 20 4c 45 nge [0,.;;; LE
94e0: 4e 47 54 48 29 2c 20 77 68 65 72 65 20 4c 45 4e NGTH), where LEN
94f0: 47 54 48 20 69 73 20 74 68 65 20 6c 65 6e 67 74 GTH is the lengt
9500: 68 20 6f 66 20 74 68 65 20 73 6d 61 6c 6c 65 73 h of the smalles
9510: 74 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 20 61 t vector.;;; a
9520: 72 67 75 6d 65 6e 74 20 70 61 73 73 65 64 2c 20 rgument passed,
9530: 61 6e 64 20 74 68 65 20 72 65 73 70 65 63 74 69 and the respecti
9540: 76 65 20 65 6c 65 6d 65 6e 74 20 61 74 20 74 68 ve element at th
9550: 61 74 20 69 6e 64 65 78 2e 20 20 49 6e 0a 3b 3b at index. In.;;
9560: 3b 20 20 20 63 6f 6e 74 72 61 73 74 20 77 69 74 ; contrast wit
9570: 68 20 56 45 43 54 4f 52 2d 4d 41 50 2c 20 46 20 h VECTOR-MAP, F
9580: 69 73 20 72 65 6c 69 61 62 6c 79 20 61 70 70 6c is reliably appl
9590: 69 65 64 20 74 6f 20 65 61 63 68 0a 3b 3b 3b 20 ied to each.;;;
95a0: 20 20 73 75 62 73 65 71 75 65 6e 74 20 65 6c 65 subsequent ele
95b0: 6d 65 6e 74 73 2c 20 73 74 61 72 74 69 6e 67 20 ments, starting
95c0: 61 74 20 69 6e 64 65 78 20 30 20 66 72 6f 6d 20 at index 0 from
95d0: 6c 65 66 74 20 74 6f 20 72 69 67 68 74 2c 20 69 left to right, i
95e0: 6e 0a 3b 3b 3b 20 20 20 74 68 65 20 76 65 63 74 n.;;; the vect
95f0: 6f 72 73 2e 0a 28 64 65 66 69 6e 65 20 76 65 63 ors..(define vec
9600: 74 6f 72 2d 66 6f 72 2d 65 61 63 68 0a 20 20 28 tor-for-each. (
9610: 6c 65 74 72 65 63 20 28 28 66 6f 72 2d 65 61 63 letrec ((for-eac
9620: 68 31 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 h1. (
9630: 6c 61 6d 62 64 61 20 28 66 20 76 65 63 20 69 20 lambda (f vec i
9640: 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 len).
9650: 20 20 20 28 63 6f 6e 64 20 28 28 3c 20 69 20 6c (cond ((< i l
9660: 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 en).
9670: 20 20 20 20 20 20 20 20 20 28 66 20 69 20 28 76 (f i (v
9680: 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 69 29 ector-ref vec i)
9690: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
96a0: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
96b0: 31 20 66 20 76 65 63 20 28 2b 20 69 20 31 29 20 1 f vec (+ i 1)
96c0: 6c 65 6e 29 29 29 29 29 0a 20 20 20 20 20 20 20 len))))).
96d0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 32 2b 0a (for-each2+.
96e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
96f0: 62 64 61 20 28 66 20 76 65 63 73 20 69 20 6c 65 bda (f vecs i le
9700: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
9710: 20 28 63 6f 6e 64 20 28 28 3c 20 69 20 6c 65 6e (cond ((< i len
9720: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9730: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 66 20 (apply f
9740: 69 20 28 76 65 63 74 6f 72 73 2d 72 65 66 20 76 i (vectors-ref v
9750: 65 63 73 20 69 29 29 0a 20 20 20 20 20 20 20 20 ecs i)).
9760: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6f (fo
9770: 72 2d 65 61 63 68 32 2b 20 66 20 76 65 63 73 20 r-each2+ f vecs
9780: 28 2b 20 69 20 31 29 20 6c 65 6e 29 29 29 29 29 (+ i 1) len)))))
9790: 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 ). (lambda (f
97a0: 20 76 65 63 20 2e 20 76 65 63 74 6f 72 73 29 0a vec . vectors).
97b0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 20 20 (let ((f
97c0: 20 28 63 68 65 63 6b 2d 74 79 70 65 20 70 72 6f (check-type pro
97d0: 63 65 64 75 72 65 3f 20 66 20 20 20 76 65 63 74 cedure? f vect
97e0: 6f 72 2d 66 6f 72 2d 65 61 63 68 29 29 0a 20 20 or-for-each)).
97f0: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 20 28 (vec (
9800: 63 68 65 63 6b 2d 74 79 70 65 20 76 65 63 74 6f check-type vecto
9810: 72 3f 20 20 20 20 76 65 63 20 76 65 63 74 6f 72 r? vec vector
9820: 2d 66 6f 72 2d 65 61 63 68 29 29 29 0a 20 20 20 -for-each))).
9830: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
9840: 76 65 63 74 6f 72 73 29 0a 20 20 20 20 20 20 20 vectors).
9850: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 31 20 (for-each1
9860: 66 20 76 65 63 20 30 20 28 76 65 63 74 6f 72 2d f vec 0 (vector-
9870: 6c 65 6e 67 74 68 20 76 65 63 29 29 0a 20 20 20 length vec)).
9880: 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 (for-ea
9890: 63 68 32 2b 20 66 20 28 63 6f 6e 73 20 76 65 63 ch2+ f (cons vec
98a0: 20 76 65 63 74 6f 72 73 29 20 30 0a 20 20 20 20 vectors) 0.
98b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
98c0: 20 20 20 20 28 25 73 6d 61 6c 6c 65 73 74 2d 6c (%smallest-l
98d0: 65 6e 67 74 68 20 76 65 63 74 6f 72 73 0a 20 20 ength vectors.
98e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
98f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9900: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
9910: 6c 65 6e 67 74 68 20 76 65 63 29 0a 20 20 20 20 length vec).
9920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9940: 20 20 20 20 20 20 76 65 63 74 6f 72 2d 66 6f 72 vector-for
9950: 2d 65 61 63 68 29 29 29 29 29 29 29 0a 0a 3b 3b -each)))))))..;;
9960: 3b 20 28 56 45 43 54 4f 52 2d 43 4f 55 4e 54 20 ; (VECTOR-COUNT
9970: 3c 70 72 65 64 69 63 61 74 65 3f 3e 20 3c 76 65 <predicate?> <ve
9980: 63 74 6f 72 3e 20 2e 2e 2e 29 0a 3b 3b 3b 20 20 ctor> ...).;;;
9990: 20 20 20 20 20 2d 3e 20 65 78 61 63 74 2c 20 6e -> exact, n
99a0: 6f 6e 6e 65 67 61 74 69 76 65 20 69 6e 74 65 67 onnegative integ
99b0: 65 72 0a 3b 3b 3b 20 20 20 20 20 28 50 52 45 44 er.;;; (PRED
99c0: 49 43 41 54 45 3f 20 3c 69 6e 64 65 78 3e 20 3c ICATE? <index> <
99d0: 76 61 6c 75 65 3e 20 2e 2e 2e 29 20 3b 20 4e 20 value> ...) ; N
99e0: 76 65 63 74 6f 72 73 20 2d 3e 20 4e 2b 31 20 61 vectors -> N+1 a
99f0: 72 67 73 0a 3b 3b 3b 20 20 20 50 52 45 44 49 43 rgs.;;; PREDIC
9a00: 41 54 45 3f 20 69 73 20 61 70 70 6c 69 65 64 20 ATE? is applied
9a10: 65 6c 65 6d 65 6e 74 2d 77 69 73 65 20 74 6f 20 element-wise to
9a20: 74 68 65 20 65 6c 65 6d 65 6e 74 73 20 6f 66 20 the elements of
9a30: 56 45 43 54 4f 52 20 2e 2e 2e 2c 0a 3b 3b 3b 20 VECTOR ...,.;;;
9a40: 20 20 61 6e 64 20 61 20 63 6f 75 6e 74 20 69 73 and a count is
9a50: 20 74 61 6c 6c 69 65 64 20 6f 66 20 74 68 65 20 tallied of the
9a60: 6e 75 6d 62 65 72 20 6f 66 20 65 6c 65 6d 65 6e number of elemen
9a70: 74 73 20 66 6f 72 20 77 68 69 63 68 20 61 0a 3b ts for which a.;
9a80: 3b 3b 20 20 20 74 72 75 65 20 76 61 6c 75 65 20 ;; true value
9a90: 69 73 20 70 72 6f 64 75 63 65 64 20 62 79 20 50 is produced by P
9aa0: 52 45 44 49 43 41 54 45 3f 2e 20 20 54 68 69 73 REDICATE?. This
9ab0: 20 63 6f 75 6e 74 20 69 73 20 72 65 74 75 72 6e count is return
9ac0: 65 64 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 63 ed..(define (vec
9ad0: 74 6f 72 2d 63 6f 75 6e 74 20 70 72 65 64 3f 20 tor-count pred?
9ae0: 76 65 63 20 2e 20 76 65 63 74 6f 72 73 29 0a 20 vec . vectors).
9af0: 20 28 6c 65 74 20 28 28 70 72 65 64 3f 20 28 63 (let ((pred? (c
9b00: 68 65 63 6b 2d 74 79 70 65 20 70 72 6f 63 65 64 heck-type proced
9b10: 75 72 65 3f 20 70 72 65 64 3f 20 76 65 63 74 6f ure? pred? vecto
9b20: 72 2d 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 20 r-count)).
9b30: 20 20 28 76 65 63 20 20 20 28 63 68 65 63 6b 2d (vec (check-
9b40: 74 79 70 65 20 76 65 63 74 6f 72 3f 20 20 20 20 type vector?
9b50: 76 65 63 20 20 20 76 65 63 74 6f 72 2d 63 6f 75 vec vector-cou
9b60: 6e 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e nt))). (if (n
9b70: 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 ull? vectors).
9b80: 20 20 20 20 20 20 28 25 76 65 63 74 6f 72 2d 66 (%vector-f
9b90: 6f 6c 64 31 20 28 6c 61 6d 62 64 61 20 28 69 6e old1 (lambda (in
9ba0: 64 65 78 20 63 6f 75 6e 74 20 65 6c 74 29 0a 20 dex count elt).
9bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9bc0: 20 20 20 20 20 20 20 20 28 69 66 20 28 70 72 65 (if (pre
9bd0: 64 3f 20 69 6e 64 65 78 20 65 6c 74 29 0a 20 20 d? index elt).
9be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9bf0: 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 63 6f (+ co
9c00: 75 6e 74 20 31 29 0a 20 20 20 20 20 20 20 20 20 unt 1).
9c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9c20: 20 20 20 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 count)).
9c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9c40: 20 20 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 0.
9c50: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec
9c60: 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a tor-length vec).
9c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9c80: 20 20 20 20 20 20 20 76 65 63 29 0a 20 20 20 20 vec).
9c90: 20 20 20 20 28 25 76 65 63 74 6f 72 2d 66 6f 6c (%vector-fol
9ca0: 64 32 2b 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 d2+ (lambda (ind
9cb0: 65 78 20 63 6f 75 6e 74 20 2e 20 65 6c 74 73 29 ex count . elts)
9cc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9cd0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
9ce0: 61 70 70 6c 79 20 70 72 65 64 3f 20 69 6e 64 65 apply pred? inde
9cf0: 78 20 65 6c 74 73 29 0a 20 20 20 20 20 20 20 20 x elts).
9d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9d10: 20 20 20 20 20 20 28 2b 20 63 6f 75 6e 74 20 31 (+ count 1
9d20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9d40: 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 20 20 20 count)).
9d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9d60: 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
9d70: 20 20 20 20 20 20 20 20 20 20 28 25 73 6d 61 6c (%smal
9d80: 6c 65 73 74 2d 6c 65 6e 67 74 68 20 76 65 63 74 lest-length vect
9d90: 6f 72 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ors.
9da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
9dc0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 ector-length vec
9dd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9df0: 20 20 20 20 20 20 20 20 20 20 20 20 76 65 63 74 vect
9e00: 6f 72 2d 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 or-count).
9e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9e20: 20 20 28 63 6f 6e 73 20 76 65 63 20 76 65 63 74 (cons vec vect
9e30: 6f 72 73 29 29 29 29 29 0a 0a 0c 0a 0a 3b 3b 3b ors))))).....;;;
9e40: 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ---------------
9e50: 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 53 65 61 72 63 68 -----.;;; Search
9e60: 69 6e 67 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 ing..;;; (VECTOR
9e70: 2d 49 4e 44 45 58 20 3c 70 72 65 64 69 63 61 74 -INDEX <predicat
9e80: 65 3f 3e 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e e?> <vector> ...
9e90: 29 0a 3b 3b 3b 20 20 20 20 20 20 20 2d 3e 20 65 ).;;; -> e
9ea0: 78 61 63 74 2c 20 6e 6f 6e 6e 65 67 61 74 69 76 xact, nonnegativ
9eb0: 65 20 69 6e 74 65 67 65 72 20 6f 72 20 23 46 0a e integer or #F.
9ec0: 3b 3b 3b 20 20 20 20 20 28 50 52 45 44 49 43 41 ;;; (PREDICA
9ed0: 54 45 3f 20 3c 65 6c 74 3e 20 2e 2e 2e 29 20 2d TE? <elt> ...) -
9ee0: 3e 20 62 6f 6f 6c 65 61 6e 20 3b 20 4e 20 76 65 > boolean ; N ve
9ef0: 63 74 6f 72 73 20 2d 3e 20 4e 20 61 72 67 73 0a ctors -> N args.
9f00: 3b 3b 3b 20 20 20 53 65 61 72 63 68 20 6c 65 66 ;;; Search lef
9f10: 74 2d 74 6f 2d 72 69 67 68 74 20 61 63 72 6f 73 t-to-right acros
9f20: 73 20 56 45 43 54 4f 52 20 2e 2e 2e 20 69 6e 20 s VECTOR ... in
9f30: 70 61 72 61 6c 6c 65 6c 2c 20 72 65 74 75 72 6e parallel, return
9f40: 69 6e 67 20 74 68 65 0a 3b 3b 3b 20 20 20 69 6e ing the.;;; in
9f50: 64 65 78 20 6f 66 20 74 68 65 20 66 69 72 73 74 dex of the first
9f60: 20 73 65 74 20 6f 66 20 76 61 6c 75 65 73 20 56 set of values V
9f70: 41 4c 55 45 20 2e 2e 2e 20 73 75 63 68 20 74 68 ALUE ... such th
9f80: 61 74 20 28 50 52 45 44 49 43 41 54 45 3f 0a 3b at (PREDICATE?.;
9f90: 3b 3b 20 20 20 56 41 4c 55 45 20 2e 2e 2e 29 20 ;; VALUE ...)
9fa0: 72 65 74 75 72 6e 73 20 61 20 74 72 75 65 20 76 returns a true v
9fb0: 61 6c 75 65 3b 20 69 66 20 6e 6f 20 73 75 63 68 alue; if no such
9fc0: 20 73 65 74 20 6f 66 20 65 6c 65 6d 65 6e 74 73 set of elements
9fd0: 20 69 73 0a 3b 3b 3b 20 20 20 72 65 61 63 68 65 is.;;; reache
9fe0: 64 2c 20 72 65 74 75 72 6e 20 23 46 2e 0a 28 64 d, return #F..(d
9ff0: 65 66 69 6e 65 20 28 76 65 63 74 6f 72 2d 69 6e efine (vector-in
a000: 64 65 78 20 70 72 65 64 3f 20 76 65 63 20 2e 20 dex pred? vec .
a010: 76 65 63 74 6f 72 73 29 0a 20 20 28 76 65 63 74 vectors). (vect
a020: 6f 72 2d 69 6e 64 65 78 2f 73 6b 69 70 20 70 72 or-index/skip pr
a030: 65 64 3f 20 76 65 63 20 76 65 63 74 6f 72 73 20 ed? vec vectors
a040: 76 65 63 74 6f 72 2d 69 6e 64 65 78 29 29 0a 0a vector-index))..
a050: 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 53 4b 49 50 ;;; (VECTOR-SKIP
a060: 20 3c 70 72 65 64 69 63 61 74 65 3f 3e 20 3c 76 <predicate?> <v
a070: 65 63 74 6f 72 3e 20 2e 2e 2e 29 0a 3b 3b 3b 20 ector> ...).;;;
a080: 20 20 20 20 20 20 2d 3e 20 65 78 61 63 74 2c 20 -> exact,
a090: 6e 6f 6e 6e 65 67 61 74 69 76 65 20 69 6e 74 65 nonnegative inte
a0a0: 67 65 72 20 6f 72 20 23 46 0a 3b 3b 3b 20 20 20 ger or #F.;;;
a0b0: 20 20 28 50 52 45 44 49 43 41 54 45 3f 20 3c 65 (PREDICATE? <e
a0c0: 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 62 6f 6f 6c lt> ...) -> bool
a0d0: 65 61 6e 20 3b 20 4e 20 76 65 63 74 6f 72 73 20 ean ; N vectors
a0e0: 2d 3e 20 4e 20 61 72 67 73 0a 3b 3b 3b 20 20 20 -> N args.;;;
a0f0: 28 76 65 63 74 6f 72 2d 69 6e 64 65 78 20 28 6c (vector-index (l
a100: 61 6d 62 64 61 20 65 6c 74 73 20 28 6e 6f 74 20 ambda elts (not
a110: 28 61 70 70 6c 79 20 50 52 45 44 49 43 41 54 45 (apply PREDICATE
a120: 3f 20 65 6c 74 73 29 29 29 0a 3b 3b 3b 20 20 20 ? elts))).;;;
a130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 56 45 VE
a140: 43 54 4f 52 20 2e 2e 2e 29 0a 3b 3b 3b 20 20 20 CTOR ...).;;;
a150: 4c 69 6b 65 20 56 45 43 54 4f 52 2d 49 4e 44 45 Like VECTOR-INDE
a160: 58 2c 20 62 75 74 20 66 69 6e 64 20 74 68 65 20 X, but find the
a170: 69 6e 64 65 78 20 6f 66 20 74 68 65 20 66 69 72 index of the fir
a180: 73 74 20 73 65 74 20 6f 66 20 76 61 6c 75 65 73 st set of values
a190: 0a 3b 3b 3b 20 20 20 74 68 61 74 20 64 6f 20 5f .;;; that do _
a1a0: 6e 6f 74 5f 20 73 61 74 69 73 66 79 20 50 52 45 not_ satisfy PRE
a1b0: 44 49 43 41 54 45 3f 2e 0a 28 64 65 66 69 6e 65 DICATE?..(define
a1c0: 20 28 76 65 63 74 6f 72 2d 73 6b 69 70 20 70 72 (vector-skip pr
a1d0: 65 64 3f 20 76 65 63 20 2e 20 76 65 63 74 6f 72 ed? vec . vector
a1e0: 73 29 0a 20 20 28 76 65 63 74 6f 72 2d 69 6e 64 s). (vector-ind
a1f0: 65 78 2f 73 6b 69 70 20 28 6c 61 6d 62 64 61 20 ex/skip (lambda
a200: 65 6c 74 73 20 28 6e 6f 74 20 28 61 70 70 6c 79 elts (not (apply
a210: 20 70 72 65 64 3f 20 65 6c 74 73 29 29 29 0a 20 pred? elts))).
a220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a230: 20 20 20 20 76 65 63 20 76 65 63 74 6f 72 73 0a vec vectors.
a240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a250: 20 20 20 20 20 76 65 63 74 6f 72 2d 73 6b 69 70 vector-skip
a260: 29 29 0a 0a 3b 3b 3b 20 41 75 78 69 6c 69 61 72 ))..;;; Auxiliar
a270: 79 20 66 6f 72 20 56 45 43 54 4f 52 2d 49 4e 44 y for VECTOR-IND
a280: 45 58 20 26 20 56 45 43 54 4f 52 2d 53 4b 49 50 EX & VECTOR-SKIP
a290: 0a 28 64 65 66 69 6e 65 20 76 65 63 74 6f 72 2d .(define vector-
a2a0: 69 6e 64 65 78 2f 73 6b 69 70 0a 20 20 28 6c 65 index/skip. (le
a2b0: 74 72 65 63 20 28 28 6c 6f 6f 70 31 20 20 28 6c trec ((loop1 (l
a2c0: 61 6d 62 64 61 20 28 70 72 65 64 3f 20 76 65 63 ambda (pred? vec
a2d0: 20 6c 65 6e 20 69 29 0a 20 20 20 20 20 20 20 20 len i).
a2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
a2f0: 6e 64 20 28 28 3d 20 69 20 6c 65 6e 29 20 23 66 nd ((= i len) #f
a300: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a310: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 ((p
a320: 72 65 64 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 red? (vector-ref
a330: 20 76 65 63 20 69 29 29 20 69 29 0a 20 20 20 20 vec i)) i).
a340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a350: 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 6c 6f (else (lo
a360: 6f 70 31 20 70 72 65 64 3f 20 76 65 63 20 6c 65 op1 pred? vec le
a370: 6e 20 28 2b 20 69 20 31 29 29 29 29 29 29 0a 20 n (+ i 1)))))).
a380: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 32 (loop2
a390: 2b 20 28 6c 61 6d 62 64 61 20 28 70 72 65 64 3f + (lambda (pred?
a3a0: 20 76 65 63 74 6f 72 73 20 6c 65 6e 20 69 29 0a vectors len i).
a3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a3c0: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 3d 20 69 (cond ((= i
a3d0: 20 6c 65 6e 29 20 23 66 29 0a 20 20 20 20 20 20 len) #f).
a3e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a3f0: 20 20 20 20 20 28 28 61 70 70 6c 79 20 70 72 65 ((apply pre
a400: 64 3f 20 28 76 65 63 74 6f 72 73 2d 72 65 66 20 d? (vectors-ref
a410: 76 65 63 74 6f 72 73 20 69 29 29 20 69 29 0a 20 vectors i)) i).
a420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a430: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
a440: 28 6c 6f 6f 70 32 2b 20 70 72 65 64 3f 20 76 65 (loop2+ pred? ve
a450: 63 74 6f 72 73 20 6c 65 6e 0a 20 20 20 20 20 20 ctors len.
a460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a480: 20 20 20 28 2b 20 69 20 31 29 29 29 29 29 29 29 (+ i 1)))))))
a490: 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 72 . (lambda (pr
a4a0: 65 64 3f 20 76 65 63 20 76 65 63 74 6f 72 73 20 ed? vec vectors
a4b0: 63 61 6c 6c 65 65 29 0a 20 20 20 20 20 20 28 6c callee). (l
a4c0: 65 74 20 28 28 70 72 65 64 3f 20 28 63 68 65 63 et ((pred? (chec
a4d0: 6b 2d 74 79 70 65 20 70 72 6f 63 65 64 75 72 65 k-type procedure
a4e0: 3f 20 70 72 65 64 3f 20 63 61 6c 6c 65 65 29 29 ? pred? callee))
a4f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 . (ve
a500: 63 20 20 20 28 63 68 65 63 6b 2d 74 79 70 65 20 c (check-type
a510: 76 65 63 74 6f 72 3f 20 20 20 20 76 65 63 20 20 vector? vec
a520: 20 63 61 6c 6c 65 65 29 29 29 0a 20 20 20 20 20 callee))).
a530: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 76 65 (if (null? ve
a540: 63 74 6f 72 73 29 0a 20 20 20 20 20 20 20 20 20 ctors).
a550: 20 20 20 28 6c 6f 6f 70 31 20 70 72 65 64 3f 20 (loop1 pred?
a560: 76 65 63 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 vec (vector-leng
a570: 74 68 20 76 65 63 29 20 30 29 0a 20 20 20 20 20 th vec) 0).
a580: 20 20 20 20 20 20 20 28 6c 6f 6f 70 32 2b 20 70 (loop2+ p
a590: 72 65 64 3f 20 28 63 6f 6e 73 20 76 65 63 20 76 red? (cons vec v
a5a0: 65 63 74 6f 72 73 29 0a 20 20 20 20 20 20 20 20 ectors).
a5b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 25 73 6d (%sm
a5c0: 61 6c 6c 65 73 74 2d 6c 65 6e 67 74 68 20 76 65 allest-length ve
a5d0: 63 74 6f 72 73 0a 20 20 20 20 20 20 20 20 20 20 ctors.
a5e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec
a600: 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a tor-length vec).
a610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a630: 20 20 20 20 20 20 63 61 6c 6c 65 65 29 0a 20 20 callee).
a640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a650: 20 20 30 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 0))))))..;;; (
a660: 56 45 43 54 4f 52 2d 49 4e 44 45 58 2d 52 49 47 VECTOR-INDEX-RIG
a670: 48 54 20 3c 70 72 65 64 69 63 61 74 65 3f 3e 20 HT <predicate?>
a680: 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 0a 3b 3b <vector> ...).;;
a690: 3b 20 20 20 20 20 20 20 2d 3e 20 65 78 61 63 74 ; -> exact
a6a0: 2c 20 6e 6f 6e 6e 65 67 61 74 69 76 65 20 69 6e , nonnegative in
a6b0: 74 65 67 65 72 20 6f 72 20 23 46 0a 3b 3b 3b 20 teger or #F.;;;
a6c0: 20 20 20 20 28 50 52 45 44 49 43 41 54 45 3f 20 (PREDICATE?
a6d0: 3c 65 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 62 6f <elt> ...) -> bo
a6e0: 6f 6c 65 61 6e 20 3b 20 4e 20 76 65 63 74 6f 72 olean ; N vector
a6f0: 73 20 2d 3e 20 4e 20 61 72 67 73 0a 3b 3b 3b 20 s -> N args.;;;
a700: 20 20 52 69 67 68 74 2d 74 6f 2d 6c 65 66 74 20 Right-to-left
a710: 76 61 72 69 61 6e 74 20 6f 66 20 56 45 43 54 4f variant of VECTO
a720: 52 2d 49 4e 44 45 58 2e 0a 28 64 65 66 69 6e 65 R-INDEX..(define
a730: 20 28 76 65 63 74 6f 72 2d 69 6e 64 65 78 2d 72 (vector-index-r
a740: 69 67 68 74 20 70 72 65 64 3f 20 76 65 63 20 2e ight pred? vec .
a750: 20 76 65 63 74 6f 72 73 29 0a 20 20 28 76 65 63 vectors). (vec
a760: 74 6f 72 2d 69 6e 64 65 78 2f 73 6b 69 70 2d 72 tor-index/skip-r
a770: 69 67 68 74 20 70 72 65 64 3f 20 76 65 63 20 76 ight pred? vec v
a780: 65 63 74 6f 72 73 20 76 65 63 74 6f 72 2d 69 6e ectors vector-in
a790: 64 65 78 2d 72 69 67 68 74 29 29 0a 0a 3b 3b 3b dex-right))..;;;
a7a0: 20 28 56 45 43 54 4f 52 2d 53 4b 49 50 2d 52 49 (VECTOR-SKIP-RI
a7b0: 47 48 54 20 3c 70 72 65 64 69 63 61 74 65 3f 3e GHT <predicate?>
a7c0: 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 0a 3b <vector> ...).;
a7d0: 3b 3b 20 20 20 20 20 20 20 2d 3e 20 65 78 61 63 ;; -> exac
a7e0: 74 2c 20 6e 6f 6e 6e 65 67 61 74 69 76 65 20 69 t, nonnegative i
a7f0: 6e 74 65 67 65 72 20 6f 72 20 23 46 0a 3b 3b 3b nteger or #F.;;;
a800: 20 20 20 20 20 28 50 52 45 44 49 43 41 54 45 3f (PREDICATE?
a810: 20 3c 65 6c 74 3e 20 2e 2e 2e 29 20 2d 3e 20 62 <elt> ...) -> b
a820: 6f 6f 6c 65 61 6e 20 3b 20 4e 20 76 65 63 74 6f oolean ; N vecto
a830: 72 73 20 2d 3e 20 4e 20 61 72 67 73 0a 3b 3b 3b rs -> N args.;;;
a840: 20 20 20 52 69 67 68 74 2d 74 6f 2d 6c 65 66 74 Right-to-left
a850: 20 76 61 72 69 61 6e 74 20 6f 66 20 56 45 43 54 variant of VECT
a860: 4f 52 2d 53 4b 49 50 2e 0a 28 64 65 66 69 6e 65 OR-SKIP..(define
a870: 20 28 76 65 63 74 6f 72 2d 73 6b 69 70 2d 72 69 (vector-skip-ri
a880: 67 68 74 20 70 72 65 64 3f 20 76 65 63 20 2e 20 ght pred? vec .
a890: 76 65 63 74 6f 72 73 29 0a 20 20 28 76 65 63 74 vectors). (vect
a8a0: 6f 72 2d 69 6e 64 65 78 2f 73 6b 69 70 2d 72 69 or-index/skip-ri
a8b0: 67 68 74 20 28 6c 61 6d 62 64 61 20 65 6c 74 73 ght (lambda elts
a8c0: 20 28 6e 6f 74 20 28 61 70 70 6c 79 20 70 72 65 (not (apply pre
a8d0: 64 3f 20 65 6c 74 73 29 29 29 0a 20 20 20 20 20 d? elts))).
a8e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a8f0: 20 20 20 20 20 20 76 65 63 20 76 65 63 74 6f 72 vec vector
a900: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
a910: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 65 63 vec
a920: 74 6f 72 2d 69 6e 64 65 78 2d 72 69 67 68 74 29 tor-index-right)
a930: 29 0a 0a 28 64 65 66 69 6e 65 20 76 65 63 74 6f )..(define vecto
a940: 72 2d 69 6e 64 65 78 2f 73 6b 69 70 2d 72 69 67 r-index/skip-rig
a950: 68 74 0a 20 20 28 6c 65 74 72 65 63 20 28 28 6c ht. (letrec ((l
a960: 6f 6f 70 31 20 20 28 6c 61 6d 62 64 61 20 28 70 oop1 (lambda (p
a970: 72 65 64 3f 20 76 65 63 20 69 29 0a 20 20 20 20 red? vec i).
a980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a990: 20 28 63 6f 6e 64 20 28 28 6e 65 67 61 74 69 76 (cond ((negativ
a9a0: 65 3f 20 69 29 20 23 66 29 0a 20 20 20 20 20 20 e? i) #f).
a9b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9c0: 20 20 20 20 20 28 28 70 72 65 64 3f 20 28 76 65 ((pred? (ve
a9d0: 63 74 6f 72 2d 72 65 66 20 76 65 63 20 69 29 29 ctor-ref vec i))
a9e0: 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i).
a9f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
aa00: 65 6c 73 65 20 28 6c 6f 6f 70 31 20 70 72 65 64 else (loop1 pred
aa10: 3f 20 76 65 63 20 28 2d 20 69 20 31 29 29 29 29 ? vec (- i 1))))
aa20: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c )). (l
aa30: 6f 6f 70 32 2b 20 28 6c 61 6d 62 64 61 20 28 70 oop2+ (lambda (p
aa40: 72 65 64 3f 20 76 65 63 74 6f 72 73 20 69 29 0a red? vectors i).
aa50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa60: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 65 67 (cond ((neg
aa70: 61 74 69 76 65 3f 20 69 29 20 23 66 29 0a 20 20 ative? i) #f).
aa80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa90: 20 20 20 20 20 20 20 20 20 28 28 61 70 70 6c 79 ((apply
aaa0: 20 70 72 65 64 3f 20 28 76 65 63 74 6f 72 73 2d pred? (vectors-
aab0: 72 65 66 20 76 65 63 74 6f 72 73 20 69 29 29 20 ref vectors i))
aac0: 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
aad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
aae0: 6c 73 65 20 28 6c 6f 6f 70 32 2b 20 70 72 65 64 lse (loop2+ pred
aaf0: 3f 20 76 65 63 74 6f 72 73 20 28 2d 20 69 20 31 ? vectors (- i 1
ab00: 29 29 29 29 29 29 29 0a 20 20 20 20 28 6c 61 6d ))))))). (lam
ab10: 62 64 61 20 28 70 72 65 64 3f 20 76 65 63 20 76 bda (pred? vec v
ab20: 65 63 74 6f 72 73 20 63 61 6c 6c 65 65 29 0a 20 ectors callee).
ab30: 20 20 20 20 20 28 6c 65 74 20 28 28 70 72 65 64 (let ((pred
ab40: 3f 20 28 63 68 65 63 6b 2d 74 79 70 65 20 70 72 ? (check-type pr
ab50: 6f 63 65 64 75 72 65 3f 20 70 72 65 64 3f 20 63 ocedure? pred? c
ab60: 61 6c 6c 65 65 29 29 0a 20 20 20 20 20 20 20 20 allee)).
ab70: 20 20 20 20 28 76 65 63 20 20 20 28 63 68 65 63 (vec (chec
ab80: 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 20 k-type vector?
ab90: 20 20 76 65 63 20 20 20 63 61 6c 6c 65 65 29 29 vec callee))
aba0: 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 6e ). (if (n
abb0: 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 ull? vectors).
abc0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 31 (loop1
abd0: 20 70 72 65 64 3f 20 76 65 63 20 28 2d 20 28 76 pred? vec (- (v
abe0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 ector-length vec
abf0: 29 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) 1)).
ac00: 20 20 28 6c 6f 6f 70 32 2b 20 70 72 65 64 3f 20 (loop2+ pred?
ac10: 28 63 6f 6e 73 20 76 65 63 20 76 65 63 74 6f 72 (cons vec vector
ac20: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
ac30: 20 20 20 20 20 20 20 28 2d 20 28 25 73 6d 61 6c (- (%smal
ac40: 6c 65 73 74 2d 6c 65 6e 67 74 68 20 76 65 63 74 lest-length vect
ac50: 6f 72 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ors.
ac60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ac70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
ac80: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 ctor-length vec)
ac90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
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 63 61 6c 6c 65 65 callee
acc0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
acd0: 20 20 20 20 20 20 20 20 20 31 29 29 29 29 29 29 1))))))
ace0: 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 42 )..;;; (VECTOR-B
acf0: 49 4e 41 52 59 2d 53 45 41 52 43 48 20 3c 76 65 INARY-SEARCH <ve
ad00: 63 74 6f 72 3e 20 3c 76 61 6c 75 65 3e 20 3c 63 ctor> <value> <c
ad10: 6d 70 3e 20 5b 3c 73 74 61 72 74 3e 20 3c 65 6e mp> [<start> <en
ad20: 64 3e 5d 29 0a 3b 3b 3b 20 20 20 20 20 20 20 2d d>]).;;; -
ad30: 3e 20 65 78 61 63 74 2c 20 6e 6f 6e 6e 65 67 61 > exact, nonnega
ad40: 74 69 76 65 20 69 6e 74 65 67 65 72 20 6f 72 20 tive integer or
ad50: 23 46 0a 3b 3b 3b 20 20 20 20 20 28 43 4d 50 20 #F.;;; (CMP
ad60: 3c 76 61 6c 75 65 31 3e 20 3c 76 61 6c 75 65 32 <value1> <value2
ad70: 3e 29 20 2d 3e 20 69 6e 74 65 67 65 72 0a 3b 3b >) -> integer.;;
ad80: 3b 20 20 20 20 20 20 20 70 6f 73 69 74 69 76 65 ; positive
ad90: 20 2d 3e 20 56 41 4c 55 45 31 20 3e 20 56 41 4c -> VALUE1 > VAL
ada0: 55 45 32 0a 3b 3b 3b 20 20 20 20 20 20 20 7a 65 UE2.;;; ze
adb0: 72 6f 20 20 20 20 20 2d 3e 20 56 41 4c 55 45 31 ro -> VALUE1
adc0: 20 3d 20 56 41 4c 55 45 32 0a 3b 3b 3b 20 20 20 = VALUE2.;;;
add0: 20 20 20 20 6e 65 67 61 74 69 76 65 20 2d 3e 20 negative ->
ade0: 56 41 4c 55 45 31 20 3c 20 56 41 4c 55 45 32 0a VALUE1 < VALUE2.
adf0: 3b 3b 3b 20 20 20 50 65 72 66 6f 72 6d 20 61 20 ;;; Perform a
ae00: 62 69 6e 61 72 79 20 73 65 61 72 63 68 20 74 68 binary search th
ae10: 72 6f 75 67 68 20 56 45 43 54 4f 52 20 66 6f 72 rough VECTOR for
ae20: 20 56 41 4c 55 45 2c 20 63 6f 6d 70 61 72 69 6e VALUE, comparin
ae30: 67 20 65 61 63 68 0a 3b 3b 3b 20 20 20 65 6c 65 g each.;;; ele
ae40: 6d 65 6e 74 20 74 6f 20 56 41 4c 55 45 20 77 69 ment to VALUE wi
ae50: 74 68 20 43 4d 50 2e 0a 28 64 65 66 69 6e 65 20 th CMP..(define
ae60: 28 76 65 63 74 6f 72 2d 62 69 6e 61 72 79 2d 73 (vector-binary-s
ae70: 65 61 72 63 68 20 76 65 63 20 76 61 6c 75 65 20 earch vec value
ae80: 63 6d 70 20 2e 20 6d 61 79 62 65 2d 73 74 61 72 cmp . maybe-star
ae90: 74 2b 65 6e 64 29 0a 20 20 28 6c 65 74 20 28 28 t+end). (let ((
aea0: 63 6d 70 20 28 63 68 65 63 6b 2d 74 79 70 65 20 cmp (check-type
aeb0: 70 72 6f 63 65 64 75 72 65 3f 20 63 6d 70 20 76 procedure? cmp v
aec0: 65 63 74 6f 72 2d 62 69 6e 61 72 79 2d 73 65 61 ector-binary-sea
aed0: 72 63 68 29 29 29 0a 20 20 20 20 28 6c 65 74 2d rch))). (let-
aee0: 76 65 63 74 6f 72 2d 73 74 61 72 74 2b 65 6e 64 vector-start+end
aef0: 20 76 65 63 74 6f 72 2d 62 69 6e 61 72 79 2d 73 vector-binary-s
af00: 65 61 72 63 68 20 76 65 63 20 6d 61 79 62 65 2d earch vec maybe-
af10: 73 74 61 72 74 2b 65 6e 64 0a 20 20 20 20 20 20 start+end.
af20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af30: 20 20 20 20 28 73 74 61 72 74 20 65 6e 64 29 0a (start end).
af40: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
af50: 28 28 73 74 61 72 74 20 73 74 61 72 74 29 20 28 ((start start) (
af60: 65 6e 64 20 65 6e 64 29 20 28 6a 20 23 66 29 29 end end) (j #f))
af70: 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 . (let ((
af80: 69 20 28 71 75 6f 74 69 65 6e 74 20 28 2b 20 73 i (quotient (+ s
af90: 74 61 72 74 20 65 6e 64 29 20 32 29 29 29 0a 20 tart end) 2))).
afa0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6f 72 (if (or
afb0: 20 28 3d 20 73 74 61 72 74 20 65 6e 64 29 20 28 (= start end) (
afc0: 61 6e 64 20 6a 20 28 3d 20 69 20 6a 29 29 29 0a and j (= i j))).
afd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
afe0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
aff0: 6c 65 74 20 28 28 63 6f 6d 70 61 72 69 73 6f 6e let ((comparison
b000: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b010: 20 20 20 20 20 20 28 63 68 65 63 6b 2d 74 79 70 (check-typ
b020: 65 20 69 6e 74 65 67 65 72 3f 0a 20 20 20 20 20 e integer?.
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 20 20 20 20 20 28 63 6d 70 (cmp
b050: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 (vector-ref vec
b060: 20 69 29 20 76 61 6c 75 65 29 0a 20 20 20 20 20 i) value).
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 20 20 20 20 60 28 2c 63 `(,c
b090: 6d 70 20 66 6f 72 20 2c 76 65 63 74 6f 72 2d 62 mp for ,vector-b
b0a0: 69 6e 61 72 79 2d 73 65 61 72 63 68 29 29 29 29 inary-search))))
b0b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b0c0: 20 28 63 6f 6e 64 20 28 28 7a 65 72 6f 3f 20 20 (cond ((zero?
b0d0: 20 20 20 63 6f 6d 70 61 72 69 73 6f 6e 29 20 69 comparison) i
b0e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b0f0: 20 20 20 20 20 20 20 20 28 28 70 6f 73 69 74 69 ((positi
b100: 76 65 3f 20 63 6f 6d 70 61 72 69 73 6f 6e 29 20 ve? comparison)
b110: 28 6c 6f 6f 70 20 73 74 61 72 74 20 69 20 69 29 (loop start i i)
b120: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b130: 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 20 20 (else
b140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b150: 28 6c 6f 6f 70 20 69 20 65 6e 64 20 69 29 29 29 (loop i end i)))
b160: 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 )))))))..;;; (VE
b170: 43 54 4f 52 2d 41 4e 59 20 3c 70 72 65 64 3f 3e CTOR-ANY <pred?>
b180: 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 2d <vector> ...) -
b190: 3e 20 76 61 6c 75 65 0a 3b 3b 3b 20 20 20 41 70 > value.;;; Ap
b1a0: 70 6c 79 20 50 52 45 44 3f 20 74 6f 20 65 61 63 ply PRED? to eac
b1b0: 68 20 70 61 72 61 6c 6c 65 6c 20 65 6c 65 6d 65 h parallel eleme
b1c0: 6e 74 20 69 6e 20 65 61 63 68 20 56 45 43 54 4f nt in each VECTO
b1d0: 52 20 2e 2e 2e 3b 20 69 66 20 50 52 45 44 3f 0a R ...; if PRED?.
b1e0: 3b 3b 3b 20 20 20 73 68 6f 75 6c 64 20 65 76 65 ;;; should eve
b1f0: 72 20 72 65 74 75 72 6e 20 61 20 74 72 75 65 20 r return a true
b200: 76 61 6c 75 65 2c 20 69 6d 6d 65 64 69 61 74 65 value, immediate
b210: 6c 79 20 73 74 6f 70 20 61 6e 64 20 72 65 74 75 ly stop and retu
b220: 72 6e 20 74 68 61 74 0a 3b 3b 3b 20 20 20 76 61 rn that.;;; va
b230: 6c 75 65 3b 20 6f 74 68 65 72 77 69 73 65 2c 20 lue; otherwise,
b240: 77 68 65 6e 20 74 68 65 20 73 68 6f 72 74 65 73 when the shortes
b250: 74 20 76 65 63 74 6f 72 20 72 75 6e 73 20 6f 75 t vector runs ou
b260: 74 2c 20 72 65 74 75 72 6e 20 23 46 2e 0a 3b 3b t, return #F..;;
b270: 3b 20 20 20 54 68 65 20 69 74 65 72 61 74 69 6f ; The iteratio
b280: 6e 20 61 6e 64 20 6f 72 64 65 72 20 6f 66 20 61 n and order of a
b290: 70 70 6c 69 63 61 74 69 6f 6e 20 6f 66 20 50 52 pplication of PR
b2a0: 45 44 3f 20 61 63 72 6f 73 73 20 65 6c 65 6d 65 ED? across eleme
b2b0: 6e 74 73 0a 3b 3b 3b 20 20 20 69 73 20 6f 66 20 nts.;;; is of
b2c0: 74 68 65 20 76 65 63 74 6f 72 73 20 69 73 20 73 the vectors is s
b2d0: 74 72 69 63 74 6c 79 20 6c 65 66 74 2d 74 6f 2d trictly left-to-
b2e0: 72 69 67 68 74 2e 0a 28 64 65 66 69 6e 65 20 76 right..(define v
b2f0: 65 63 74 6f 72 2d 61 6e 79 0a 20 20 28 6c 65 74 ector-any. (let
b300: 72 65 63 20 28 28 6c 6f 6f 70 31 20 28 6c 61 6d rec ((loop1 (lam
b310: 62 64 61 20 28 70 72 65 64 3f 20 76 65 63 20 69 bda (pred? vec i
b320: 20 6c 65 6e 20 6c 65 6e 2d 31 29 0a 20 20 20 20 len len-1).
b330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b340: 28 61 6e 64 20 28 6e 6f 74 20 28 3d 20 69 20 6c (and (not (= i l
b350: 65 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 en)).
b360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
b370: 66 20 28 3d 20 69 20 6c 65 6e 2d 31 29 0a 20 20 f (= i len-1).
b380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b390: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 65 64 (pred
b3a0: 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 ? (vector-ref ve
b3b0: 63 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 c i)).
b3c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3d0: 20 20 20 28 6f 72 20 28 70 72 65 64 3f 20 28 76 (or (pred? (v
b3e0: 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 69 29 ector-ref vec i)
b3f0: 29 0a 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 28 6c 6f 6f 70 31 20 70 72 65 64 3f 20 (loop1 pred?
b420: 76 65 63 20 28 2b 20 69 20 31 29 0a 20 20 20 20 vec (+ i 1).
b430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b450: 20 20 20 20 6c 65 6e 20 6c 65 6e 2d 31 29 29 29 len len-1)))
b460: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
b470: 6c 6f 6f 70 32 2b 20 28 6c 61 6d 62 64 61 20 28 loop2+ (lambda (
b480: 70 72 65 64 3f 20 76 65 63 74 6f 72 73 20 69 20 pred? vectors i
b490: 6c 65 6e 20 6c 65 6e 2d 31 29 0a 20 20 20 20 20 len len-1).
b4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4b0: 28 61 6e 64 20 28 6e 6f 74 20 28 3d 20 69 20 6c (and (not (= i l
b4c0: 65 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 en)).
b4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
b4e0: 69 66 20 28 3d 20 69 20 6c 65 6e 2d 31 29 0a 20 if (= i len-1).
b4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b500: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
b510: 70 6c 79 20 70 72 65 64 3f 20 28 76 65 63 74 6f ply pred? (vecto
b520: 72 73 2d 72 65 66 20 76 65 63 74 6f 72 73 20 69 rs-ref vectors i
b530: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
b540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b550: 20 28 6f 72 20 28 61 70 70 6c 79 20 70 72 65 64 (or (apply pred
b560: 3f 20 28 76 65 63 74 6f 72 73 2d 72 65 66 20 76 ? (vectors-ref v
b570: 65 63 74 6f 72 73 20 69 29 29 0a 20 20 20 20 20 ectors i)).
b580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b590: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
b5a0: 6f 70 32 2b 20 70 72 65 64 3f 20 76 65 63 74 6f op2+ pred? vecto
b5b0: 72 73 20 28 2b 20 69 20 31 29 0a 20 20 20 20 20 rs (+ i 1).
b5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5e0: 20 20 20 20 6c 65 6e 20 6c 65 6e 2d 31 29 29 29 len len-1)))
b5f0: 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 )))). (lambda
b600: 20 28 70 72 65 64 3f 20 76 65 63 20 2e 20 76 65 (pred? vec . ve
b610: 63 74 6f 72 73 29 0a 20 20 20 20 20 20 28 6c 65 ctors). (le
b620: 74 20 28 28 70 72 65 64 3f 20 28 63 68 65 63 6b t ((pred? (check
b630: 2d 74 79 70 65 20 70 72 6f 63 65 64 75 72 65 3f -type procedure?
b640: 20 70 72 65 64 3f 20 76 65 63 74 6f 72 2d 61 6e pred? vector-an
b650: 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 y)).
b660: 28 76 65 63 20 20 20 28 63 68 65 63 6b 2d 74 79 (vec (check-ty
b670: 70 65 20 76 65 63 74 6f 72 3f 20 20 20 20 76 65 pe vector? ve
b680: 63 20 20 20 76 65 63 74 6f 72 2d 61 6e 79 29 29 c vector-any))
b690: 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 6e ). (if (n
b6a0: 75 6c 6c 3f 20 76 65 63 74 6f 72 73 29 0a 20 20 ull? vectors).
b6b0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
b6c0: 28 6c 65 6e 20 28 76 65 63 74 6f 72 2d 6c 65 6e (len (vector-len
b6d0: 67 74 68 20 76 65 63 29 29 29 0a 20 20 20 20 20 gth vec))).
b6e0: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 31 20 (loop1
b6f0: 70 72 65 64 3f 20 76 65 63 20 30 20 6c 65 6e 20 pred? vec 0 len
b700: 28 2d 20 6c 65 6e 20 31 29 29 29 0a 20 20 20 20 (- len 1))).
b710: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c (let ((l
b720: 65 6e 20 28 25 73 6d 61 6c 6c 65 73 74 2d 6c 65 en (%smallest-le
b730: 6e 67 74 68 20 76 65 63 74 6f 72 73 0a 20 20 20 ngth vectors.
b740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b760: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 6c 65 (vector-le
b770: 6e 67 74 68 20 76 65 63 29 0a 20 20 20 20 20 20 ngth vec).
b780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b7a0: 20 20 20 76 65 63 74 6f 72 2d 61 6e 79 29 29 29 vector-any)))
b7b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
b7c0: 6c 6f 6f 70 32 2b 20 70 72 65 64 3f 20 28 63 6f loop2+ pred? (co
b7d0: 6e 73 20 76 65 63 20 76 65 63 74 6f 72 73 29 20 ns vec vectors)
b7e0: 30 20 6c 65 6e 20 28 2d 20 6c 65 6e 20 31 29 29 0 len (- len 1))
b7f0: 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 ))))))..;;; (VEC
b800: 54 4f 52 2d 45 56 45 52 59 20 3c 70 72 65 64 3f TOR-EVERY <pred?
b810: 3e 20 3c 76 65 63 74 6f 72 3e 20 2e 2e 2e 29 20 > <vector> ...)
b820: 2d 3e 20 76 61 6c 75 65 0a 3b 3b 3b 20 20 20 41 -> value.;;; A
b830: 70 70 6c 79 20 50 52 45 44 3f 20 74 6f 20 65 61 pply PRED? to ea
b840: 63 68 20 70 61 72 61 6c 6c 65 6c 20 76 61 6c 75 ch parallel valu
b850: 65 20 69 6e 20 65 61 63 68 20 56 45 43 54 4f 52 e in each VECTOR
b860: 20 2e 2e 2e 3b 20 69 66 20 50 52 45 44 3f 0a 3b ...; if PRED?.;
b870: 3b 3b 20 20 20 73 68 6f 75 6c 64 20 65 76 65 72 ;; should ever
b880: 20 72 65 74 75 72 6e 20 23 46 2c 20 69 6d 6d 65 return #F, imme
b890: 64 69 61 74 65 6c 79 20 73 74 6f 70 20 61 6e 64 diately stop and
b8a0: 20 72 65 74 75 72 6e 20 23 46 3b 20 6f 74 68 65 return #F; othe
b8b0: 72 77 69 73 65 2c 0a 3b 3b 3b 20 20 20 69 66 20 rwise,.;;; if
b8c0: 50 52 45 44 3f 20 73 68 6f 75 6c 64 20 72 65 74 PRED? should ret
b8d0: 75 72 6e 20 61 20 74 72 75 65 20 76 61 6c 75 65 urn a true value
b8e0: 20 66 6f 72 20 65 61 63 68 20 65 6c 65 6d 65 6e for each elemen
b8f0: 74 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 0a 3b t, stopping at.;
b900: 3b 3b 20 20 20 74 68 65 20 65 6e 64 20 6f 66 20 ;; the end of
b910: 74 68 65 20 73 68 6f 72 74 65 73 74 20 76 65 63 the shortest vec
b920: 74 6f 72 2c 20 72 65 74 75 72 6e 20 74 68 65 20 tor, return the
b930: 6c 61 73 74 20 76 61 6c 75 65 20 74 68 61 74 20 last value that
b940: 50 52 45 44 3f 0a 3b 3b 3b 20 20 20 72 65 74 75 PRED?.;;; retu
b950: 72 6e 65 64 2e 20 20 49 6e 20 74 68 65 20 63 61 rned. In the ca
b960: 73 65 20 74 68 61 74 20 74 68 65 72 65 20 69 73 se that there is
b970: 20 61 6e 20 65 6d 70 74 79 20 76 65 63 74 6f 72 an empty vector
b980: 2c 20 72 65 74 75 72 6e 20 23 54 2e 0a 3b 3b 3b , return #T..;;;
b990: 20 20 20 54 68 65 20 69 74 65 72 61 74 69 6f 6e The iteration
b9a0: 20 61 6e 64 20 6f 72 64 65 72 20 6f 66 20 61 70 and order of ap
b9b0: 70 6c 69 63 61 74 69 6f 6e 20 6f 66 20 50 52 45 plication of PRE
b9c0: 44 3f 20 61 63 72 6f 73 73 20 65 6c 65 6d 65 6e D? across elemen
b9d0: 74 73 0a 3b 3b 3b 20 20 20 69 73 20 6f 66 20 74 ts.;;; is of t
b9e0: 68 65 20 76 65 63 74 6f 72 73 20 69 73 20 73 74 he vectors is st
b9f0: 72 69 63 74 6c 79 20 6c 65 66 74 2d 74 6f 2d 72 rictly left-to-r
ba00: 69 67 68 74 2e 0a 28 64 65 66 69 6e 65 20 76 65 ight..(define ve
ba10: 63 74 6f 72 2d 65 76 65 72 79 0a 20 20 28 6c 65 ctor-every. (le
ba20: 74 72 65 63 20 28 28 6c 6f 6f 70 31 20 28 6c 61 trec ((loop1 (la
ba30: 6d 62 64 61 20 28 70 72 65 64 3f 20 76 65 63 20 mbda (pred? vec
ba40: 69 20 6c 65 6e 20 6c 65 6e 2d 31 29 0a 20 20 20 i len len-1).
ba50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba60: 20 28 6f 72 20 28 3d 20 69 20 6c 65 6e 29 0a 20 (or (= i len).
ba70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba80: 20 20 20 20 20 20 20 28 69 66 20 28 3d 20 69 20 (if (= i
ba90: 6c 65 6e 2d 31 29 0a 20 20 20 20 20 20 20 20 20 len-1).
baa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bab0: 20 20 20 28 70 72 65 64 3f 20 28 76 65 63 74 6f (pred? (vecto
bac0: 72 2d 72 65 66 20 76 65 63 20 69 29 29 0a 20 20 r-ref vec i)).
bad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bae0: 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 (and (
baf0: 70 72 65 64 3f 20 28 76 65 63 74 6f 72 2d 72 65 pred? (vector-re
bb00: 66 20 76 65 63 20 69 29 29 0a 20 20 20 20 20 20 f vec i)).
bb10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb20: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
bb30: 31 20 70 72 65 64 3f 20 76 65 63 20 28 2b 20 69 1 pred? vec (+ i
bb40: 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 1).
bb50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb60: 20 20 20 20 20 20 20 20 20 20 20 20 6c 65 6e 20 len
bb70: 6c 65 6e 2d 31 29 29 29 29 29 29 0a 20 20 20 20 len-1)))))).
bb80: 20 20 20 20 20 20 20 28 6c 6f 6f 70 32 2b 20 28 (loop2+ (
bb90: 6c 61 6d 62 64 61 20 28 70 72 65 64 3f 20 76 65 lambda (pred? ve
bba0: 63 74 6f 72 73 20 69 20 6c 65 6e 20 6c 65 6e 2d ctors i len len-
bbb0: 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1).
bbc0: 20 20 20 20 20 20 20 20 28 6f 72 20 28 3d 20 69 (or (= i
bbd0: 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 len).
bbe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
bbf0: 69 66 20 28 3d 20 69 20 6c 65 6e 2d 31 29 0a 20 if (= i len-1).
bc00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc10: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
bc20: 6c 79 20 70 72 65 64 3f 20 28 76 65 63 74 6f 72 ly pred? (vector
bc30: 73 2d 72 65 66 20 76 65 63 74 6f 72 73 20 69 29 s-ref vectors i)
bc40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
bc50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
bc60: 61 6e 64 20 28 61 70 70 6c 79 20 70 72 65 64 3f and (apply pred?
bc70: 20 28 76 65 63 74 6f 72 73 2d 72 65 66 20 76 65 (vectors-ref ve
bc80: 63 74 6f 72 73 20 69 29 29 0a 20 20 20 20 20 20 ctors i)).
bc90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bca0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
bcb0: 70 32 2b 20 70 72 65 64 3f 20 76 65 63 74 6f 72 p2+ pred? vector
bcc0: 73 20 28 2b 20 69 20 31 29 0a 20 20 20 20 20 20 s (+ i 1).
bcd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcf0: 20 20 20 20 6c 65 6e 20 6c 65 6e 2d 31 29 29 29 len len-1)))
bd00: 29 29 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 )))). (lambda
bd10: 20 28 70 72 65 64 3f 20 76 65 63 20 2e 20 76 65 (pred? vec . ve
bd20: 63 74 6f 72 73 29 0a 20 20 20 20 20 20 28 6c 65 ctors). (le
bd30: 74 20 28 28 70 72 65 64 3f 20 28 63 68 65 63 6b t ((pred? (check
bd40: 2d 74 79 70 65 20 70 72 6f 63 65 64 75 72 65 3f -type procedure?
bd50: 20 70 72 65 64 3f 20 76 65 63 74 6f 72 2d 65 76 pred? vector-ev
bd60: 65 72 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 ery)).
bd70: 20 20 28 76 65 63 20 20 20 28 63 68 65 63 6b 2d (vec (check-
bd80: 74 79 70 65 20 76 65 63 74 6f 72 3f 20 20 20 20 type vector?
bd90: 76 65 63 20 20 20 76 65 63 74 6f 72 2d 65 76 65 vec vector-eve
bda0: 72 79 29 29 29 0a 20 20 20 20 20 20 20 20 28 69 ry))). (i
bdb0: 66 20 28 6e 75 6c 6c 3f 20 76 65 63 74 6f 72 73 f (null? vectors
bdc0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c ). (l
bdd0: 65 74 20 28 28 6c 65 6e 20 28 76 65 63 74 6f 72 et ((len (vector
bde0: 2d 6c 65 6e 67 74 68 20 76 65 63 29 29 29 0a 20 -length vec))).
bdf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
be00: 6f 70 31 20 70 72 65 64 3f 20 76 65 63 20 30 20 op1 pred? vec 0
be10: 6c 65 6e 20 28 2d 20 6c 65 6e 20 31 29 29 29 0a len (- len 1))).
be20: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
be30: 20 28 28 6c 65 6e 20 28 25 73 6d 61 6c 6c 65 73 ((len (%smalles
be40: 74 2d 6c 65 6e 67 74 68 20 76 65 63 74 6f 72 73 t-length vectors
be50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
be60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be70: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
be80: 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 0a 20 20 r-length vec).
be90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
beb0: 20 20 20 20 20 20 20 76 65 63 74 6f 72 2d 65 76 vector-ev
bec0: 65 72 79 29 29 29 0a 20 20 20 20 20 20 20 20 20 ery))).
bed0: 20 20 20 20 20 28 6c 6f 6f 70 32 2b 20 70 72 65 (loop2+ pre
bee0: 64 3f 20 28 63 6f 6e 73 20 76 65 63 20 76 65 63 d? (cons vec vec
bef0: 74 6f 72 73 29 20 30 20 6c 65 6e 20 28 2d 20 6c tors) 0 len (- l
bf00: 65 6e 20 31 29 29 29 29 29 29 29 29 0a 0a 0c 0a en 1))))))))....
bf10: 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d .;;; -----------
bf20: 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 4d 75 ---------.;;; Mu
bf30: 74 61 74 6f 72 73 0a 0a 3b 3b 3b 20 28 56 45 43 tators..;;; (VEC
bf40: 54 4f 52 2d 53 45 54 21 20 3c 76 65 63 74 6f 72 TOR-SET! <vector
bf50: 3e 20 3c 69 6e 64 65 78 3e 20 3c 76 61 6c 75 65 > <index> <value
bf60: 3e 29 20 2d 3e 20 75 6e 73 70 65 63 69 66 69 65 >) -> unspecifie
bf70: 64 0a 3b 3b 3b 20 20 20 5b 52 35 52 53 5d 20 41 d.;;; [R5RS] A
bf80: 73 73 69 67 6e 20 74 68 65 20 6c 6f 63 61 74 69 ssign the locati
bf90: 6f 6e 20 61 74 20 49 4e 44 45 58 20 69 6e 20 56 on at INDEX in V
bfa0: 45 43 54 4f 52 20 74 6f 20 56 41 4c 55 45 2e 0a ECTOR to VALUE..
bfb0: 3b 3b 20 28 64 65 66 69 6e 65 20 76 65 63 74 6f ;; (define vecto
bfc0: 72 2d 73 65 74 21 20 76 65 63 74 6f 72 2d 73 65 r-set! vector-se
bfd0: 74 21 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 t!)..;;; (VECTOR
bfe0: 2d 53 57 41 50 21 20 3c 76 65 63 74 6f 72 3e 20 -SWAP! <vector>
bff0: 3c 69 6e 64 65 78 31 3e 20 3c 69 6e 64 65 78 32 <index1> <index2
c000: 3e 29 20 2d 3e 20 75 6e 73 70 65 63 69 66 69 65 >) -> unspecifie
c010: 64 0a 3b 3b 3b 20 20 20 53 77 61 70 20 74 68 65 d.;;; Swap the
c020: 20 76 61 6c 75 65 73 20 69 6e 20 74 68 65 20 6c values in the l
c030: 6f 63 61 74 69 6f 6e 73 20 61 74 20 49 4e 44 45 ocations at INDE
c040: 58 31 20 61 6e 64 20 49 4e 44 45 58 32 2e 0a 28 X1 and INDEX2..(
c050: 64 65 66 69 6e 65 20 28 76 65 63 74 6f 72 2d 73 define (vector-s
c060: 77 61 70 21 20 76 65 63 20 69 20 6a 29 0a 20 20 wap! vec i j).
c070: 28 6c 65 74 20 28 28 76 65 63 20 28 63 68 65 63 (let ((vec (chec
c080: 6b 2d 74 79 70 65 20 76 65 63 74 6f 72 3f 20 76 k-type vector? v
c090: 65 63 20 76 65 63 74 6f 72 2d 73 77 61 70 21 29 ec vector-swap!)
c0a0: 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 69 20 )). (let ((i
c0b0: 28 63 68 65 63 6b 2d 69 6e 64 65 78 20 76 65 63 (check-index vec
c0c0: 20 69 20 76 65 63 74 6f 72 2d 73 77 61 70 21 29 i vector-swap!)
c0d0: 29 0a 20 20 20 20 20 20 20 20 20 20 28 6a 20 28 ). (j (
c0e0: 63 68 65 63 6b 2d 69 6e 64 65 78 20 76 65 63 20 check-index vec
c0f0: 6a 20 76 65 63 74 6f 72 2d 73 77 61 70 21 29 29 j vector-swap!))
c100: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 78 ). (let ((x
c110: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 (vector-ref vec
c120: 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 28 76 i))). (v
c130: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 69 ector-set! vec i
c140: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 (vector-ref vec
c150: 20 6a 29 29 0a 20 20 20 20 20 20 20 20 28 76 65 j)). (ve
c160: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 6a 20 ctor-set! vec j
c170: 78 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 x)))))..;;; (VEC
c180: 54 4f 52 2d 46 49 4c 4c 21 20 3c 76 65 63 74 6f TOR-FILL! <vecto
c190: 72 3e 20 3c 76 61 6c 75 65 3e 20 5b 3c 73 74 61 r> <value> [<sta
c1a0: 72 74 3e 20 3c 65 6e 64 3e 5d 29 20 2d 3e 20 75 rt> <end>]) -> u
c1b0: 6e 73 70 65 63 69 66 69 65 64 0a 3b 3b 3b 20 20 nspecified.;;;
c1c0: 20 5b 52 35 52 53 2b 5d 20 46 69 6c 6c 20 74 68 [R5RS+] Fill th
c1d0: 65 20 6c 6f 63 61 74 69 6f 6e 73 20 69 6e 20 56 e locations in V
c1e0: 45 43 54 4f 52 20 62 65 74 77 65 65 6e 20 53 54 ECTOR between ST
c1f0: 41 52 54 2c 20 77 68 6f 73 65 20 64 65 66 61 75 ART, whose defau
c200: 6c 74 0a 3b 3b 3b 20 20 20 69 73 20 30 2c 20 61 lt.;;; is 0, a
c210: 6e 64 20 45 4e 44 2c 20 77 68 6f 73 65 20 64 65 nd END, whose de
c220: 66 61 75 6c 74 20 69 73 20 74 68 65 20 6c 65 6e fault is the len
c230: 67 74 68 20 6f 66 20 56 45 43 54 4f 52 2c 20 77 gth of VECTOR, w
c240: 69 74 68 20 56 41 4c 55 45 2e 0a 3b 3b 3b 0a 3b ith VALUE..;;;.;
c250: 3b 3b 20 54 68 69 73 20 6f 6e 65 20 63 61 6e 20 ;; This one can
c260: 70 72 6f 62 61 62 6c 79 20 62 65 20 6d 61 64 65 probably be made
c270: 20 72 65 61 6c 6c 79 20 66 61 73 74 20 6e 61 74 really fast nat
c280: 69 76 65 6c 79 2e 0a 28 64 65 66 69 6e 65 20 76 ively..(define v
c290: 65 63 74 6f 72 2d 66 69 6c 6c 21 0a 20 20 28 6c ector-fill!. (l
c2a0: 65 74 20 28 28 25 76 65 63 74 6f 72 2d 66 69 6c et ((%vector-fil
c2b0: 6c 21 20 76 65 63 74 6f 72 2d 66 69 6c 6c 21 29 l! vector-fill!)
c2c0: 29 20 20 20 3b 20 54 61 6b 65 20 74 68 65 20 6e ) ; Take the n
c2d0: 61 74 69 76 65 20 6f 6e 65 2c 20 75 6e 64 65 72 ative one, under
c2e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c300: 20 20 20 20 20 20 20 20 20 3b 20 20 20 74 68 65 ; the
c310: 20 61 73 73 75 6d 70 74 69 6f 6e 20 74 68 61 74 assumption that
c320: 20 69 74 27 73 0a 20 20 20 20 20 20 20 20 20 20 it's.
c330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 ;
c350: 20 20 66 61 73 74 65 72 2c 20 73 6f 20 77 65 20 faster, so we
c360: 63 61 6e 20 75 73 65 20 69 74 20 69 66 0a 20 20 can use it if.
c370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c390: 20 20 20 20 20 20 3b 20 20 20 74 68 65 72 65 20 ; there
c3a0: 61 72 65 20 6e 6f 20 6f 70 74 69 6f 6e 61 6c 0a are no optional.
c3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c3c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c3d0: 20 20 20 20 20 20 20 20 3b 20 20 20 61 72 67 75 ; argu
c3e0: 6d 65 6e 74 73 2e 0a 20 20 20 20 28 6c 61 6d 62 ments.. (lamb
c3f0: 64 61 20 28 76 65 63 20 76 61 6c 75 65 20 2e 20 da (vec value .
c400: 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e 64 29 maybe-start+end)
c410: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c . (if (null
c420: 3f 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e ? maybe-start+en
c430: 64 29 0a 20 20 20 20 20 20 20 20 20 20 28 25 76 d). (%v
c440: 65 63 74 6f 72 2d 66 69 6c 6c 21 20 76 65 63 20 ector-fill! vec
c450: 76 61 6c 75 65 29 20 20 20 20 20 3b 2b 2b 2b 0a value) ;+++.
c460: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2d 76 (let-v
c470: 65 63 74 6f 72 2d 73 74 61 72 74 2b 65 6e 64 20 ector-start+end
c480: 76 65 63 74 6f 72 2d 66 69 6c 6c 21 20 76 65 63 vector-fill! vec
c490: 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e 64 maybe-start+end
c4a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c4b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c4c0: 20 28 73 74 61 72 74 20 65 6e 64 29 0a 20 20 20 (start end).
c4d0: 20 20 20 20 20 20 20 20 20 28 64 6f 20 28 28 69 (do ((i
c4e0: 20 73 74 61 72 74 20 28 2b 20 69 20 31 29 29 29 start (+ i 1)))
c4f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c500: 20 28 28 3d 20 69 20 65 6e 64 29 29 0a 20 20 20 ((= i end)).
c510: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
c520: 6f 72 2d 73 65 74 21 20 76 65 63 20 69 20 76 61 or-set! vec i va
c530: 6c 75 65 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 lue)))))))..;;;
c540: 28 56 45 43 54 4f 52 2d 43 4f 50 59 21 20 3c 74 (VECTOR-COPY! <t
c550: 61 72 67 65 74 3e 20 3c 74 73 74 61 72 74 3e 20 arget> <tstart>
c560: 3c 73 6f 75 72 63 65 3e 20 5b 3c 73 73 74 61 72 <source> [<sstar
c570: 74 3e 20 3c 73 65 6e 64 3e 5d 29 0a 3b 3b 3b 20 t> <send>]).;;;
c580: 20 20 20 20 20 20 2d 3e 20 75 6e 73 70 65 63 69 -> unspeci
c590: 66 69 65 64 0a 3b 3b 3b 20 20 20 43 6f 70 79 20 fied.;;; Copy
c5a0: 74 68 65 20 76 61 6c 75 65 73 20 69 6e 20 74 68 the values in th
c5b0: 65 20 6c 6f 63 61 74 69 6f 6e 73 20 69 6e 20 5b e locations in [
c5c0: 53 53 54 41 52 54 2c 53 45 4e 44 29 20 66 72 6f SSTART,SEND) fro
c5d0: 6d 20 53 4f 55 52 43 45 20 74 6f 0a 3b 3b 3b 20 m SOURCE to.;;;
c5e0: 20 20 74 6f 20 54 41 52 47 45 54 2c 20 73 74 61 to TARGET, sta
c5f0: 72 74 69 6e 67 20 61 74 20 54 53 54 41 52 54 20 rting at TSTART
c600: 69 6e 20 54 41 52 47 45 54 2e 0a 3b 3b 3b 20 5b in TARGET..;;; [
c610: 77 64 63 5d 20 43 6f 72 72 65 63 74 65 64 20 74 wdc] Corrected t
c620: 6f 20 61 6c 6c 6f 77 20 30 20 3c 3d 20 73 73 74 o allow 0 <= sst
c630: 61 72 74 20 3c 3d 20 73 65 6e 64 20 3c 3d 20 28 art <= send <= (
c640: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 73 6f vector-length so
c650: 75 72 63 65 29 2e 0a 28 64 65 66 69 6e 65 20 28 urce)..(define (
c660: 76 65 63 74 6f 72 2d 63 6f 70 79 21 20 74 61 72 vector-copy! tar
c670: 67 65 74 20 74 73 74 61 72 74 20 73 6f 75 72 63 get tstart sourc
c680: 65 20 2e 20 6d 61 79 62 65 2d 73 73 74 61 72 74 e . maybe-sstart
c690: 2b 73 65 6e 64 29 0a 20 20 28 64 65 66 69 6e 65 +send). (define
c6a0: 20 28 64 6f 69 74 21 20 73 73 74 61 72 74 20 73 (doit! sstart s
c6b0: 65 6e 64 20 73 6f 75 72 63 65 2d 6c 65 6e 67 74 end source-lengt
c6c0: 68 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 73 h). (let ((ts
c6d0: 74 61 72 74 20 28 63 68 65 63 6b 2d 74 79 70 65 tart (check-type
c6e0: 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 74 73 74 nonneg-int? tst
c6f0: 61 72 74 20 76 65 63 74 6f 72 2d 63 6f 70 79 21 art vector-copy!
c700: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 73 )). (ss
c710: 74 61 72 74 20 28 63 68 65 63 6b 2d 74 79 70 65 tart (check-type
c720: 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 73 73 74 nonneg-int? sst
c730: 61 72 74 20 76 65 63 74 6f 72 2d 63 6f 70 79 21 art vector-copy!
c740: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 )). (se
c750: 6e 64 20 20 20 28 63 68 65 63 6b 2d 74 79 70 65 nd (check-type
c760: 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 73 65 6e nonneg-int? sen
c770: 64 20 76 65 63 74 6f 72 2d 63 6f 70 79 21 29 29 d vector-copy!))
c780: 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 ). (cond ((
c790: 61 6e 64 20 28 3c 3d 20 30 20 73 73 74 61 72 74 and (<= 0 sstart
c7a0: 20 73 65 6e 64 20 73 6f 75 72 63 65 2d 6c 65 6e send source-len
c7b0: 67 74 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 gth).
c7c0: 20 20 20 20 20 20 20 28 3c 3d 20 28 2b 20 74 73 (<= (+ ts
c7d0: 74 61 72 74 20 28 2d 20 73 65 6e 64 20 73 73 74 tart (- send sst
c7e0: 61 72 74 29 29 20 28 76 65 63 74 6f 72 2d 6c 65 art)) (vector-le
c7f0: 6e 67 74 68 20 74 61 72 67 65 74 29 29 29 0a 20 ngth target))).
c800: 20 20 20 20 20 20 20 20 20 20 20 20 28 25 76 65 (%ve
c810: 63 74 6f 72 2d 63 6f 70 79 21 20 74 61 72 67 65 ctor-copy! targe
c820: 74 20 74 73 74 61 72 74 20 73 6f 75 72 63 65 20 t tstart source
c830: 73 73 74 61 72 74 20 73 65 6e 64 29 29 0a 20 20 sstart send)).
c840: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
c850: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
c860: 72 6f 72 20 22 69 6c 6c 65 67 61 6c 20 61 72 67 ror "illegal arg
c870: 75 6d 65 6e 74 73 22 0a 20 20 20 20 20 20 20 20 uments".
c880: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 77 68 `(wh
c890: 69 6c 65 20 63 61 6c 6c 69 6e 67 20 2c 76 65 63 ile calling ,vec
c8a0: 74 6f 72 2d 63 6f 70 79 21 29 0a 20 20 20 20 20 tor-copy!).
c8b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 `
c8c0: 28 74 61 72 67 65 74 20 77 61 73 20 2c 74 61 72 (target was ,tar
c8d0: 67 65 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 get).
c8e0: 20 20 20 20 20 20 20 20 20 60 28 74 61 72 67 65 `(targe
c8f0: 74 2d 6c 65 6e 67 74 68 20 77 61 73 20 2c 28 76 t-length was ,(v
c900: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 74 61 72 ector-length tar
c910: 67 65 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 get)).
c920: 20 20 20 20 20 20 20 20 20 20 60 28 74 73 74 61 `(tsta
c930: 72 74 20 77 61 73 20 2c 74 73 74 61 72 74 29 0a rt was ,tstart).
c940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c950: 20 20 20 20 60 28 73 6f 75 72 63 65 20 77 61 73 `(source was
c960: 20 2c 73 6f 75 72 63 65 29 0a 20 20 20 20 20 20 ,source).
c970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
c980: 73 6f 75 72 63 65 2d 6c 65 6e 67 74 68 20 77 61 source-length wa
c990: 73 20 2c 73 6f 75 72 63 65 2d 6c 65 6e 67 74 68 s ,source-length
c9a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
c9b0: 20 20 20 20 20 20 60 28 73 73 74 61 72 74 20 77 `(sstart w
c9c0: 61 73 20 2c 73 73 74 61 72 74 29 0a 20 20 20 20 as ,sstart).
c9d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c9e0: 60 28 73 65 6e 64 20 20 20 77 61 73 20 2c 73 65 `(send was ,se
c9f0: 6e 64 29 29 29 29 29 29 0a 20 20 28 6c 65 74 20 nd)))))). (let
ca00: 28 28 6e 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 ((n (vector-leng
ca10: 74 68 20 73 6f 75 72 63 65 29 29 29 0a 20 20 20 th source))).
ca20: 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 6d (cond ((null? m
ca30: 61 79 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 aybe-sstart+send
ca40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 6f ). (do
ca50: 69 74 21 20 30 20 6e 20 6e 29 29 0a 20 20 20 20 it! 0 n n)).
ca60: 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 ((null? (c
ca70: 64 72 20 6d 61 79 62 65 2d 73 73 74 61 72 74 2b dr maybe-sstart+
ca80: 73 65 6e 64 29 29 0a 20 20 20 20 20 20 20 20 20 send)).
ca90: 20 20 28 64 6f 69 74 21 20 28 63 61 72 20 6d 61 (doit! (car ma
caa0: 79 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 ybe-sstart+send)
cab0: 20 6e 20 6e 29 29 0a 20 20 20 20 20 20 20 20 20 n n)).
cac0: 20 28 28 6e 75 6c 6c 3f 20 28 63 64 64 72 20 6d ((null? (cddr m
cad0: 61 79 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 aybe-sstart+send
cae0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 )). (d
caf0: 6f 69 74 21 20 28 63 61 72 20 6d 61 79 62 65 2d oit! (car maybe-
cb00: 73 73 74 61 72 74 2b 73 65 6e 64 29 20 28 63 61 sstart+send) (ca
cb10: 64 72 20 6d 61 79 62 65 2d 73 73 74 61 72 74 2b dr maybe-sstart+
cb20: 73 65 6e 64 29 20 6e 29 29 0a 20 20 20 20 20 20 send) n)).
cb30: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
cb40: 20 20 20 20 20 28 65 72 72 6f 72 20 22 74 6f 6f (error "too
cb50: 20 6d 61 6e 79 20 61 72 67 75 6d 65 6e 74 73 22 many arguments"
cb60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
cb70: 20 20 20 76 65 63 74 6f 72 2d 63 6f 70 79 21 0a vector-copy!.
cb80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cb90: 20 20 28 63 64 64 72 20 6d 61 79 62 65 2d 73 73 (cddr maybe-ss
cba0: 74 61 72 74 2b 73 65 6e 64 29 29 29 29 29 29 0a tart+send)))))).
cbb0: 0a 3b 3b 3b 20 28 56 45 43 54 4f 52 2d 52 45 56 .;;; (VECTOR-REV
cbc0: 45 52 53 45 2d 43 4f 50 59 21 20 3c 74 61 72 67 ERSE-COPY! <targ
cbd0: 65 74 3e 20 3c 74 73 74 61 72 74 3e 20 3c 73 6f et> <tstart> <so
cbe0: 75 72 63 65 3e 20 5b 3c 73 73 74 61 72 74 3e 20 urce> [<sstart>
cbf0: 3c 73 65 6e 64 3e 5d 29 0a 3b 3b 3b 20 5b 77 64 <send>]).;;; [wd
cc00: 63 5d 20 43 6f 72 72 65 63 74 65 64 20 74 6f 20 c] Corrected to
cc10: 61 6c 6c 6f 77 20 30 20 3c 3d 20 73 73 74 61 72 allow 0 <= sstar
cc20: 74 20 3c 3d 20 73 65 6e 64 20 3c 3d 20 28 76 65 t <= send <= (ve
cc30: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 73 6f 75 72 ctor-length sour
cc40: 63 65 29 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 ce)..(define (ve
cc50: 63 74 6f 72 2d 72 65 76 65 72 73 65 2d 63 6f 70 ctor-reverse-cop
cc60: 79 21 20 74 61 72 67 65 74 20 74 73 74 61 72 74 y! target tstart
cc70: 20 73 6f 75 72 63 65 20 2e 20 6d 61 79 62 65 2d source . maybe-
cc80: 73 73 74 61 72 74 2b 73 65 6e 64 29 0a 20 20 28 sstart+send). (
cc90: 64 65 66 69 6e 65 20 28 64 6f 69 74 21 20 73 73 define (doit! ss
cca0: 74 61 72 74 20 73 65 6e 64 20 73 6f 75 72 63 65 tart send source
ccb0: 2d 6c 65 6e 67 74 68 29 0a 20 20 20 20 28 6c 65 -length). (le
ccc0: 74 20 28 28 74 73 74 61 72 74 20 28 63 68 65 63 t ((tstart (chec
ccd0: 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 67 2d 69 6e k-type nonneg-in
cce0: 74 3f 20 74 73 74 61 72 74 20 76 65 63 74 6f 72 t? tstart vector
ccf0: 2d 72 65 76 65 72 73 65 2d 63 6f 70 79 21 29 29 -reverse-copy!))
cd00: 0a 20 20 20 20 20 20 20 20 20 20 28 73 73 74 61 . (ssta
cd10: 72 74 20 28 63 68 65 63 6b 2d 74 79 70 65 20 6e rt (check-type n
cd20: 6f 6e 6e 65 67 2d 69 6e 74 3f 20 73 73 74 61 72 onneg-int? sstar
cd30: 74 20 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 t vector-reverse
cd40: 2d 63 6f 70 79 21 29 29 0a 20 20 20 20 20 20 20 -copy!)).
cd50: 20 20 20 28 73 65 6e 64 20 20 20 28 63 68 65 63 (send (chec
cd60: 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 67 2d 69 6e k-type nonneg-in
cd70: 74 3f 20 73 65 6e 64 20 76 65 63 74 6f 72 2d 72 t? send vector-r
cd80: 65 76 65 72 73 65 2d 63 6f 70 79 21 29 29 29 0a everse-copy!))).
cd90: 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 61 6e (cond ((an
cda0: 64 20 28 65 71 3f 20 74 61 72 67 65 74 20 73 6f d (eq? target so
cdb0: 75 72 63 65 29 0a 20 20 20 20 20 20 20 20 20 20 urce).
cdc0: 20 20 20 20 20 20 20 20 28 6f 72 20 28 62 65 74 (or (bet
cdd0: 77 65 65 6e 3f 20 73 73 74 61 72 74 20 74 73 74 ween? sstart tst
cde0: 61 72 74 20 73 65 6e 64 29 0a 20 20 20 20 20 20 art send).
cdf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ce00: 28 62 65 74 77 65 65 6e 3f 20 74 73 74 61 72 74 (between? tstart
ce10: 20 73 73 74 61 72 74 0a 20 20 20 20 20 20 20 20 sstart.
ce20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ce30: 20 20 20 20 20 20 20 20 28 2b 20 74 73 74 61 72 (+ tstar
ce40: 74 20 28 2d 20 73 65 6e 64 20 73 73 74 61 72 74 t (- send sstart
ce50: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
ce60: 20 20 20 20 20 28 65 72 72 6f 72 20 22 76 65 63 (error "vec
ce70: 74 6f 72 20 72 61 6e 67 65 20 66 6f 72 20 73 65 tor range for se
ce80: 6c 66 2d 63 6f 70 79 69 6e 67 20 6f 76 65 72 6c lf-copying overl
ce90: 61 70 73 22 0a 20 20 20 20 20 20 20 20 20 20 20 aps".
cea0: 20 20 20 20 20 20 20 20 20 20 20 76 65 63 74 6f vecto
ceb0: 72 2d 72 65 76 65 72 73 65 2d 63 6f 70 79 21 0a r-reverse-copy!.
cec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ced0: 20 20 20 20 20 20 60 28 76 65 63 74 6f 72 20 77 `(vector w
cee0: 61 73 20 2c 74 61 72 67 65 74 29 0a 20 20 20 20 as ,target).
cef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cf00: 20 20 60 28 74 73 74 61 72 74 20 77 61 73 20 2c `(tstart was ,
cf10: 74 73 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 tstart).
cf20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
cf30: 73 73 74 61 72 74 20 77 61 73 20 2c 73 73 74 61 sstart was ,ssta
cf40: 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rt).
cf50: 20 20 20 20 20 20 20 20 20 20 60 28 73 65 6e 64 `(send
cf60: 20 20 20 77 61 73 20 2c 73 65 6e 64 29 29 29 0a was ,send))).
cf70: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 6e ((an
cf80: 64 20 28 3c 3d 20 30 20 73 73 74 61 72 74 20 73 d (<= 0 sstart s
cf90: 65 6e 64 20 73 6f 75 72 63 65 2d 6c 65 6e 67 74 end source-lengt
cfa0: 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 h).
cfb0: 20 20 20 20 20 28 3c 3d 20 28 2b 20 74 73 74 61 (<= (+ tsta
cfc0: 72 74 20 28 2d 20 73 65 6e 64 20 73 73 74 61 72 rt (- send sstar
cfd0: 74 29 29 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 t)) (vector-leng
cfe0: 74 68 20 74 61 72 67 65 74 29 29 29 0a 20 20 20 th target))).
cff0: 20 20 20 20 20 20 20 20 20 20 28 25 76 65 63 74 (%vect
d000: 6f 72 2d 72 65 76 65 72 73 65 2d 63 6f 70 79 21 or-reverse-copy!
d010: 20 74 61 72 67 65 74 20 74 73 74 61 72 74 20 73 target tstart s
d020: 6f 75 72 63 65 20 73 73 74 61 72 74 20 73 65 6e ource sstart sen
d030: 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 d)).
d040: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
d050: 20 20 20 28 65 72 72 6f 72 20 22 69 6c 6c 65 67 (error "illeg
d060: 61 6c 20 61 72 67 75 6d 65 6e 74 73 22 0a 20 20 al arguments".
d070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d080: 20 20 60 28 77 68 69 6c 65 20 63 61 6c 6c 69 6e `(while callin
d090: 67 20 2c 76 65 63 74 6f 72 2d 72 65 76 65 72 73 g ,vector-revers
d0a0: 65 2d 63 6f 70 79 21 29 0a 20 20 20 20 20 20 20 e-copy!).
d0b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 74 `(t
d0c0: 61 72 67 65 74 20 77 61 73 20 2c 74 61 72 67 65 arget was ,targe
d0d0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
d0e0: 20 20 20 20 20 20 20 60 28 74 61 72 67 65 74 2d `(target-
d0f0: 6c 65 6e 67 74 68 20 77 61 73 20 2c 28 76 65 63 length was ,(vec
d100: 74 6f 72 2d 6c 65 6e 67 74 68 20 74 61 72 67 65 tor-length targe
d110: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
d120: 20 20 20 20 20 20 20 20 60 28 74 73 74 61 72 74 `(tstart
d130: 20 77 61 73 20 2c 74 73 74 61 72 74 29 0a 20 20 was ,tstart).
d140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d150: 20 20 60 28 73 6f 75 72 63 65 20 77 61 73 20 2c `(source was ,
d160: 73 6f 75 72 63 65 29 0a 20 20 20 20 20 20 20 20 source).
d170: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 73 6f `(so
d180: 75 72 63 65 2d 6c 65 6e 67 74 68 20 77 61 73 20 urce-length was
d190: 2c 73 6f 75 72 63 65 2d 6c 65 6e 67 74 68 29 0a ,source-length).
d1a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d1b0: 20 20 20 20 60 28 73 73 74 61 72 74 20 77 61 73 `(sstart was
d1c0: 20 2c 73 73 74 61 72 74 29 0a 20 20 20 20 20 20 ,sstart).
d1d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
d1e0: 73 65 6e 64 20 20 20 77 61 73 20 2c 73 65 6e 64 send was ,send
d1f0: 29 29 29 29 29 29 0a 20 20 28 6c 65 74 20 28 28 )))))). (let ((
d200: 6e 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 n (vector-length
d210: 20 73 6f 75 72 63 65 29 29 29 0a 20 20 20 20 28 source))). (
d220: 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 6d 61 79 cond ((null? may
d230: 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 0a be-sstart+send).
d240: 20 20 20 20 20 20 20 20 20 20 20 28 64 6f 69 74 (doit
d250: 21 20 30 20 6e 20 6e 29 29 0a 20 20 20 20 20 20 ! 0 n n)).
d260: 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 72 ((null? (cdr
d270: 20 6d 61 79 62 65 2d 73 73 74 61 72 74 2b 73 65 maybe-sstart+se
d280: 6e 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 nd)).
d290: 28 64 6f 69 74 21 20 28 63 61 72 20 6d 61 79 62 (doit! (car mayb
d2a0: 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 20 6e e-sstart+send) n
d2b0: 20 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 n)). (
d2c0: 28 6e 75 6c 6c 3f 20 28 63 64 64 72 20 6d 61 79 (null? (cddr may
d2d0: 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 29 be-sstart+send))
d2e0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 6f 69 . (doi
d2f0: 74 21 20 28 63 61 72 20 6d 61 79 62 65 2d 73 73 t! (car maybe-ss
d300: 74 61 72 74 2b 73 65 6e 64 29 20 28 63 61 64 72 tart+send) (cadr
d310: 20 6d 61 79 62 65 2d 73 73 74 61 72 74 2b 73 65 maybe-sstart+se
d320: 6e 64 29 20 6e 29 29 0a 20 20 20 20 20 20 20 20 nd) n)).
d330: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
d340: 20 20 20 28 65 72 72 6f 72 20 22 74 6f 6f 20 6d (error "too m
d350: 61 6e 79 20 61 72 67 75 6d 65 6e 74 73 22 0a 20 any arguments".
d360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d370: 20 76 65 63 74 6f 72 2d 72 65 76 65 72 73 65 2d vector-reverse-
d380: 63 6f 70 79 21 0a 20 20 20 20 20 20 20 20 20 20 copy!.
d390: 20 20 20 20 20 20 20 20 28 63 64 64 72 20 6d 61 (cddr ma
d3a0: 79 62 65 2d 73 73 74 61 72 74 2b 73 65 6e 64 29 ybe-sstart+send)
d3b0: 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 56 45 43 54 )))))..;;; (VECT
d3c0: 4f 52 2d 52 45 56 45 52 53 45 21 20 3c 76 65 63 OR-REVERSE! <vec
d3d0: 74 6f 72 3e 20 5b 3c 73 74 61 72 74 3e 20 3c 65 tor> [<start> <e
d3e0: 6e 64 3e 5d 29 20 2d 3e 20 75 6e 73 70 65 63 69 nd>]) -> unspeci
d3f0: 66 69 65 64 0a 3b 3b 3b 20 20 20 44 65 73 74 72 fied.;;; Destr
d400: 75 63 74 69 76 65 6c 79 20 72 65 76 65 72 73 65 uctively reverse
d410: 20 74 68 65 20 63 6f 6e 74 65 6e 74 73 20 6f 66 the contents of
d420: 20 74 68 65 20 73 65 71 75 65 6e 63 65 20 6f 66 the sequence of
d430: 20 6c 6f 63 61 74 69 6f 6e 73 0a 3b 3b 3b 20 20 locations.;;;
d440: 20 69 6e 20 56 45 43 54 4f 52 20 62 65 74 77 65 in VECTOR betwe
d450: 65 6e 20 53 54 41 52 54 2c 20 77 68 6f 73 65 20 en START, whose
d460: 64 65 66 61 75 6c 74 20 69 73 20 30 2c 20 61 6e default is 0, an
d470: 64 20 45 4e 44 2c 20 77 68 6f 73 65 0a 3b 3b 3b d END, whose.;;;
d480: 20 20 20 64 65 66 61 75 6c 74 20 69 73 20 74 68 default is th
d490: 65 20 6c 65 6e 67 74 68 20 6f 66 20 56 45 43 54 e length of VECT
d4a0: 4f 52 2e 0a 28 64 65 66 69 6e 65 20 28 76 65 63 OR..(define (vec
d4b0: 74 6f 72 2d 72 65 76 65 72 73 65 21 20 76 65 63 tor-reverse! vec
d4c0: 20 2e 20 73 74 61 72 74 2b 65 6e 64 29 0a 20 20 . start+end).
d4d0: 28 6c 65 74 2d 76 65 63 74 6f 72 2d 73 74 61 72 (let-vector-star
d4e0: 74 2b 65 6e 64 20 76 65 63 74 6f 72 2d 72 65 76 t+end vector-rev
d4f0: 65 72 73 65 21 20 76 65 63 20 73 74 61 72 74 2b erse! vec start+
d500: 65 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 end.
d510: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 (sta
d520: 72 74 20 65 6e 64 29 0a 20 20 20 20 28 25 76 65 rt end). (%ve
d530: 63 74 6f 72 2d 72 65 76 65 72 73 65 21 20 76 65 ctor-reverse! ve
d540: 63 20 73 74 61 72 74 20 65 6e 64 29 29 29 0a 0a c start end)))..
d550: 0c 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d ...;;; ---------
d560: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 3b 3b 20 -----------.;;;
d570: 43 6f 6e 76 65 72 73 69 6f 6e 0a 0a 3b 3b 3b 20 Conversion..;;;
d580: 28 56 45 43 54 4f 52 2d 3e 4c 49 53 54 20 3c 76 (VECTOR->LIST <v
d590: 65 63 74 6f 72 3e 20 5b 3c 73 74 61 72 74 3e 20 ector> [<start>
d5a0: 3c 65 6e 64 3e 5d 29 20 2d 3e 20 6c 69 73 74 0a <end>]) -> list.
d5b0: 3b 3b 3b 20 20 20 5b 52 35 52 53 2b 5d 20 50 72 ;;; [R5RS+] Pr
d5c0: 6f 64 75 63 65 20 61 20 6c 69 73 74 20 63 6f 6e oduce a list con
d5d0: 74 61 69 6e 69 6e 67 20 74 68 65 20 65 6c 65 6d taining the elem
d5e0: 65 6e 74 73 20 69 6e 20 74 68 65 20 6c 6f 63 61 ents in the loca
d5f0: 74 69 6f 6e 73 0a 3b 3b 3b 20 20 20 62 65 74 77 tions.;;; betw
d600: 65 65 6e 20 53 54 41 52 54 2c 20 77 68 6f 73 65 een START, whose
d610: 20 64 65 66 61 75 6c 74 20 69 73 20 30 2c 20 61 default is 0, a
d620: 6e 64 20 45 4e 44 2c 20 77 68 6f 73 65 20 64 65 nd END, whose de
d630: 66 61 75 6c 74 20 69 73 20 74 68 65 0a 3b 3b 3b fault is the.;;;
d640: 20 20 20 6c 65 6e 67 74 68 20 6f 66 20 56 45 43 length of VEC
d650: 54 4f 52 2c 20 66 72 6f 6d 20 56 45 43 54 4f 52 TOR, from VECTOR
d660: 2e 0a 28 64 65 66 69 6e 65 20 76 65 63 74 6f 72 ..(define vector
d670: 2d 3e 6c 69 73 74 0a 20 20 28 6c 65 74 20 28 28 ->list. (let ((
d680: 25 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 65 %vector->list ve
d690: 63 74 6f 72 2d 3e 6c 69 73 74 29 29 0a 20 20 20 ctor->list)).
d6a0: 20 28 6c 61 6d 62 64 61 20 28 76 65 63 20 2e 20 (lambda (vec .
d6b0: 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e 64 29 maybe-start+end)
d6c0: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c . (if (null
d6d0: 3f 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e ? maybe-start+en
d6e0: 64 29 20 20 20 20 20 20 20 3b 20 4f 75 67 68 74 d) ; Ought
d6f0: 61 20 75 73 65 20 43 41 53 45 2d 4c 41 4d 42 44 a use CASE-LAMBD
d700: 41 2e 0a 20 20 20 20 20 20 20 20 20 20 28 25 76 A.. (%v
d710: 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 65 63 29 ector->list vec)
d720: 20 20 20 20 20 20 20 20 20 20 20 3b 2b 2b 2b 0a ;+++.
d730: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2d 76 (let-v
d740: 65 63 74 6f 72 2d 73 74 61 72 74 2b 65 6e 64 20 ector-start+end
d750: 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 65 63 vector->list vec
d760: 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e 64 maybe-start+end
d770: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d790: 20 28 73 74 61 72 74 20 65 6e 64 29 0a 20 20 20 (start end).
d7a0: 20 20 20 20 20 20 20 20 20 3b 28 75 6e 66 6f 6c ;(unfol
d7b0: 64 20 28 6c 61 6d 62 64 61 20 28 69 29 20 20 20 d (lambda (i)
d7c0: 20 20 20 20 20 3b 20 4e 6f 20 53 52 46 49 20 31 ; No SRFI 1
d7d0: 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 .. ;
d7e0: 20 20 20 20 20 20 20 20 20 28 3c 20 69 20 73 74 (< i st
d7f0: 61 72 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 art)).
d800: 20 20 3b 20 20 20 20 20 20 20 20 28 6c 61 6d 62 ; (lamb
d810: 64 61 20 28 69 29 20 28 76 65 63 74 6f 72 2d 72 da (i) (vector-r
d820: 65 66 20 76 65 63 20 69 29 29 0a 20 20 20 20 20 ef vec i)).
d830: 20 20 20 20 20 20 20 3b 20 20 20 20 20 20 20 20 ;
d840: 28 6c 61 6d 62 64 61 20 28 69 29 20 28 2d 20 69 (lambda (i) (- i
d850: 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 1)).
d860: 20 3b 20 20 20 20 20 20 20 20 28 2d 20 65 6e 64 ; (- end
d870: 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 1)).
d880: 20 28 64 6f 20 28 28 69 20 28 2d 20 65 6e 64 20 (do ((i (- end
d890: 31 29 20 28 2d 20 69 20 31 29 29 0a 20 20 20 20 1) (- i 1)).
d8a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
d8b0: 73 75 6c 74 20 27 28 29 20 28 63 6f 6e 73 20 28 sult '() (cons (
d8c0: 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 69 vector-ref vec i
d8d0: 29 20 72 65 73 75 6c 74 29 29 29 0a 20 20 20 20 ) result))).
d8e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3c 20 ((<
d8f0: 69 20 73 74 61 72 74 29 20 72 65 73 75 6c 74 29 i start) result)
d900: 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 28 52 45 56 ))))))..;;; (REV
d910: 45 52 53 45 2d 56 45 43 54 4f 52 2d 3e 4c 49 53 ERSE-VECTOR->LIS
d920: 54 20 3c 76 65 63 74 6f 72 3e 20 5b 3c 73 74 61 T <vector> [<sta
d930: 72 74 3e 20 3c 65 6e 64 3e 5d 29 20 2d 3e 20 6c rt> <end>]) -> l
d940: 69 73 74 0a 3b 3b 3b 20 20 20 50 72 6f 64 75 63 ist.;;; Produc
d950: 65 20 61 20 6c 69 73 74 20 63 6f 6e 74 61 69 6e e a list contain
d960: 69 6e 67 20 74 68 65 20 65 6c 65 6d 65 6e 74 73 ing the elements
d970: 20 69 6e 20 74 68 65 20 6c 6f 63 61 74 69 6f 6e in the location
d980: 73 20 62 65 74 77 65 65 6e 0a 3b 3b 3b 20 20 20 s between.;;;
d990: 53 54 41 52 54 2c 20 77 68 6f 73 65 20 64 65 66 START, whose def
d9a0: 61 75 6c 74 20 69 73 20 30 2c 20 61 6e 64 20 45 ault is 0, and E
d9b0: 4e 44 2c 20 77 68 6f 73 65 20 64 65 66 61 75 6c ND, whose defaul
d9c0: 74 20 69 73 20 74 68 65 20 6c 65 6e 67 74 68 0a t is the length.
d9d0: 3b 3b 3b 20 20 20 6f 66 20 56 45 43 54 4f 52 2c ;;; of VECTOR,
d9e0: 20 66 72 6f 6d 20 56 45 43 54 4f 52 2c 20 69 6e from VECTOR, in
d9f0: 20 72 65 76 65 72 73 65 20 6f 72 64 65 72 2e 0a reverse order..
da00: 28 64 65 66 69 6e 65 20 28 72 65 76 65 72 73 65 (define (reverse
da10: 2d 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 65 -vector->list ve
da20: 63 20 2e 20 6d 61 79 62 65 2d 73 74 61 72 74 2b c . maybe-start+
da30: 65 6e 64 29 0a 20 20 28 6c 65 74 2d 76 65 63 74 end). (let-vect
da40: 6f 72 2d 73 74 61 72 74 2b 65 6e 64 20 72 65 76 or-start+end rev
da50: 65 72 73 65 2d 76 65 63 74 6f 72 2d 3e 6c 69 73 erse-vector->lis
da60: 74 20 76 65 63 20 6d 61 79 62 65 2d 73 74 61 72 t vec maybe-star
da70: 74 2b 65 6e 64 0a 20 20 20 20 20 20 20 20 20 20 t+end.
da80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
da90: 74 61 72 74 20 65 6e 64 29 0a 20 20 20 20 3b 28 tart end). ;(
daa0: 75 6e 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 28 unfold (lambda (
dab0: 69 29 20 28 3d 20 69 20 65 6e 64 29 29 20 20 20 i) (= i end))
dac0: 20 20 3b 20 4e 6f 20 53 52 46 49 20 31 2e 0a 20 ; No SRFI 1..
dad0: 20 20 20 3b 20 20 20 20 20 20 20 20 28 6c 61 6d ; (lam
dae0: 62 64 61 20 28 69 29 20 28 76 65 63 74 6f 72 2d bda (i) (vector-
daf0: 72 65 66 20 76 65 63 20 69 29 29 0a 20 20 20 20 ref vec i)).
db00: 3b 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ; (lambda
db10: 20 28 69 29 20 28 2b 20 69 20 31 29 29 0a 20 20 (i) (+ i 1)).
db20: 20 20 3b 20 20 20 20 20 20 20 20 73 74 61 72 74 ; start
db30: 29 0a 20 20 20 20 28 64 6f 20 28 28 69 20 73 74 ). (do ((i st
db40: 61 72 74 20 28 2b 20 69 20 31 29 29 0a 20 20 20 art (+ i 1)).
db50: 20 20 20 20 20 20 28 72 65 73 75 6c 74 20 27 28 (result '(
db60: 29 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 2d ) (cons (vector-
db70: 72 65 66 20 76 65 63 20 69 29 20 72 65 73 75 6c ref vec i) resul
db80: 74 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 3d t))). ((=
db90: 20 69 20 65 6e 64 29 20 72 65 73 75 6c 74 29 29 i end) result))
dba0: 29 29 0a 0a 3b 3b 3b 20 28 4c 49 53 54 2d 3e 56 ))..;;; (LIST->V
dbb0: 45 43 54 4f 52 20 3c 6c 69 73 74 3e 20 5b 3c 73 ECTOR <list> [<s
dbc0: 74 61 72 74 3e 20 3c 65 6e 64 3e 5d 29 20 2d 3e tart> <end>]) ->
dbd0: 20 76 65 63 74 6f 72 0a 3b 3b 3b 20 20 20 5b 52 vector.;;; [R
dbe0: 35 52 53 2b 5d 20 50 72 6f 64 75 63 65 20 61 20 5RS+] Produce a
dbf0: 76 65 63 74 6f 72 20 63 6f 6e 74 61 69 6e 69 6e vector containin
dc00: 67 20 74 68 65 20 65 6c 65 6d 65 6e 74 73 20 69 g the elements i
dc10: 6e 20 4c 49 53 54 2c 20 77 68 69 63 68 0a 3b 3b n LIST, which.;;
dc20: 3b 20 20 20 6d 75 73 74 20 62 65 20 61 20 70 72 ; must be a pr
dc30: 6f 70 65 72 20 6c 69 73 74 2c 20 62 65 74 77 65 oper list, betwe
dc40: 65 6e 20 53 54 41 52 54 2c 20 77 68 6f 73 65 20 en START, whose
dc50: 64 65 66 61 75 6c 74 20 69 73 20 30 2c 20 26 20 default is 0, &
dc60: 45 4e 44 2c 0a 3b 3b 3b 20 20 20 77 68 6f 73 65 END,.;;; whose
dc70: 20 64 65 66 61 75 6c 74 20 69 73 20 74 68 65 20 default is the
dc80: 6c 65 6e 67 74 68 20 6f 66 20 4c 49 53 54 2e 20 length of LIST.
dc90: 20 49 74 20 69 73 20 73 75 67 67 65 73 74 65 64 It is suggested
dca0: 20 74 68 61 74 20 69 66 20 74 68 65 0a 3b 3b 3b that if the.;;;
dcb0: 20 20 20 6c 65 6e 67 74 68 20 6f 66 20 4c 49 53 length of LIS
dcc0: 54 20 69 73 20 6b 6e 6f 77 6e 20 69 6e 20 61 64 T is known in ad
dcd0: 76 61 6e 63 65 2c 20 74 68 65 20 53 54 41 52 54 vance, the START
dce0: 20 61 6e 64 20 45 4e 44 20 61 72 67 75 6d 65 6e and END argumen
dcf0: 74 73 0a 3b 3b 3b 20 20 20 62 65 20 70 61 73 73 ts.;;; be pass
dd00: 65 64 2c 20 73 6f 20 74 68 61 74 20 4c 49 53 54 ed, so that LIST
dd10: 2d 3e 56 45 43 54 4f 52 20 6e 65 65 64 20 6e 6f ->VECTOR need no
dd20: 74 20 63 61 6c 6c 20 4c 45 4e 47 54 48 20 74 6f t call LENGTH to
dd30: 20 64 65 74 65 72 6d 69 6e 65 0a 3b 3b 3b 20 20 determine.;;;
dd40: 20 74 68 65 20 74 68 65 20 6c 65 6e 67 74 68 2e the the length.
dd50: 0a 3b 3b 3b 0a 3b 3b 3b 20 54 68 69 73 20 69 6d .;;;.;;; This im
dd60: 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 64 69 76 plementation div
dd70: 65 72 67 65 73 20 6f 6e 20 63 69 72 63 75 6c 61 erges on circula
dd80: 72 20 6c 69 73 74 73 2c 20 75 6e 6c 65 73 73 20 r lists, unless
dd90: 4c 45 4e 47 54 48 20 66 61 69 6c 73 0a 3b 3b 3b LENGTH fails.;;;
dda0: 20 61 6e 64 20 63 61 75 73 65 73 20 2d 20 74 6f and causes - to
ddb0: 20 66 61 69 6c 20 61 73 20 77 65 6c 6c 2e 20 20 fail as well.
ddc0: 47 69 76 65 6e 20 61 20 4c 45 4e 47 54 48 2a 20 Given a LENGTH*
ddd0: 74 68 61 74 20 63 6f 6d 70 75 74 65 73 20 74 68 that computes th
dde0: 65 0a 3b 3b 3b 20 6c 65 6e 67 74 68 20 6f 66 20 e.;;; length of
ddf0: 61 20 6c 69 73 74 27 73 20 63 79 63 6c 65 2c 20 a list's cycle,
de00: 74 68 69 73 20 77 6f 75 6c 64 6e 27 74 20 64 69 this wouldn't di
de10: 76 65 72 67 65 2c 20 61 6e 64 20 77 6f 75 6c 64 verge, and would
de20: 20 77 6f 72 6b 0a 3b 3b 3b 20 67 72 65 61 74 20 work.;;; great
de30: 66 6f 72 20 63 69 72 63 75 6c 61 72 20 6c 69 73 for circular lis
de40: 74 73 2e 0a 28 64 65 66 69 6e 65 20 6c 69 73 74 ts..(define list
de50: 2d 3e 76 65 63 74 6f 72 0a 20 20 28 6c 65 74 20 ->vector. (let
de60: 28 28 25 6c 69 73 74 2d 3e 76 65 63 74 6f 72 20 ((%list->vector
de70: 6c 69 73 74 2d 3e 76 65 63 74 6f 72 29 29 0a 20 list->vector)).
de80: 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 73 74 20 (lambda (lst
de90: 2e 20 6d 61 79 62 65 2d 73 74 61 72 74 2b 65 6e . maybe-start+en
dea0: 64 29 0a 20 20 20 20 20 20 3b 3b 20 43 68 65 63 d). ;; Chec
deb0: 6b 69 6e 67 20 74 68 65 20 74 79 70 65 20 6f 66 king the type of
dec0: 20 61 20 70 72 6f 70 65 72 20 6c 69 73 74 20 69 a proper list i
ded0: 73 20 65 78 70 65 6e 73 69 76 65 2c 20 73 6f 20 s expensive, so
dee0: 77 65 20 64 6f 20 69 74 0a 20 20 20 20 20 20 3b we do it. ;
def0: 3b 20 61 6d 6f 72 74 69 7a 65 64 6c 79 2c 20 6f ; amortizedly, o
df00: 72 20 6c 65 74 20 25 4c 49 53 54 2d 3e 56 45 43 r let %LIST->VEC
df10: 54 4f 52 20 6f 72 20 4c 49 53 54 2d 54 41 49 4c TOR or LIST-TAIL
df20: 20 64 6f 20 69 74 2e 0a 20 20 20 20 20 20 28 69 do it.. (i
df30: 66 20 28 6e 75 6c 6c 3f 20 6d 61 79 62 65 2d 73 f (null? maybe-s
df40: 74 61 72 74 2b 65 6e 64 29 20 20 20 20 20 20 20 tart+end)
df50: 3b 20 4f 75 67 68 74 61 20 75 73 65 20 43 41 53 ; Oughta use CAS
df60: 45 2d 4c 41 4d 42 44 41 2e 0a 20 20 20 20 20 20 E-LAMBDA..
df70: 20 20 20 20 28 25 6c 69 73 74 2d 3e 76 65 63 74 (%list->vect
df80: 6f 72 20 6c 73 74 29 20 20 20 20 20 20 20 20 20 or lst)
df90: 20 20 3b 2b 2b 2b 0a 20 20 20 20 20 20 20 20 20 ;+++.
dfa0: 20 3b 3b 20 57 65 20 63 61 6e 27 74 20 75 73 65 ;; We can't use
dfb0: 20 4c 45 54 2d 56 45 43 54 4f 52 2d 53 54 41 52 LET-VECTOR-STAR
dfc0: 54 2b 45 4e 44 2c 20 62 65 63 61 75 73 65 20 77 T+END, because w
dfd0: 65 27 72 65 20 75 73 69 6e 67 20 74 68 65 0a 20 e're using the.
dfe0: 20 20 20 20 20 20 20 20 20 3b 3b 20 62 6f 75 6e ;; boun
dff0: 64 73 20 6f 66 20 61 20 5f 6c 69 73 74 5f 2c 20 ds of a _list_,
e000: 6e 6f 74 20 61 20 76 65 63 74 6f 72 2e 0a 20 20 not a vector..
e010: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 2d 6f 70 (let*-op
e020: 74 69 6f 6e 61 6c 73 20 6d 61 79 62 65 2d 73 74 tionals maybe-st
e030: 61 72 74 2b 65 6e 64 0a 20 20 20 20 20 20 20 20 art+end.
e040: 20 20 20 20 20 20 28 28 73 74 61 72 74 20 30 29 ((start 0)
e050: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e060: 28 65 6e 64 20 28 6c 65 6e 67 74 68 20 6c 73 74 (end (length lst
e070: 29 29 29 20 20 20 20 20 20 3b 20 55 67 68 20 2d ))) ; Ugh -
e080: 2d 20 4c 45 4e 47 54 48 0a 20 20 20 20 20 20 20 - LENGTH.
e090: 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 61 72 (let ((star
e0a0: 74 20 28 63 68 65 63 6b 2d 74 79 70 65 20 6e 6f t (check-type no
e0b0: 6e 6e 65 67 2d 69 6e 74 3f 20 73 74 61 72 74 20 nneg-int? start
e0c0: 6c 69 73 74 2d 3e 76 65 63 74 6f 72 29 29 0a 20 list->vector)).
e0d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e0e0: 20 28 65 6e 64 20 20 20 28 63 68 65 63 6b 2d 74 (end (check-t
e0f0: 79 70 65 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 ype nonneg-int?
e100: 65 6e 64 20 20 20 6c 69 73 74 2d 3e 76 65 63 74 end list->vect
e110: 6f 72 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 or))).
e120: 20 20 20 20 28 28 6c 61 6d 62 64 61 20 28 66 29 ((lambda (f)
e130: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e140: 20 20 28 76 65 63 74 6f 72 2d 75 6e 66 6f 6c 64 (vector-unfold
e150: 20 66 20 28 2d 20 65 6e 64 20 73 74 61 72 74 29 f (- end start)
e160: 20 28 6c 69 73 74 2d 74 61 69 6c 20 6c 73 74 20 (list-tail lst
e170: 73 74 61 72 74 29 29 29 0a 20 20 20 20 20 20 20 start))).
e180: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
e190: 28 69 6e 64 65 78 20 6c 29 0a 20 20 20 20 20 20 (index l).
e1a0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond
e1b0: 20 28 28 6e 75 6c 6c 3f 20 6c 29 0a 20 20 20 20 ((null? l).
e1c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e1d0: 20 20 20 20 28 65 72 72 6f 72 20 22 6c 69 73 74 (error "list
e1e0: 20 77 61 73 20 74 6f 6f 20 73 68 6f 72 74 22 0a was too short".
e1f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 `
e210: 28 6c 69 73 74 20 77 61 73 20 2c 6c 73 74 29 0a (list was ,lst).
e220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 `
e240: 28 61 74 74 65 6d 70 74 65 64 20 65 6e 64 20 77 (attempted end w
e250: 61 73 20 2c 65 6e 64 29 0a 20 20 20 20 20 20 20 as ,end).
e260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e270: 20 20 20 20 20 20 20 20 60 28 77 68 69 6c 65 20 `(while
e280: 63 61 6c 6c 69 6e 67 20 2c 6c 69 73 74 2d 3e 76 calling ,list->v
e290: 65 63 74 6f 72 29 29 29 0a 20 20 20 20 20 20 20 ector))).
e2a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e2b0: 28 28 70 61 69 72 3f 20 6c 29 0a 20 20 20 20 20 ((pair? l).
e2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e2d0: 20 20 20 28 76 61 6c 75 65 73 20 28 63 61 72 20 (values (car
e2e0: 6c 29 20 28 63 64 72 20 6c 29 29 29 0a 20 20 20 l) (cdr l))).
e2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e300: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
e310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e320: 20 20 3b 3b 20 4d 61 6b 65 20 74 68 69 73 20 6c ;; Make this l
e330: 6f 6f 6b 20 61 73 20 6d 75 63 68 20 6c 69 6b 65 ook as much like
e340: 20 77 68 61 74 20 43 48 45 43 4b 2d 54 59 50 45 what CHECK-TYPE
e350: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e360: 20 20 20 20 20 20 20 20 20 3b 3b 20 77 6f 75 6c ;; woul
e370: 64 20 72 65 70 6f 72 74 20 61 73 20 70 6f 73 73 d report as poss
e380: 69 62 6c 65 2e 0a 20 20 20 20 20 20 20 20 20 20 ible..
e390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
e3a0: 72 72 6f 72 20 22 65 72 72 6f 6e 65 6f 75 73 20 rror "erroneous
e3b0: 76 61 6c 75 65 22 0a 20 20 20 20 20 20 20 20 20 value".
e3c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e3d0: 20 20 20 20 20 20 3b 3b 20 57 65 20 77 61 6e 74 ;; We want
e3e0: 20 53 52 46 49 20 31 27 73 20 50 52 4f 50 45 52 SRFI 1's PROPER
e3f0: 2d 4c 49 53 54 3f 2c 20 62 75 74 20 69 74 0a 20 -LIST?, but it.
e400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
e420: 20 77 6f 75 6c 64 20 62 65 20 61 20 77 61 73 74 would be a wast
e430: 65 20 74 6f 20 6c 69 6e 6b 20 61 6c 6c 20 6f 66 e to link all of
e440: 20 53 52 46 49 0a 20 20 20 20 20 20 20 20 20 20 SRFI.
e450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e460: 20 20 20 20 20 3b 3b 20 31 20 74 6f 20 74 68 69 ;; 1 to thi
e470: 73 20 6d 6f 64 75 6c 65 20 66 6f 72 20 6f 6e 6c s module for onl
e480: 79 20 74 68 65 20 73 69 6e 67 6c 65 0a 20 20 20 y the single.
e490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e4a0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 66 ;; f
e4b0: 75 6e 63 74 69 6f 6e 20 50 52 4f 50 45 52 2d 4c unction PROPER-L
e4c0: 49 53 54 3f 2e 0a 20 20 20 20 20 20 20 20 20 20 IST?..
e4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e4e0: 20 20 20 20 20 28 6c 69 73 74 20 6c 69 73 74 3f (list list?
e4f0: 20 6c 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 lst).
e500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e510: 20 20 20 20 20 60 28 77 68 69 6c 65 20 63 61 6c `(while cal
e520: 6c 69 6e 67 0a 20 20 20 20 20 20 20 20 20 20 20 ling.
e530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e540: 20 20 20 20 20 20 2c 6c 69 73 74 2d 3e 76 65 63 ,list->vec
e550: 74 6f 72 29 29 29 29 29 29 29 29 29 29 29 29 0a tor)))))))))))).
e560: 0a 3b 3b 3b 20 28 52 45 56 45 52 53 45 2d 4c 49 .;;; (REVERSE-LI
e570: 53 54 2d 3e 56 45 43 54 4f 52 20 3c 6c 69 73 74 ST->VECTOR <list
e580: 3e 20 5b 3c 73 74 61 72 74 3e 20 3c 65 6e 64 3e > [<start> <end>
e590: 5d 29 20 2d 3e 20 76 65 63 74 6f 72 0a 3b 3b 3b ]) -> vector.;;;
e5a0: 20 20 20 50 72 6f 64 75 63 65 20 61 20 76 65 63 Produce a vec
e5b0: 74 6f 72 20 63 6f 6e 74 61 69 6e 69 6e 67 20 74 tor containing t
e5c0: 68 65 20 65 6c 65 6d 65 6e 74 73 20 69 6e 20 4c he elements in L
e5d0: 49 53 54 2c 20 77 68 69 63 68 20 6d 75 73 74 20 IST, which must
e5e0: 62 65 20 61 0a 3b 3b 3b 20 20 20 70 72 6f 70 65 be a.;;; prope
e5f0: 72 20 6c 69 73 74 2c 20 62 65 74 77 65 65 6e 20 r list, between
e600: 53 54 41 52 54 2c 20 77 68 6f 73 65 20 64 65 66 START, whose def
e610: 61 75 6c 74 20 69 73 20 30 2c 20 61 6e 64 20 45 ault is 0, and E
e620: 4e 44 2c 20 77 68 6f 73 65 0a 3b 3b 3b 20 20 20 ND, whose.;;;
e630: 64 65 66 61 75 6c 74 20 69 73 20 74 68 65 20 6c default is the l
e640: 65 6e 67 74 68 20 6f 66 20 4c 49 53 54 2c 20 69 ength of LIST, i
e650: 6e 20 72 65 76 65 72 73 65 20 6f 72 64 65 72 2e n reverse order.
e660: 20 20 49 74 20 69 73 20 73 75 67 67 65 73 74 65 It is suggeste
e670: 64 0a 3b 3b 3b 20 20 20 74 68 61 74 20 69 66 20 d.;;; that if
e680: 74 68 65 20 6c 65 6e 67 74 68 20 6f 66 20 4c 49 the length of LI
e690: 53 54 20 69 73 20 6b 6e 6f 77 6e 20 69 6e 20 61 ST is known in a
e6a0: 64 76 61 6e 63 65 2c 20 74 68 65 20 53 54 41 52 dvance, the STAR
e6b0: 54 20 61 6e 64 20 45 4e 44 0a 3b 3b 3b 20 20 20 T and END.;;;
e6c0: 61 72 67 75 6d 65 6e 74 73 20 62 65 20 70 61 73 arguments be pas
e6d0: 73 65 64 2c 20 73 6f 20 74 68 61 74 20 52 45 56 sed, so that REV
e6e0: 45 52 53 45 2d 4c 49 53 54 2d 3e 56 45 43 54 4f ERSE-LIST->VECTO
e6f0: 52 20 6e 65 65 64 20 6e 6f 74 20 63 61 6c 6c 0a R need not call.
e700: 3b 3b 3b 20 20 20 4c 45 4e 47 54 48 20 74 6f 20 ;;; LENGTH to
e710: 64 65 74 65 72 6d 69 6e 65 20 74 68 65 20 74 68 determine the th
e720: 65 20 6c 65 6e 67 74 68 2e 0a 3b 3b 3b 0a 3b 3b e length..;;;.;;
e730: 3b 20 54 68 69 73 20 61 6c 73 6f 20 64 69 76 65 ; This also dive
e740: 72 67 65 73 20 6f 6e 20 63 69 72 63 75 6c 61 72 rges on circular
e750: 20 6c 69 73 74 73 20 75 6e 6c 65 73 73 2c 20 61 lists unless, a
e760: 67 61 69 6e 2c 20 4c 45 4e 47 54 48 20 72 65 74 gain, LENGTH ret
e770: 75 72 6e 73 0a 3b 3b 3b 20 73 6f 6d 65 74 68 69 urns.;;; somethi
e780: 6e 67 20 74 68 61 74 20 6d 61 6b 65 73 20 2d 20 ng that makes -
e790: 62 6f 72 6b 2e 0a 28 64 65 66 69 6e 65 20 28 72 bork..(define (r
e7a0: 65 76 65 72 73 65 2d 6c 69 73 74 2d 3e 76 65 63 everse-list->vec
e7b0: 74 6f 72 20 6c 73 74 20 2e 20 6d 61 79 62 65 2d tor lst . maybe-
e7c0: 73 74 61 72 74 2b 65 6e 64 29 0a 20 20 28 6c 65 start+end). (le
e7d0: 74 2a 2d 6f 70 74 69 6f 6e 61 6c 73 20 6d 61 79 t*-optionals may
e7e0: 62 65 2d 73 74 61 72 74 2b 65 6e 64 0a 20 20 20 be-start+end.
e7f0: 20 20 20 28 28 73 74 61 72 74 20 30 29 0a 20 20 ((start 0).
e800: 20 20 20 20 20 28 65 6e 64 20 28 6c 65 6e 67 74 (end (lengt
e810: 68 20 6c 73 74 29 29 29 20 20 20 20 20 20 20 20 h lst)))
e820: 20 20 20 20 20 20 3b 20 55 67 68 20 2d 2d 20 4c ; Ugh -- L
e830: 45 4e 47 54 48 0a 20 20 20 20 28 6c 65 74 20 28 ENGTH. (let (
e840: 28 73 74 61 72 74 20 28 63 68 65 63 6b 2d 74 79 (start (check-ty
e850: 70 65 20 6e 6f 6e 6e 65 67 2d 69 6e 74 3f 20 73 pe nonneg-int? s
e860: 74 61 72 74 20 72 65 76 65 72 73 65 2d 6c 69 73 tart reverse-lis
e870: 74 2d 3e 76 65 63 74 6f 72 29 29 0a 20 20 20 20 t->vector)).
e880: 20 20 20 20 20 20 28 65 6e 64 20 20 20 28 63 68 (end (ch
e890: 65 63 6b 2d 74 79 70 65 20 6e 6f 6e 6e 65 67 2d eck-type nonneg-
e8a0: 69 6e 74 3f 20 65 6e 64 20 20 20 72 65 76 65 72 int? end rever
e8b0: 73 65 2d 6c 69 73 74 2d 3e 76 65 63 74 6f 72 29 se-list->vector)
e8c0: 29 29 0a 20 20 20 20 20 20 28 28 6c 61 6d 62 64 )). ((lambd
e8d0: 61 20 28 66 29 0a 20 20 20 20 20 20 20 20 20 28 a (f). (
e8e0: 76 65 63 74 6f 72 2d 75 6e 66 6f 6c 64 2d 72 69 vector-unfold-ri
e8f0: 67 68 74 20 66 20 28 2d 20 65 6e 64 20 73 74 61 ght f (- end sta
e900: 72 74 29 20 28 6c 69 73 74 2d 74 61 69 6c 20 6c rt) (list-tail l
e910: 73 74 20 73 74 61 72 74 29 29 29 0a 20 20 20 20 st start))).
e920: 20 20 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 65 (lambda (inde
e930: 78 20 6c 29 0a 20 20 20 20 20 20 20 20 20 28 63 x l). (c
e940: 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 6c 29 0a 20 ond ((null? l).
e950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
e960: 65 72 72 6f 72 20 22 6c 69 73 74 20 74 6f 6f 20 error "list too
e970: 73 68 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 short".
e980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
e990: 6c 69 73 74 20 77 61 73 20 2c 6c 73 74 29 0a 20 list was ,lst).
e9a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e9b0: 20 20 20 20 20 20 60 28 61 74 74 65 6d 70 74 65 `(attempte
e9c0: 64 20 65 6e 64 20 77 61 73 20 2c 65 6e 64 29 0a d end was ,end).
e9d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e9e0: 20 20 20 20 20 20 20 60 28 77 68 69 6c 65 20 63 `(while c
e9f0: 61 6c 6c 69 6e 67 20 2c 72 65 76 65 72 73 65 2d alling ,reverse-
ea00: 6c 69 73 74 2d 3e 76 65 63 74 6f 72 29 29 29 0a list->vector))).
ea10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
ea20: 28 70 61 69 72 3f 20 6c 29 0a 20 20 20 20 20 20 (pair? l).
ea30: 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 (value
ea40: 73 20 28 63 61 72 20 6c 29 20 28 63 64 72 20 6c s (car l) (cdr l
ea50: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
ea60: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
ea70: 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 (error
ea80: 22 65 72 72 6f 6e 65 6f 75 73 20 76 61 6c 75 65 "erroneous value
ea90: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
eaa0: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 6c (list l
eab0: 69 73 74 3f 20 6c 73 74 29 0a 20 20 20 20 20 20 ist? lst).
eac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ead0: 20 60 28 77 68 69 6c 65 20 63 61 6c 6c 69 6e 67 `(while calling
eae0: 20 2c 72 65 76 65 72 73 65 2d 6c 69 73 74 2d 3e ,reverse-list->
eaf0: 76 65 63 74 6f 72 29 29 29 29 29 29 29 29 29 0a vector))))))))).
eb00: 0a 3b 3b 20 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b .;; ;;;;;;;;;;;;
eb10: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
eb20: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
eb30: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
eb40: 3b 3b 3b 3b 3b 3b 3b 0a 0a 29 0a ;;;;;;;..).