Artifact
023755add907a077d00d7e74c16ef7784d165616:
0000: 23 21 72 36 72 73 0a 3b 3b 20 53 52 46 49 20 31 #!r6rs.;; SRFI 1
0010: 30 31 3a 20 50 75 72 65 6c 79 20 46 75 6e 63 74 01: Purely Funct
0020: 69 6f 6e 61 6c 20 52 61 6e 64 6f 6d 2d 41 63 63 ional Random-Acc
0030: 65 73 73 20 50 61 69 72 73 20 61 6e 64 20 4c 69 ess Pairs and Li
0040: 73 74 73 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 sts.;; Copyright
0050: 20 28 63 29 20 44 61 76 69 64 20 56 61 6e 20 48 (c) David Van H
0060: 6f 72 6e 20 32 30 30 39 2e 20 20 41 6c 6c 20 52 orn 2009. All R
0070: 69 67 68 74 73 20 52 65 73 65 72 76 65 64 2e 0a ights Reserved..
0080: 0a 3b 3b 20 50 65 72 6d 69 73 73 69 6f 6e 20 69 .;; Permission i
0090: 73 20 68 65 72 65 62 79 20 67 72 61 6e 74 65 64 s hereby granted
00a0: 2c 20 66 72 65 65 20 6f 66 20 63 68 61 72 67 65 , free of charge
00b0: 2c 20 74 6f 20 61 6e 79 20 70 65 72 73 6f 6e 20 , to any person
00c0: 6f 62 74 61 69 6e 69 6e 67 0a 3b 3b 20 61 20 63 obtaining.;; a c
00d0: 6f 70 79 20 6f 66 20 74 68 69 73 20 73 6f 66 74 opy of this soft
00e0: 77 61 72 65 20 61 6e 64 20 61 73 73 6f 63 69 61 ware and associa
00f0: 74 65 64 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f ted documentatio
0100: 6e 0a 3b 3b 20 66 69 6c 65 73 20 28 74 68 65 20 n.;; files (the
0110: 22 53 6f 66 74 77 61 72 65 22 29 2c 20 74 6f 20 "Software"), to
0120: 64 65 61 6c 20 69 6e 20 74 68 65 20 53 6f 66 74 deal in the Soft
0130: 77 61 72 65 20 77 69 74 68 6f 75 74 20 72 65 73 ware without res
0140: 74 72 69 63 74 69 6f 6e 2c 0a 3b 3b 20 69 6e 63 triction,.;; inc
0150: 6c 75 64 69 6e 67 20 77 69 74 68 6f 75 74 20 6c luding without l
0160: 69 6d 69 74 61 74 69 6f 6e 20 74 68 65 20 72 69 imitation the ri
0170: 67 68 74 73 20 74 6f 20 75 73 65 2c 20 63 6f 70 ghts to use, cop
0180: 79 2c 20 6d 6f 64 69 66 79 2c 20 6d 65 72 67 65 y, modify, merge
0190: 2c 0a 3b 3b 20 70 75 62 6c 69 73 68 2c 20 64 69 ,.;; publish, di
01a0: 73 74 72 69 62 75 74 65 2c 20 73 75 62 6c 69 63 stribute, sublic
01b0: 65 6e 73 65 2c 20 61 6e 64 2f 6f 72 20 73 65 6c ense, and/or sel
01c0: 6c 20 63 6f 70 69 65 73 20 6f 66 20 74 68 65 20 l copies of the
01d0: 53 6f 66 74 77 61 72 65 2c 0a 3b 3b 20 61 6e 64 Software,.;; and
01e0: 20 74 6f 20 70 65 72 6d 69 74 20 70 65 72 73 6f to permit perso
01f0: 6e 73 20 74 6f 20 77 68 6f 6d 20 74 68 65 20 53 ns to whom the S
0200: 6f 66 74 77 61 72 65 20 69 73 20 66 75 72 6e 69 oftware is furni
0210: 73 68 65 64 20 74 6f 20 64 6f 20 73 6f 2c 0a 3b shed to do so,.;
0220: 3b 20 73 75 62 6a 65 63 74 20 74 6f 20 74 68 65 ; subject to the
0230: 20 66 6f 6c 6c 6f 77 69 6e 67 20 63 6f 6e 64 69 following condi
0240: 74 69 6f 6e 73 3a 0a 0a 3b 3b 20 54 68 65 20 61 tions:..;; The a
0250: 62 6f 76 65 20 63 6f 70 79 72 69 67 68 74 20 6e bove copyright n
0260: 6f 74 69 63 65 20 61 6e 64 20 74 68 69 73 20 70 otice and this p
0270: 65 72 6d 69 73 73 69 6f 6e 20 6e 6f 74 69 63 65 ermission notice
0280: 20 73 68 61 6c 6c 20 62 65 0a 3b 3b 20 69 6e 63 shall be.;; inc
0290: 6c 75 64 65 64 20 69 6e 20 61 6c 6c 20 63 6f 70 luded in all cop
02a0: 69 65 73 20 6f 72 20 73 75 62 73 74 61 6e 74 69 ies or substanti
02b0: 61 6c 20 70 6f 72 74 69 6f 6e 73 20 6f 66 20 74 al portions of t
02c0: 68 65 20 53 6f 66 74 77 61 72 65 2e 0a 0a 3b 3b he Software...;;
02d0: 20 54 48 45 20 53 4f 46 54 57 41 52 45 20 49 53 THE SOFTWARE IS
02e0: 20 50 52 4f 56 49 44 45 44 20 22 41 53 20 49 53 PROVIDED "AS IS
02f0: 22 2c 20 57 49 54 48 4f 55 54 20 57 41 52 52 41 ", WITHOUT WARRA
0300: 4e 54 59 20 4f 46 20 41 4e 59 20 4b 49 4e 44 2c NTY OF ANY KIND,
0310: 0a 3b 3b 20 45 58 50 52 45 53 53 20 4f 52 20 49 .;; EXPRESS OR I
0320: 4d 50 4c 49 45 44 2c 20 49 4e 43 4c 55 44 49 4e MPLIED, INCLUDIN
0330: 47 20 42 55 54 20 4e 4f 54 20 4c 49 4d 49 54 45 G BUT NOT LIMITE
0340: 44 20 54 4f 20 54 48 45 20 57 41 52 52 41 4e 54 D TO THE WARRANT
0350: 49 45 53 20 4f 46 0a 3b 3b 20 4d 45 52 43 48 41 IES OF.;; MERCHA
0360: 4e 54 41 42 49 4c 49 54 59 2c 20 46 49 54 4e 45 NTABILITY, FITNE
0370: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0380: 4c 41 52 20 50 55 52 50 4f 53 45 20 41 4e 44 0a LAR PURPOSE AND.
0390: 3b 3b 20 4e 4f 4e 49 4e 46 52 49 4e 47 45 4d 45 ;; NONINFRINGEME
03a0: 4e 54 2e 20 52 45 4d 45 4d 42 45 52 2c 20 54 48 NT. REMEMBER, TH
03b0: 45 52 45 20 49 53 20 4e 4f 20 53 43 48 45 4d 45 ERE IS NO SCHEME
03c0: 20 55 4e 44 45 52 47 52 4f 55 4e 44 2e 20 49 4e UNDERGROUND. IN
03d0: 20 4e 4f 20 45 56 45 4e 54 0a 3b 3b 20 53 48 41 NO EVENT.;; SHA
03e0: 4c 4c 20 54 48 45 20 41 55 54 48 4f 52 53 20 4f LL THE AUTHORS O
03f0: 52 20 43 4f 50 59 52 49 47 48 54 20 48 4f 4c 44 R COPYRIGHT HOLD
0400: 45 52 53 20 42 45 20 4c 49 41 42 4c 45 20 46 4f ERS BE LIABLE FO
0410: 52 20 41 4e 59 20 43 4c 41 49 4d 2c 0a 3b 3b 20 R ANY CLAIM,.;;
0420: 44 41 4d 41 47 45 53 20 4f 52 20 4f 54 48 45 52 DAMAGES OR OTHER
0430: 20 4c 49 41 42 49 4c 49 54 59 2c 20 57 48 45 54 LIABILITY, WHET
0440: 48 45 52 20 49 4e 20 41 4e 20 41 43 54 49 4f 4e HER IN AN ACTION
0450: 20 4f 46 20 43 4f 4e 54 52 41 43 54 2c 20 54 4f OF CONTRACT, TO
0460: 52 54 20 4f 52 0a 3b 3b 20 4f 54 48 45 52 57 49 RT OR.;; OTHERWI
0470: 53 45 2c 20 41 52 49 53 49 4e 47 20 46 52 4f 4d SE, ARISING FROM
0480: 2c 20 4f 55 54 20 4f 46 20 4f 52 20 49 4e 20 43 , OUT OF OR IN C
0490: 4f 4e 4e 45 43 54 49 4f 4e 20 57 49 54 48 20 54 ONNECTION WITH T
04a0: 48 45 20 53 4f 46 54 57 41 52 45 20 4f 52 0a 3b HE SOFTWARE OR.;
04b0: 3b 20 54 48 45 20 55 53 45 20 4f 52 20 4f 54 48 ; THE USE OR OTH
04c0: 45 52 20 44 45 41 4c 49 4e 47 53 20 49 4e 20 54 ER DEALINGS IN T
04d0: 48 45 20 53 4f 46 54 57 41 52 45 2e 0a 0a 28 6c HE SOFTWARE...(l
04e0: 69 62 72 61 72 79 20 28 73 72 66 69 20 73 31 30 ibrary (srfi s10
04f0: 31 20 72 61 6e 64 6f 6d 2d 61 63 63 65 73 73 2d 1 random-access-
0500: 6c 69 73 74 73 29 0a 20 20 28 65 78 70 6f 72 74 lists). (export
0510: 20 28 72 65 6e 61 6d 65 20 28 72 61 3a 71 75 6f (rename (ra:quo
0520: 74 65 20 71 75 6f 74 65 29 0a 20 20 20 20 20 20 te quote).
0530: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 61 3a (ra:
0540: 70 61 69 72 3f 20 70 61 69 72 3f 29 20 0a 20 20 pair? pair?) .
0550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0560: 28 72 61 3a 63 6f 6e 73 20 63 6f 6e 73 29 0a 20 (ra:cons cons).
0570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0580: 20 28 72 61 3a 63 61 72 20 63 61 72 29 20 0a 20 (ra:car car) .
0590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05a0: 20 28 72 61 3a 63 64 72 20 63 64 72 29 0a 20 20 (ra:cdr cdr).
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05c0: 28 72 61 3a 63 61 61 72 20 63 61 61 72 29 20 0a (ra:caar caar) .
05d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05e0: 20 20 28 72 61 3a 63 61 64 72 20 63 61 64 72 29 (ra:cadr cadr)
05f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0600: 20 20 20 28 72 61 3a 63 64 64 72 20 63 64 64 72 (ra:cddr cddr
0610: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0620: 20 20 20 20 28 72 61 3a 63 64 61 72 20 63 64 61 (ra:cdar cda
0630: 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r).
0640: 20 20 20 20 20 28 72 61 3a 63 61 61 61 72 20 63 (ra:caaar c
0650: 61 61 61 72 29 0a 20 20 20 20 20 20 20 20 20 20 aaar).
0660: 20 20 20 20 20 20 20 20 28 72 61 3a 63 61 61 64 (ra:caad
0670: 72 20 63 61 61 64 72 29 0a 20 20 20 20 20 20 20 r caadr).
0680: 20 20 20 20 20 20 20 20 20 20 20 28 72 61 3a 63 (ra:c
0690: 61 64 64 72 20 63 61 64 64 72 29 0a 20 20 20 20 addr caddr).
06a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
06b0: 61 3a 63 61 64 61 72 20 63 61 64 61 72 29 0a 20 a:cadar cadar).
06c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06d0: 20 28 72 61 3a 63 64 61 61 72 20 63 64 61 61 72 (ra:cdaar cdaar
06e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
06f0: 20 20 20 20 28 72 61 3a 63 64 61 64 72 20 63 64 (ra:cdadr cd
0700: 61 64 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 adr).
0710: 20 20 20 20 20 20 20 28 72 61 3a 63 64 64 64 72 (ra:cdddr
0720: 20 63 64 64 64 72 29 0a 20 20 20 20 20 20 20 20 cdddr).
0730: 20 20 20 20 20 20 20 20 20 20 28 72 61 3a 63 64 (ra:cd
0740: 64 61 72 20 63 64 64 61 72 29 0a 20 20 20 20 20 dar cddar).
0750: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 61 (ra
0760: 3a 63 61 61 61 61 72 20 63 61 61 61 61 72 29 0a :caaaar caaaar).
0770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0780: 20 20 28 72 61 3a 63 61 61 61 64 72 20 63 61 61 (ra:caaadr caa
0790: 61 64 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 adr).
07a0: 20 20 20 20 20 20 20 28 72 61 3a 63 61 61 64 64 (ra:caadd
07b0: 72 20 63 61 61 64 64 72 29 0a 20 20 20 20 20 20 r caaddr).
07c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 61 3a (ra:
07d0: 63 61 61 64 61 72 20 63 61 61 64 61 72 29 0a 20 caadar caadar).
07e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07f0: 20 28 72 61 3a 63 61 64 61 61 72 20 63 61 64 61 (ra:cadaar cada
0800: 61 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ar).
0810: 20 20 20 20 20 20 28 72 61 3a 63 61 64 61 64 72 (ra:cadadr
0820: 20 63 61 64 61 64 72 29 0a 20 20 20 20 20 20 20 cadadr).
0830: 20 20 20 20 20 20 20 20 20 20 20 28 72 61 3a 63 (ra:c
0840: 61 64 64 64 72 20 63 61 64 64 64 72 29 0a 20 20 adddr cadddr).
0850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0860: 28 72 61 3a 63 61 64 64 61 72 20 63 61 64 64 61 (ra:caddar cadda
0870: 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r).
0880: 20 20 20 20 20 28 72 61 3a 63 64 61 61 61 72 20 (ra:cdaaar
0890: 63 64 61 61 61 72 29 0a 20 20 20 20 20 20 20 20 cdaaar).
08a0: 20 20 20 20 20 20 20 20 20 20 28 72 61 3a 63 64 (ra:cd
08b0: 61 61 64 72 20 63 64 61 61 64 72 29 0a 20 20 20 aadr cdaadr).
08c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
08d0: 72 61 3a 63 64 61 64 64 72 20 63 64 61 64 64 72 ra:cdaddr cdaddr
08e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
08f0: 20 20 20 20 28 72 61 3a 63 64 61 64 61 72 20 63 (ra:cdadar c
0900: 64 61 64 61 72 29 0a 20 20 20 20 20 20 20 20 20 dadar).
0910: 20 20 20 20 20 20 20 20 20 28 72 61 3a 63 64 64 (ra:cdd
0920: 61 61 72 20 63 64 64 61 61 72 29 0a 20 20 20 20 aar cddaar).
0930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
0940: 61 3a 63 64 64 61 64 72 20 63 64 64 61 64 72 29 a:cddadr cddadr)
0950: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0960: 20 20 20 28 72 61 3a 63 64 64 64 64 72 20 63 64 (ra:cddddr cd
0970: 64 64 64 72 29 0a 20 20 20 20 20 20 20 20 20 20 dddr).
0980: 20 20 20 20 20 20 20 20 28 72 61 3a 63 64 64 64 (ra:cddd
0990: 61 72 20 63 64 64 64 61 72 29 0a 20 20 20 20 20 ar cdddar).
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 61 (ra
09b0: 3a 6e 75 6c 6c 3f 20 6e 75 6c 6c 3f 29 0a 20 20 :null? null?).
09c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09d0: 28 72 61 3a 6c 69 73 74 3f 20 6c 69 73 74 3f 29 (ra:list? list?)
09e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
09f0: 20 20 20 28 72 61 3a 6c 69 73 74 20 6c 69 73 74 (ra:list list
0a00: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0a10: 20 20 20 20 28 72 61 3a 6d 61 6b 65 2d 6c 69 73 (ra:make-lis
0a20: 74 20 6d 61 6b 65 2d 6c 69 73 74 29 0a 20 20 20 t make-list).
0a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
0a40: 72 61 3a 6c 65 6e 67 74 68 20 6c 65 6e 67 74 68 ra:length length
0a50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0a60: 20 20 20 20 28 72 61 3a 61 70 70 65 6e 64 20 61 (ra:append a
0a70: 70 70 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 ppend).
0a80: 20 20 20 20 20 20 20 20 20 28 72 61 3a 72 65 76 (ra:rev
0a90: 65 72 73 65 20 72 65 76 65 72 73 65 29 0a 20 20 erse reverse).
0aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ab0: 28 72 61 3a 6c 69 73 74 2d 74 61 69 6c 20 6c 69 (ra:list-tail li
0ac0: 73 74 2d 74 61 69 6c 29 0a 20 20 20 20 20 20 20 st-tail).
0ad0: 20 20 20 20 20 20 20 20 20 20 20 28 72 61 3a 6c (ra:l
0ae0: 69 73 74 2d 72 65 66 20 6c 69 73 74 2d 72 65 66 ist-ref list-ref
0af0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0b00: 20 20 20 20 28 72 61 3a 6c 69 73 74 2d 73 65 74 (ra:list-set
0b10: 20 6c 69 73 74 2d 73 65 74 29 0a 20 20 20 20 20 list-set).
0b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 61 (ra
0b30: 3a 6c 69 73 74 2d 72 65 66 2f 75 70 64 61 74 65 :list-ref/update
0b40: 20 6c 69 73 74 2d 72 65 66 2f 75 70 64 61 74 65 list-ref/update
0b50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0b60: 20 20 20 20 28 72 61 3a 6d 61 70 20 6d 61 70 29 (ra:map map)
0b70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0b80: 20 20 20 28 72 61 3a 66 6f 72 2d 65 61 63 68 20 (ra:for-each
0b90: 66 6f 72 2d 65 61 63 68 29 0a 20 20 20 20 20 20 for-each).
0ba0: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 61 3a (ra:
0bb0: 72 61 6e 64 6f 6d 2d 61 63 63 65 73 73 2d 6c 69 random-access-li
0bc0: 73 74 2d 3e 6c 69 6e 65 61 72 2d 61 63 63 65 73 st->linear-acces
0bd0: 73 2d 6c 69 73 74 0a 20 20 20 20 20 20 20 20 20 s-list.
0be0: 20 20 20 20 20 20 20 20 20 20 72 61 6e 64 6f 6d random
0bf0: 2d 61 63 63 65 73 73 2d 6c 69 73 74 2d 3e 6c 69 -access-list->li
0c00: 6e 65 61 72 2d 61 63 63 65 73 73 2d 6c 69 73 74 near-access-list
0c10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0c20: 20 20 20 20 28 72 61 3a 6c 69 6e 65 61 72 2d 61 (ra:linear-a
0c30: 63 63 65 73 73 2d 6c 69 73 74 2d 3e 72 61 6e 64 ccess-list->rand
0c40: 6f 6d 2d 61 63 63 65 73 73 2d 6c 69 73 74 0a 20 om-access-list.
0c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c60: 20 20 6c 69 6e 65 61 72 2d 61 63 63 65 73 73 2d linear-access-
0c70: 6c 69 73 74 2d 3e 72 61 6e 64 6f 6d 2d 61 63 63 list->random-acc
0c80: 65 73 73 2d 6c 69 73 74 29 29 29 0a 20 20 0a 20 ess-list))). .
0c90: 20 28 69 6d 70 6f 72 74 20 28 72 6e 72 73 20 62 (import (rnrs b
0ca0: 61 73 65 29 0a 20 20 20 20 20 20 20 20 20 20 28 ase). (
0cb0: 72 6e 72 73 20 6c 69 73 74 73 29 0a 20 20 20 20 rnrs lists).
0cc0: 20 20 20 20 20 20 28 72 6e 72 73 20 63 6f 6e 74 (rnrs cont
0cd0: 72 6f 6c 29 0a 20 20 20 20 20 20 20 20 20 20 28 rol). (
0ce0: 72 6e 72 73 20 68 61 73 68 74 61 62 6c 65 73 29 rnrs hashtables)
0cf0: 0a 20 20 20 20 20 20 20 20 20 20 28 72 6e 72 73 . (rnrs
0d00: 20 72 65 63 6f 72 64 73 20 73 79 6e 74 61 63 74 records syntact
0d10: 69 63 29 0a 20 20 20 20 20 20 20 20 20 20 28 72 ic). (r
0d20: 6e 72 73 20 61 72 69 74 68 6d 65 74 69 63 20 62 nrs arithmetic b
0d30: 69 74 77 69 73 65 29 29 20 20 20 20 20 20 20 20 itwise))
0d40: 20 20 0a 20 20 0a 20 20 28 64 65 66 69 6e 65 2d . . (define-
0d50: 72 65 63 6f 72 64 2d 74 79 70 65 20 6b 6f 6e 73 record-type kons
0d60: 20 28 66 69 65 6c 64 73 20 73 69 7a 65 20 74 72 (fields size tr
0d70: 65 65 20 72 65 73 74 29 29 0a 20 20 28 64 65 66 ee rest)). (def
0d80: 69 6e 65 2d 72 65 63 6f 72 64 2d 74 79 70 65 20 ine-record-type
0d90: 6e 6f 64 65 20 28 66 69 65 6c 64 73 20 76 61 6c node (fields val
0da0: 20 6c 65 66 74 20 72 69 67 68 74 29 29 20 0a 0a left right)) ..
0db0: 20 20 3b 3b 20 4e 61 74 20 2d 3e 20 4e 61 74 0a ;; Nat -> Nat.
0dc0: 20 20 28 64 65 66 69 6e 65 20 28 73 75 62 31 20 (define (sub1
0dd0: 6e 29 20 28 2d 20 6e 20 31 29 29 0a 20 20 28 64 n) (- n 1)). (d
0de0: 65 66 69 6e 65 20 28 61 64 64 31 20 6e 29 20 28 efine (add1 n) (
0df0: 2b 20 6e 20 31 29 29 0a 20 20 20 20 0a 20 20 3b + n 1)). . ;
0e00: 3b 20 5b 54 72 65 65 20 58 5d 20 2d 3e 20 58 0a ; [Tree X] -> X.
0e10: 20 20 28 64 65 66 69 6e 65 20 28 74 72 65 65 2d (define (tree-
0e20: 76 61 6c 20 74 29 0a 20 20 20 20 28 69 66 20 28 val t). (if (
0e30: 6e 6f 64 65 3f 20 74 29 20 0a 20 20 20 20 20 20 node? t) .
0e40: 20 20 28 6e 6f 64 65 2d 76 61 6c 20 74 29 0a 20 (node-val t).
0e50: 20 20 20 20 20 20 20 74 29 29 0a 20 20 0a 20 20 t)). .
0e60: 3b 3b 20 5b 58 20 2d 3e 20 59 5d 20 5b 54 72 65 ;; [X -> Y] [Tre
0e70: 65 20 58 5d 20 2d 3e 20 5b 54 72 65 65 20 59 5d e X] -> [Tree Y]
0e80: 0a 20 20 28 64 65 66 69 6e 65 20 28 74 72 65 65 . (define (tree
0e90: 2d 6d 61 70 20 66 20 74 29 0a 20 20 20 20 28 69 -map f t). (i
0ea0: 66 20 28 6e 6f 64 65 3f 20 74 29 0a 20 20 20 20 f (node? t).
0eb0: 20 20 20 20 28 6d 61 6b 65 2d 6e 6f 64 65 20 28 (make-node (
0ec0: 66 20 28 6e 6f 64 65 2d 76 61 6c 20 74 29 29 0a f (node-val t)).
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ee0: 20 20 20 28 74 72 65 65 2d 6d 61 70 20 66 20 28 (tree-map f (
0ef0: 6e 6f 64 65 2d 6c 65 66 74 20 74 29 29 0a 20 20 node-left t)).
0f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f10: 20 28 74 72 65 65 2d 6d 61 70 20 66 20 28 6e 6f (tree-map f (no
0f20: 64 65 2d 72 69 67 68 74 20 74 29 29 29 0a 20 20 de-right t))).
0f30: 20 20 20 20 20 20 28 66 20 74 29 29 29 0a 0a 20 (f t)))..
0f40: 20 3b 3b 20 5b 58 20 2d 3e 20 59 5d 20 5b 54 72 ;; [X -> Y] [Tr
0f50: 65 65 20 58 5d 20 2d 3e 20 75 6e 73 70 65 63 69 ee X] -> unspeci
0f60: 66 69 65 64 0a 20 20 28 64 65 66 69 6e 65 20 28 fied. (define (
0f70: 74 72 65 65 2d 66 6f 72 2d 65 61 63 68 20 66 20 tree-for-each f
0f80: 74 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 64 65 t). (if (node
0f90: 3f 20 74 29 0a 20 20 20 20 20 20 20 20 28 62 65 ? t). (be
0fa0: 67 69 6e 20 28 66 20 28 6e 6f 64 65 2d 76 61 6c gin (f (node-val
0fb0: 20 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t)).
0fc0: 20 20 20 20 28 74 72 65 65 2d 66 6f 72 2d 65 61 (tree-for-ea
0fd0: 63 68 20 66 20 28 6e 6f 64 65 2d 6c 65 66 74 20 ch f (node-left
0fe0: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
0ff0: 20 20 20 28 74 72 65 65 2d 66 6f 72 2d 65 61 63 (tree-for-eac
1000: 68 20 66 20 28 6e 6f 64 65 2d 72 69 67 68 74 20 h f (node-right
1010: 74 29 29 29 0a 20 20 20 20 20 20 20 20 28 66 20 t))). (f
1020: 74 29 29 29 0a 0a 20 20 3b 3b 20 5b 58 20 59 20 t))).. ;; [X Y
1030: 5a 20 2e 2e 2e 20 2d 3e 20 52 5d 20 5b 4c 69 73 Z ... -> R] [Lis
1040: 74 20 5b 54 72 65 65 20 58 5d 20 5b 54 72 65 65 t [Tree X] [Tree
1050: 20 59 5d 20 5b 54 72 65 65 20 5a 5d 20 2e 2e 2e Y] [Tree Z] ...
1060: 5d 20 2d 3e 20 5b 54 72 65 65 20 52 5d 0a 20 20 ] -> [Tree R].
1070: 28 64 65 66 69 6e 65 20 28 74 72 65 65 2d 6d 61 (define (tree-ma
1080: 70 2f 6e 20 66 20 74 73 29 0a 20 20 20 20 28 6c p/n f ts). (l
1090: 65 74 20 72 65 63 72 20 28 28 74 73 20 74 73 29 et recr ((ts ts)
10a0: 29 0a 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 ). (if (and
10b0: 20 28 70 61 69 72 3f 20 74 73 29 0a 20 20 20 20 (pair? ts).
10c0: 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 64 65 (node
10d0: 3f 20 28 63 61 72 20 74 73 29 29 29 0a 20 20 20 ? (car ts))).
10e0: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 6e 6f 64 (make-nod
10f0: 65 20 28 61 70 70 6c 79 20 66 20 28 6d 61 70 20 e (apply f (map
1100: 6e 6f 64 65 2d 76 61 6c 20 74 73 29 29 0a 20 20 node-val ts)).
1110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1120: 20 20 20 28 72 65 63 72 20 28 6d 61 70 20 6e 6f (recr (map no
1130: 64 65 2d 6c 65 66 74 20 74 73 29 29 0a 20 20 20 de-left ts)).
1140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1150: 20 20 28 72 65 63 72 20 28 6d 61 70 20 6e 6f 64 (recr (map nod
1160: 65 2d 72 69 67 68 74 20 74 73 29 29 29 0a 20 20 e-right ts))).
1170: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 66 (apply f
1180: 20 74 73 29 29 29 29 0a 20 20 0a 20 20 3b 3b 20 ts)))). . ;;
1190: 5b 58 20 59 20 5a 20 2e 2e 2e 20 2d 3e 20 52 5d [X Y Z ... -> R]
11a0: 20 5b 4c 69 73 74 20 5b 54 72 65 65 20 58 5d 20 [List [Tree X]
11b0: 5b 54 72 65 65 20 59 5d 20 5b 54 72 65 65 20 5a [Tree Y] [Tree Z
11c0: 5d 20 2e 2e 2e 5d 20 2d 3e 20 75 6e 73 70 65 63 ] ...] -> unspec
11d0: 69 66 69 65 64 0a 20 20 28 64 65 66 69 6e 65 20 ified. (define
11e0: 28 74 72 65 65 2d 66 6f 72 2d 65 61 63 68 2f 6e (tree-for-each/n
11f0: 20 66 20 74 73 29 0a 20 20 20 20 28 6c 65 74 20 f ts). (let
1200: 72 65 63 72 20 28 28 74 73 20 74 73 29 29 0a 20 recr ((ts ts)).
1210: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 70 (if (and (p
1220: 61 69 72 3f 20 74 73 29 0a 20 20 20 20 20 20 20 air? ts).
1230: 20 20 20 20 20 20 20 20 28 6e 6f 64 65 3f 20 28 (node? (
1240: 63 61 72 20 74 73 29 29 29 0a 20 20 20 20 20 20 car ts))).
1250: 20 20 20 20 28 62 65 67 69 6e 20 28 61 70 70 6c (begin (appl
1260: 79 20 66 20 28 6d 61 70 20 6e 6f 64 65 2d 76 61 y f (map node-va
1270: 6c 20 74 73 29 29 0a 20 20 20 20 20 20 20 20 20 l ts)).
1280: 20 20 20 20 20 20 20 20 28 72 65 63 72 20 28 6d (recr (m
1290: 61 70 20 6e 6f 64 65 2d 6c 65 66 74 20 74 73 29 ap node-left ts)
12a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12b0: 20 20 20 28 72 65 63 72 20 28 6d 61 70 20 6e 6f (recr (map no
12c0: 64 65 2d 72 69 67 68 74 20 74 73 29 29 29 0a 20 de-right ts))).
12d0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
12e0: 66 20 74 73 29 29 29 29 0a 20 20 0a 20 20 3b 3b f ts)))). . ;;
12f0: 20 4e 61 74 20 5b 4e 61 74 20 2d 3e 20 58 5d 20 Nat [Nat -> X]
1300: 2d 3e 20 5b 54 72 65 65 20 58 5d 0a 20 20 3b 3b -> [Tree X]. ;;
1310: 20 6c 69 6b 65 20 62 75 69 6c 64 2d 6c 69 73 74 like build-list
1320: 2c 20 62 75 74 20 66 6f 72 20 63 6f 6d 70 6c 65 , but for comple
1330: 74 65 20 62 69 6e 61 72 79 20 74 72 65 65 73 0a te binary trees.
1340: 20 20 28 64 65 66 69 6e 65 20 28 62 75 69 6c 64 (define (build
1350: 2d 74 72 65 65 20 69 20 66 29 20 3b 3b 20 69 20 -tree i f) ;; i
1360: 3d 20 32 5e 6a 2d 31 0a 20 20 20 20 28 6c 65 74 = 2^j-1. (let
1370: 20 72 65 63 20 28 28 69 20 69 29 20 28 6f 20 30 rec ((i i) (o 0
1380: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 3d 20 )). (if (=
1390: 31 20 69 29 20 0a 20 20 20 20 20 20 20 20 20 20 1 i) .
13a0: 28 66 20 6f 29 0a 20 20 20 20 20 20 20 20 20 20 (f o).
13b0: 28 6c 65 74 20 28 28 69 2f 32 20 28 68 61 6c 66 (let ((i/2 (half
13c0: 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 i))).
13d0: 20 20 28 6d 61 6b 65 2d 6e 6f 64 65 20 28 66 20 (make-node (f
13e0: 6f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 o).
13f0: 20 20 20 20 20 20 20 20 20 20 28 72 65 63 20 69 (rec i
1400: 2f 32 20 28 61 64 64 31 20 6f 29 29 0a 20 20 20 /2 (add1 o)).
1410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1420: 20 20 20 20 28 72 65 63 20 69 2f 32 20 28 2b 20 (rec i/2 (+
1430: 31 20 6f 20 69 2f 32 29 29 29 29 29 29 29 0a 20 1 o i/2))))))).
1440: 20 0a 20 20 3b 3b 20 43 6f 6e 73 75 6d 65 73 20 . ;; Consumes
1450: 6e 20 3d 20 32 5e 69 2d 31 20 61 6e 64 20 70 72 n = 2^i-1 and pr
1460: 6f 64 75 63 65 73 20 32 5e 28 69 2d 31 29 2d 31 oduces 2^(i-1)-1
1470: 2e 0a 20 20 3b 3b 20 4e 61 74 20 2d 3e 20 4e 61 .. ;; Nat -> Na
1480: 74 0a 20 20 28 64 65 66 69 6e 65 20 28 68 61 6c t. (define (hal
1490: 66 20 6e 29 0a 20 20 20 20 28 62 69 74 77 69 73 f n). (bitwis
14a0: 65 2d 61 72 69 74 68 6d 65 74 69 63 2d 73 68 69 e-arithmetic-shi
14b0: 66 74 20 6e 20 2d 31 29 29 0a 0a 20 20 3b 3b 20 ft n -1)).. ;;
14c0: 4e 61 74 20 58 20 2d 3e 20 5b 54 72 65 65 20 58 Nat X -> [Tree X
14d0: 5d 0a 20 20 28 64 65 66 69 6e 65 20 28 74 72 3a ]. (define (tr:
14e0: 6d 61 6b 65 2d 74 72 65 65 20 69 20 78 29 20 3b make-tree i x) ;
14f0: 3b 20 69 20 3d 20 32 5e 6a 2d 31 0a 20 20 20 20 ; i = 2^j-1.
1500: 28 6c 65 74 20 72 65 63 72 20 28 28 69 20 69 29 (let recr ((i i)
1510: 29 0a 20 20 20 20 20 20 28 69 66 20 28 3d 20 31 ). (if (= 1
1520: 20 69 29 20 0a 20 20 20 20 20 20 20 20 20 20 78 i) . x
1530: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 . (let
1540: 28 28 6e 20 28 72 65 63 72 20 28 68 61 6c 66 20 ((n (recr (half
1550: 69 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 i)))).
1560: 20 20 28 6d 61 6b 65 2d 6e 6f 64 65 20 78 20 6e (make-node x n
1570: 20 6e 29 29 29 29 29 0a 20 20 0a 20 20 3b 3b 20 n))))). . ;;
1580: 4e 61 74 20 5b 54 72 65 65 20 58 5d 20 4e 61 74 Nat [Tree X] Nat
1590: 20 5b 58 20 2d 3e 20 58 5d 20 2d 3e 20 58 20 5b [X -> X] -> X [
15a0: 54 72 65 65 20 58 5d 0a 20 20 28 64 65 66 69 6e Tree X]. (defin
15b0: 65 20 28 74 72 65 65 2d 72 65 66 2f 75 70 64 61 e (tree-ref/upda
15c0: 74 65 20 6d 69 64 20 74 20 69 20 66 29 0a 20 20 te mid t i f).
15d0: 20 20 28 63 6f 6e 64 20 28 28 7a 65 72 6f 3f 20 (cond ((zero?
15e0: 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 i). (i
15f0: 66 20 28 6e 6f 64 65 3f 20 74 29 20 0a 20 20 20 f (node? t) .
1600: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c (val
1610: 75 65 73 20 28 6e 6f 64 65 2d 76 61 6c 20 74 29 ues (node-val t)
1620: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1630: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 6e 6f (make-no
1640: 64 65 20 28 66 20 28 6e 6f 64 65 2d 76 61 6c 20 de (f (node-val
1650: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1670: 20 20 20 20 20 20 28 6e 6f 64 65 2d 6c 65 66 74 (node-left
1680: 20 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t).
1690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16a0: 20 20 20 20 20 20 28 6e 6f 64 65 2d 72 69 67 68 (node-righ
16b0: 74 20 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 t t))).
16c0: 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 74 20 (values t
16d0: 28 66 20 74 29 29 29 29 0a 20 20 20 20 20 20 20 (f t)))).
16e0: 20 20 20 28 28 3c 3d 20 69 20 6d 69 64 29 0a 20 ((<= i mid).
16f0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2d 76 (let-v
1700: 61 6c 75 65 73 20 28 28 28 76 2a 20 74 2a 29 20 alues (((v* t*)
1710: 28 74 72 65 65 2d 72 65 66 2f 75 70 64 61 74 65 (tree-ref/update
1720: 20 28 68 61 6c 66 20 28 73 75 62 31 20 6d 69 64 (half (sub1 mid
1730: 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 )) .
1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1760: 20 20 20 20 20 20 28 6e 6f 64 65 2d 6c 65 66 74 (node-left
1770: 20 74 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 t) .
1780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17a0: 20 20 20 20 20 20 20 28 73 75 62 31 20 69 29 20 (sub1 i)
17b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
17c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17e0: 20 20 20 66 29 29 29 0a 20 20 20 20 20 20 20 20 f))).
17f0: 20 20 20 20 20 28 76 61 6c 75 65 73 20 76 2a 20 (values v*
1800: 28 6d 61 6b 65 2d 6e 6f 64 65 20 28 6e 6f 64 65 (make-node (node
1810: 2d 76 61 6c 20 74 29 20 74 2a 20 28 6e 6f 64 65 -val t) t* (node
1820: 2d 72 69 67 68 74 20 74 29 29 29 29 29 0a 20 20 -right t))))).
1830: 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 20 20 (else
1840: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 .
1850: 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 (let-values
1860: 28 28 28 76 2a 20 74 2a 29 20 28 74 72 65 65 2d (((v* t*) (tree-
1870: 72 65 66 2f 75 70 64 61 74 65 20 28 68 61 6c 66 ref/update (half
1880: 20 28 73 75 62 31 20 6d 69 64 29 29 20 0a 20 20 (sub1 mid)) .
1890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18c0: 28 6e 6f 64 65 2d 72 69 67 68 74 20 74 29 20 0a (node-right t) .
18d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1900: 20 20 28 73 75 62 31 20 28 2d 20 69 20 6d 69 64 (sub1 (- i mid
1910: 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 )) .
1920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1940: 20 20 20 20 20 20 66 29 29 29 0a 20 20 20 20 20 f))).
1950: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 (values
1960: 76 2a 20 28 6d 61 6b 65 2d 6e 6f 64 65 20 28 6e v* (make-node (n
1970: 6f 64 65 2d 76 61 6c 20 74 29 20 28 6e 6f 64 65 ode-val t) (node
1980: 2d 6c 65 66 74 20 74 29 20 74 2a 29 29 29 29 29 -left t) t*)))))
1990: 29 0a 20 20 0a 20 20 3b 3b 20 53 70 65 63 69 61 ). . ;; Specia
19a0: 6c 2d 63 61 73 65 64 20 61 62 6f 76 65 20 74 6f l-cased above to
19b0: 20 61 76 6f 69 64 20 6c 6f 67 61 72 61 74 68 6d avoid logarathm
19c0: 69 63 20 61 6d 6f 75 6e 74 20 6f 66 20 63 6f 6e ic amount of con
19d0: 73 27 69 6e 67 0a 20 20 3b 3b 20 61 6e 64 20 61 s'ing. ;; and a
19e0: 6e 79 20 6d 75 6c 74 69 2d 76 61 6c 75 65 73 20 ny multi-values
19f0: 6f 76 65 72 68 65 61 64 2e 20 20 4f 70 65 72 61 overhead. Opera
1a00: 74 65 73 20 69 6e 20 63 6f 6e 73 74 61 6e 74 20 tes in constant
1a10: 73 70 61 63 65 2e 0a 20 20 3b 3b 20 5b 54 72 65 space.. ;; [Tre
1a20: 65 20 58 5d 20 4e 61 74 20 4e 61 74 20 2d 3e 20 e X] Nat Nat ->
1a30: 58 0a 20 20 3b 3b 20 69 6e 76 61 72 69 61 6e 74 X. ;; invariant
1a40: 3a 20 28 3d 20 6d 69 64 20 28 68 61 6c 66 20 28 : (= mid (half (
1a50: 73 75 62 31 20 28 74 72 65 65 2d 63 6f 75 6e 74 sub1 (tree-count
1a60: 20 74 29 29 29 29 0a 20 20 28 64 65 66 69 6e 65 t)))). (define
1a70: 20 28 74 72 65 65 2d 72 65 66 2f 61 20 74 20 69 (tree-ref/a t i
1a80: 20 6d 69 64 29 20 0a 20 20 20 20 28 63 6f 6e 64 mid) . (cond
1a90: 20 28 28 7a 65 72 6f 3f 20 69 29 20 28 74 72 65 ((zero? i) (tre
1aa0: 65 2d 76 61 6c 20 74 29 29 0a 20 20 20 20 20 20 e-val t)).
1ab0: 20 20 20 20 28 28 3c 3d 20 69 20 6d 69 64 29 20 ((<= i mid)
1ac0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 74 72 65 . (tre
1ad0: 65 2d 72 65 66 2f 61 20 28 6e 6f 64 65 2d 6c 65 e-ref/a (node-le
1ae0: 66 74 20 74 29 20 0a 20 20 20 20 20 20 20 20 20 ft t) .
1af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
1b00: 75 62 31 20 69 29 20 0a 20 20 20 20 20 20 20 20 ub1 i) .
1b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1b20: 68 61 6c 66 20 28 73 75 62 31 20 6d 69 64 29 29 half (sub1 mid))
1b30: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c )). (el
1b40: 73 65 20 0a 20 20 20 20 20 20 20 20 20 20 20 28 se . (
1b50: 74 72 65 65 2d 72 65 66 2f 61 20 28 6e 6f 64 65 tree-ref/a (node
1b60: 2d 72 69 67 68 74 20 74 29 20 0a 20 20 20 20 20 -right t) .
1b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b80: 20 20 28 73 75 62 31 20 28 2d 20 69 20 6d 69 64 (sub1 (- i mid
1b90: 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 )) .
1ba0: 20 20 20 20 20 20 20 20 20 20 20 28 68 61 6c 66 (half
1bb0: 20 28 73 75 62 31 20 6d 69 64 29 29 29 29 29 29 (sub1 mid))))))
1bc0: 0a 20 20 0a 20 20 3b 3b 20 4e 61 74 20 5b 54 72 . . ;; Nat [Tr
1bd0: 65 65 20 58 5d 20 4e 61 74 20 2d 3e 20 58 0a 20 ee X] Nat -> X.
1be0: 20 3b 3b 20 69 6e 76 61 72 69 61 6e 74 3a 20 28 ;; invariant: (
1bf0: 3d 20 73 69 7a 65 20 28 74 72 65 65 2d 63 6f 75 = size (tree-cou
1c00: 6e 74 20 74 29 29 0a 20 20 28 64 65 66 69 6e 65 nt t)). (define
1c10: 20 28 74 72 65 65 2d 72 65 66 20 73 69 7a 65 20 (tree-ref size
1c20: 74 20 69 29 0a 20 20 20 20 28 69 66 20 28 7a 65 t i). (if (ze
1c30: 72 6f 3f 20 69 29 0a 20 20 20 20 20 20 20 20 28 ro? i). (
1c40: 74 72 65 65 2d 76 61 6c 20 74 29 0a 20 20 20 20 tree-val t).
1c50: 20 20 20 20 28 74 72 65 65 2d 72 65 66 2f 61 20 (tree-ref/a
1c60: 74 20 69 20 28 68 61 6c 66 20 28 73 75 62 31 20 t i (half (sub1
1c70: 73 69 7a 65 29 29 29 29 29 0a 20 20 0a 20 20 3b size))))). . ;
1c80: 3b 20 4e 61 74 20 5b 54 72 65 65 20 58 5d 20 4e ; Nat [Tree X] N
1c90: 61 74 20 5b 58 20 2d 3e 20 58 5d 20 2d 3e 20 5b at [X -> X] -> [
1ca0: 54 72 65 65 20 58 5d 0a 20 20 28 64 65 66 69 6e Tree X]. (defin
1cb0: 65 20 28 74 72 65 65 2d 75 70 64 61 74 65 20 73 e (tree-update s
1cc0: 69 7a 65 20 74 20 69 20 66 29 0a 20 20 20 20 28 ize t i f). (
1cd0: 6c 65 74 20 72 65 63 72 20 28 28 6d 69 64 20 28 let recr ((mid (
1ce0: 68 61 6c 66 20 28 73 75 62 31 20 73 69 7a 65 29 half (sub1 size)
1cf0: 29 29 20 28 74 20 74 29 20 28 69 20 69 29 29 0a )) (t t) (i i)).
1d00: 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 7a 65 (cond ((ze
1d10: 72 6f 3f 20 69 29 0a 20 20 20 20 20 20 20 20 20 ro? i).
1d20: 20 20 20 20 28 69 66 20 28 6e 6f 64 65 3f 20 74 (if (node? t
1d30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1d40: 20 20 20 28 6d 61 6b 65 2d 6e 6f 64 65 20 28 66 (make-node (f
1d50: 20 28 6e 6f 64 65 2d 76 61 6c 20 74 29 29 0a 20 (node-val t)).
1d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d70: 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 64 65 (node
1d80: 2d 6c 65 66 74 20 74 29 0a 20 20 20 20 20 20 20 -left t).
1d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1da0: 20 20 20 20 20 28 6e 6f 64 65 2d 72 69 67 68 74 (node-right
1db0: 20 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t)).
1dc0: 20 20 20 20 20 20 28 66 20 74 29 29 29 0a 20 20 (f t))).
1dd0: 20 20 20 20 20 20 20 20 20 20 28 28 3c 3d 20 69 ((<= i
1de0: 20 6d 69 64 29 0a 20 20 20 20 20 20 20 20 20 20 mid).
1df0: 20 20 20 28 6d 61 6b 65 2d 6e 6f 64 65 20 28 6e (make-node (n
1e00: 6f 64 65 2d 76 61 6c 20 74 29 20 0a 20 20 20 20 ode-val t) .
1e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e20: 20 20 20 20 28 72 65 63 72 20 28 68 61 6c 66 20 (recr (half
1e30: 28 73 75 62 31 20 6d 69 64 29 29 0a 20 20 20 20 (sub1 mid)).
1e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e50: 20 20 20 20 20 20 20 20 20 20 28 6e 6f 64 65 2d (node-
1e60: 6c 65 66 74 20 74 29 20 0a 20 20 20 20 20 20 20 left t) .
1e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e80: 20 20 20 20 20 20 20 28 73 75 62 31 20 69 29 29 (sub1 i))
1e90: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1ea0: 20 20 20 20 20 20 20 20 20 20 28 6e 6f 64 65 2d (node-
1eb0: 72 69 67 68 74 20 74 29 29 29 0a 20 20 20 20 20 right t))).
1ec0: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
1ed0: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
1ee0: 6e 6f 64 65 20 28 6e 6f 64 65 2d 76 61 6c 20 74 node (node-val t
1ef0: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
1f00: 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 64 65 (node
1f10: 2d 6c 65 66 74 20 74 29 20 0a 20 20 20 20 20 20 -left t) .
1f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f30: 20 20 28 72 65 63 72 20 28 68 61 6c 66 20 28 73 (recr (half (s
1f40: 75 62 31 20 6d 69 64 29 29 0a 20 20 20 20 20 20 ub1 mid)).
1f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f60: 20 20 20 20 20 20 20 20 28 6e 6f 64 65 2d 72 69 (node-ri
1f70: 67 68 74 20 74 29 20 0a 20 20 20 20 20 20 20 20 ght t) .
1f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f90: 20 20 20 20 20 20 28 73 75 62 31 20 28 2d 20 69 (sub1 (- i
1fa0: 20 6d 69 64 29 29 29 29 29 29 29 29 0a 0a 20 20 mid))))))))..
1fb0: 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ;; -------------
1fc0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 20 20 3b 3b -----------. ;;
1fd0: 20 52 61 6e 64 6f 6d 20 61 63 63 65 73 73 20 6c Random access l
1fe0: 69 73 74 73 0a 20 20 0a 20 20 3b 3b 20 5b 52 61 ists. . ;; [Ra
1ff0: 4c 69 73 74 6f 66 20 58 5d 0a 20 20 28 64 65 66 Listof X]. (def
2000: 69 6e 65 20 72 61 3a 6e 75 6c 6c 20 28 71 75 6f ine ra:null (quo
2010: 74 65 20 28 29 29 29 0a 0a 20 20 3b 3b 20 5b 41 te ())).. ;; [A
2020: 6e 79 20 2d 3e 20 42 6f 6f 6c 65 61 6e 5d 0a 20 ny -> Boolean].
2030: 20 28 64 65 66 69 6e 65 20 72 61 3a 70 61 69 72 (define ra:pair
2040: 3f 20 6b 6f 6e 73 3f 29 0a 20 20 0a 20 20 3b 3b ? kons?). . ;;
2050: 20 5b 41 6e 79 20 2d 3e 20 42 6f 6f 6c 65 61 6e [Any -> Boolean
2060: 5d 0a 20 20 28 64 65 66 69 6e 65 20 72 61 3a 6e ]. (define ra:n
2070: 75 6c 6c 3f 20 6e 75 6c 6c 3f 29 0a 20 20 0a 20 ull? null?). .
2080: 20 3b 3b 20 58 20 5b 52 61 4c 69 73 74 6f 66 20 ;; X [RaListof
2090: 58 5d 20 2d 3e 20 5b 52 61 4c 69 73 74 6f 66 20 X] -> [RaListof
20a0: 58 5d 20 20 2f 5c 0a 20 20 3b 3b 20 58 20 59 20 X] /\. ;; X Y
20b0: 2d 3e 20 5b 52 61 50 61 69 72 20 58 20 59 5d 0a -> [RaPair X Y].
20c0: 20 20 28 64 65 66 69 6e 65 20 28 72 61 3a 63 6f (define (ra:co
20d0: 6e 73 20 78 20 6c 73 29 0a 20 20 20 20 28 69 66 ns x ls). (if
20e0: 20 28 6b 6f 6e 73 3f 20 6c 73 29 0a 20 20 20 20 (kons? ls).
20f0: 20 20 20 20 28 6c 65 74 20 28 28 73 20 28 6b 6f (let ((s (ko
2100: 6e 73 2d 73 69 7a 65 20 6c 73 29 29 29 0a 20 20 ns-size ls))).
2110: 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 (if (and
2120: 20 28 6b 6f 6e 73 3f 20 28 6b 6f 6e 73 2d 72 65 (kons? (kons-re
2130: 73 74 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 st ls)).
2140: 20 20 20 20 20 20 20 20 20 20 20 28 3d 20 28 6b (= (k
2150: 6f 6e 73 2d 73 69 7a 65 20 28 6b 6f 6e 73 2d 72 ons-size (kons-r
2160: 65 73 74 20 6c 73 29 29 0a 20 20 20 20 20 20 20 est ls)).
2170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
2180: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2190: 20 28 6d 61 6b 65 2d 6b 6f 6e 73 20 28 2b 20 31 (make-kons (+ 1
21a0: 20 73 20 73 29 20 0a 20 20 20 20 20 20 20 20 20 s s) .
21b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21c0: 28 6d 61 6b 65 2d 6e 6f 64 65 20 78 20 0a 20 20 (make-node x .
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 28 6b 6f 6e 73 2d 74 72 65 65 20 6c 73 29 (kons-tree ls)
2200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2220: 20 20 20 20 20 28 6b 6f 6e 73 2d 74 72 65 65 20 (kons-tree
2230: 28 6b 6f 6e 73 2d 72 65 73 74 20 6c 73 29 29 29 (kons-rest ls)))
2240: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2250: 20 20 20 20 20 20 20 20 20 20 28 6b 6f 6e 73 2d (kons-
2260: 72 65 73 74 20 28 6b 6f 6e 73 2d 72 65 73 74 20 rest (kons-rest
2270: 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ls))).
2280: 20 20 20 20 28 6d 61 6b 65 2d 6b 6f 6e 73 20 31 (make-kons 1
2290: 20 78 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 x ls))).
22a0: 20 28 6d 61 6b 65 2d 6b 6f 6e 73 20 31 20 78 20 (make-kons 1 x
22b0: 6c 73 29 29 29 0a 0a 20 20 0a 20 20 3b 3b 20 5b ls))).. . ;; [
22c0: 52 61 50 61 69 72 20 58 20 59 5d 20 2d 3e 20 58 RaPair X Y] -> X
22d0: 20 59 0a 20 20 28 64 65 66 69 6e 65 20 72 61 3a Y. (define ra:
22e0: 63 61 72 2b 63 64 72 20 0a 20 20 20 20 28 6c 61 car+cdr . (la
22f0: 6d 62 64 61 20 28 70 29 0a 20 20 20 20 20 20 28 mbda (p). (
2300: 61 73 73 65 72 74 20 28 6b 6f 6e 73 3f 20 70 29 assert (kons? p)
2310: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 64 ). (if (nod
2320: 65 3f 20 28 6b 6f 6e 73 2d 74 72 65 65 20 70 29 e? (kons-tree p)
2330: 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 ). (let
2340: 20 28 28 73 2a 20 28 68 61 6c 66 20 28 6b 6f 6e ((s* (half (kon
2350: 73 2d 73 69 7a 65 20 70 29 29 29 29 0a 20 20 20 s-size p)))).
2360: 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 (values
2370: 20 28 74 72 65 65 2d 76 61 6c 20 28 6b 6f 6e 73 (tree-val (kons
2380: 2d 74 72 65 65 20 70 29 29 0a 20 20 20 20 20 20 -tree p)).
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
23a0: 61 6b 65 2d 6b 6f 6e 73 20 73 2a 20 0a 20 20 20 ake-kons s* .
23b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 64 (nod
23d0: 65 2d 6c 65 66 74 20 28 6b 6f 6e 73 2d 74 72 65 e-left (kons-tre
23e0: 65 20 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 e p)).
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2400: 20 20 20 20 20 28 6d 61 6b 65 2d 6b 6f 6e 73 20 (make-kons
2410: 73 2a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s*.
2420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2430: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f (no
2440: 64 65 2d 72 69 67 68 74 20 28 6b 6f 6e 73 2d 74 de-right (kons-t
2450: 72 65 65 20 70 29 29 0a 20 20 20 20 20 20 20 20 ree p)).
2460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2480: 20 20 28 6b 6f 6e 73 2d 72 65 73 74 20 70 29 29 (kons-rest p))
2490: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 76 ))). (v
24a0: 61 6c 75 65 73 20 28 6b 6f 6e 73 2d 74 72 65 65 alues (kons-tree
24b0: 20 70 29 20 28 6b 6f 6e 73 2d 72 65 73 74 20 70 p) (kons-rest p
24c0: 29 29 29 29 29 0a 20 20 0a 20 20 3b 3b 20 5b 52 ))))). . ;; [R
24d0: 61 50 61 69 72 20 58 20 59 5d 20 2d 3e 20 58 0a aPair X Y] -> X.
24e0: 20 20 28 64 65 66 69 6e 65 20 28 72 61 3a 63 61 (define (ra:ca
24f0: 72 20 70 29 0a 20 20 20 20 28 63 61 6c 6c 2d 77 r p). (call-w
2500: 69 74 68 2d 76 61 6c 75 65 73 20 28 6c 61 6d 62 ith-values (lamb
2510: 64 61 20 28 29 20 28 72 61 3a 63 61 72 2b 63 64 da () (ra:car+cd
2520: 72 20 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 r p)).
2530: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
2540: 62 64 61 20 28 63 61 72 20 63 64 72 29 20 63 61 bda (car cdr) ca
2550: 72 29 29 29 0a 20 20 0a 20 20 3b 3b 20 5b 52 61 r))). . ;; [Ra
2560: 50 61 69 72 20 58 20 59 5d 20 2d 3e 20 59 0a 20 Pair X Y] -> Y.
2570: 20 28 64 65 66 69 6e 65 20 28 72 61 3a 63 64 72 (define (ra:cdr
2580: 20 70 29 0a 20 20 20 20 28 63 61 6c 6c 2d 77 69 p). (call-wi
2590: 74 68 2d 76 61 6c 75 65 73 20 28 6c 61 6d 62 64 th-values (lambd
25a0: 61 20 28 29 20 28 72 61 3a 63 61 72 2b 63 64 72 a () (ra:car+cdr
25b0: 20 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 p)).
25c0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
25d0: 64 61 20 28 63 61 72 20 63 64 72 29 20 63 64 72 da (car cdr) cdr
25e0: 29 29 29 0a 20 20 0a 20 20 3b 3b 20 5b 52 61 4c ))). . ;; [RaL
25f0: 69 73 74 6f 66 20 58 5d 20 4e 61 74 20 5b 58 20 istof X] Nat [X
2600: 2d 3e 20 58 5d 20 2d 3e 20 58 20 5b 52 61 4c 69 -> X] -> X [RaLi
2610: 73 74 6f 66 20 58 5d 0a 20 20 28 64 65 66 69 6e stof X]. (defin
2620: 65 20 28 72 61 3a 6c 69 73 74 2d 72 65 66 2f 75 e (ra:list-ref/u
2630: 70 64 61 74 65 20 6c 73 20 69 20 66 29 0a 20 20 pdate ls i f).
2640: 20 20 3b 28 61 73 73 65 72 74 20 28 3c 20 69 20 ;(assert (< i
2650: 28 72 61 3a 6c 65 6e 67 74 68 20 6c 73 29 29 29 (ra:length ls)))
2660: 0a 20 20 20 20 28 6c 65 74 20 72 65 63 72 20 28 . (let recr (
2670: 28 78 73 20 6c 73 29 20 28 6a 20 69 29 29 0a 20 (xs ls) (j i)).
2680: 20 20 20 20 20 28 69 66 20 28 3c 20 6a 20 28 6b (if (< j (k
2690: 6f 6e 73 2d 73 69 7a 65 20 78 73 29 29 0a 20 20 ons-size xs)).
26a0: 20 20 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c (let-val
26b0: 75 65 73 20 28 28 28 76 2a 20 74 2a 29 20 0a 20 ues (((v* t*) .
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26d0: 20 20 20 20 20 20 20 28 74 72 65 65 2d 72 65 66 (tree-ref
26e0: 2f 75 70 64 61 74 65 20 28 68 61 6c 66 20 28 73 /update (half (s
26f0: 75 62 31 20 28 6b 6f 6e 73 2d 73 69 7a 65 20 78 ub1 (kons-size x
2700: 73 29 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 s))) .
2710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2730: 6b 6f 6e 73 2d 74 72 65 65 20 78 73 29 20 6a 20 kons-tree xs) j
2740: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f))).
2750: 20 28 76 61 6c 75 65 73 20 76 2a 20 28 6d 61 6b (values v* (mak
2760: 65 2d 6b 6f 6e 73 20 28 6b 6f 6e 73 2d 73 69 7a e-kons (kons-siz
2770: 65 20 78 73 29 20 0a 20 20 20 20 20 20 20 20 20 e xs) .
2780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2790: 20 20 20 20 20 20 20 20 20 74 2a 20 0a 20 20 20 t* .
27a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
27c0: 6b 6f 6e 73 2d 72 65 73 74 20 78 73 29 29 29 29 kons-rest xs))))
27d0: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2d . (let-
27e0: 76 61 6c 75 65 73 20 28 28 28 76 2a 20 72 2a 29 values (((v* r*)
27f0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2800: 20 20 20 20 20 20 20 20 20 20 28 72 65 63 72 20 (recr
2810: 28 6b 6f 6e 73 2d 72 65 73 74 20 78 73 29 20 0a (kons-rest xs) .
2820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2d (-
2840: 20 6a 20 28 6b 6f 6e 73 2d 73 69 7a 65 20 78 73 j (kons-size xs
2850: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
2860: 20 20 28 76 61 6c 75 65 73 20 76 2a 20 28 6d 61 (values v* (ma
2870: 6b 65 2d 6b 6f 6e 73 20 28 6b 6f 6e 73 2d 73 69 ke-kons (kons-si
2880: 7a 65 20 78 73 29 20 0a 20 20 20 20 20 20 20 20 ze xs) .
2890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28a0: 20 20 20 20 20 20 20 20 20 20 28 6b 6f 6e 73 2d (kons-
28b0: 74 72 65 65 20 78 73 29 20 0a 20 20 20 20 20 20 tree xs) .
28c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28d0: 20 20 20 20 20 20 20 20 20 20 20 20 72 2a 29 29 r*))
28e0: 29 29 29 29 0a 20 20 0a 20 20 3b 3b 20 5b 52 61 )))). . ;; [Ra
28f0: 4c 69 73 74 6f 66 20 58 5d 20 4e 61 74 20 5b 58 Listof X] Nat [X
2900: 20 2d 3e 20 58 5d 20 2d 3e 20 5b 52 61 4c 69 73 -> X] -> [RaLis
2910: 74 6f 66 20 58 5d 0a 20 20 28 64 65 66 69 6e 65 tof X]. (define
2920: 20 28 72 61 3a 6c 69 73 74 2d 75 70 64 61 74 65 (ra:list-update
2930: 20 6c 73 20 69 20 66 29 0a 20 20 20 20 3b 28 61 ls i f). ;(a
2940: 73 73 65 72 74 20 28 3c 20 69 20 28 72 61 3a 6c ssert (< i (ra:l
2950: 65 6e 67 74 68 20 6c 73 29 29 29 0a 20 20 20 20 ength ls))).
2960: 28 6c 65 74 20 72 65 63 72 20 28 28 78 73 20 6c (let recr ((xs l
2970: 73 29 20 28 6a 20 69 29 29 0a 20 20 20 20 20 20 s) (j i)).
2980: 28 6c 65 74 20 28 28 73 20 28 6b 6f 6e 73 2d 73 (let ((s (kons-s
2990: 69 7a 65 20 78 73 29 29 29 0a 20 20 20 20 20 20 ize xs))).
29a0: 20 20 28 69 66 20 28 3c 20 6a 20 73 29 20 0a 20 (if (< j s) .
29b0: 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 (make
29c0: 2d 6b 6f 6e 73 20 73 20 28 74 72 65 65 2d 75 70 -kons s (tree-up
29d0: 64 61 74 65 20 73 20 28 6b 6f 6e 73 2d 74 72 65 date s (kons-tre
29e0: 65 20 78 73 29 20 6a 20 66 29 20 28 6b 6f 6e 73 e xs) j f) (kons
29f0: 2d 72 65 73 74 20 78 73 29 29 0a 20 20 20 20 20 -rest xs)).
2a00: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 6b 6f 6e (make-kon
2a10: 73 20 73 20 28 6b 6f 6e 73 2d 74 72 65 65 20 78 s s (kons-tree x
2a20: 73 29 20 28 72 65 63 72 20 28 6b 6f 6e 73 2d 72 s) (recr (kons-r
2a30: 65 73 74 20 78 73 29 20 28 2d 20 6a 20 73 29 29 est xs) (- j s))
2a40: 29 29 29 29 29 0a 0a 20 20 3b 3b 20 5b 52 61 4c ))))).. ;; [RaL
2a50: 69 73 74 6f 66 20 58 5d 20 4e 61 74 20 58 20 2d istof X] Nat X -
2a60: 3e 20 28 76 61 6c 75 65 73 20 58 20 5b 52 61 4c > (values X [RaL
2a70: 69 73 74 6f 66 20 58 5d 29 0a 20 20 28 64 65 66 istof X]). (def
2a80: 69 6e 65 20 28 72 61 3a 6c 69 73 74 2d 72 65 66 ine (ra:list-ref
2a90: 2f 73 65 74 20 6c 73 20 69 20 76 29 0a 20 20 20 /set ls i v).
2aa0: 20 28 72 61 3a 6c 69 73 74 2d 72 65 66 2f 75 70 (ra:list-ref/up
2ab0: 64 61 74 65 20 6c 73 20 69 20 28 6c 61 6d 62 64 date ls i (lambd
2ac0: 61 20 28 5f 29 20 76 29 29 29 0a 0a 20 20 3b 3b a (_) v))).. ;;
2ad0: 20 58 20 2e 2e 2e 20 2d 3e 20 5b 52 61 4c 69 73 X ... -> [RaLis
2ae0: 74 6f 66 20 58 5d 0a 20 20 28 64 65 66 69 6e 65 tof X]. (define
2af0: 20 28 72 61 3a 6c 69 73 74 20 2e 20 78 73 29 0a (ra:list . xs).
2b00: 20 20 20 20 28 66 6f 6c 64 2d 72 69 67 68 74 20 (fold-right
2b10: 72 61 3a 63 6f 6e 73 20 72 61 3a 6e 75 6c 6c 20 ra:cons ra:null
2b20: 78 73 29 29 0a 0a 20 20 3b 3b 20 4e 61 74 20 58 xs)).. ;; Nat X
2b30: 20 2d 3e 20 5b 52 61 4c 69 73 74 6f 66 20 58 5d -> [RaListof X]
2b40: 0a 20 20 28 64 65 66 69 6e 65 20 72 61 3a 6d 61 . (define ra:ma
2b50: 6b 65 2d 6c 69 73 74 0a 20 20 20 20 28 63 61 73 ke-list. (cas
2b60: 65 2d 6c 61 6d 62 64 61 0a 20 20 20 20 20 28 28 e-lambda. ((
2b70: 6b 29 20 28 72 61 3a 6d 61 6b 65 2d 6c 69 73 74 k) (ra:make-list
2b80: 20 6b 20 30 29 29 0a 20 20 20 20 20 28 28 6b 20 k 0)). ((k
2b90: 6f 62 6a 29 0a 20 20 20 20 20 20 28 6c 65 74 20 obj). (let
2ba0: 6c 6f 6f 70 20 28 28 6e 20 6b 29 20 28 61 20 72 loop ((n k) (a r
2bb0: 61 3a 6e 75 6c 6c 29 29 0a 20 20 20 20 20 20 20 a:null)).
2bc0: 20 28 63 6f 6e 64 20 28 28 7a 65 72 6f 3f 20 6e (cond ((zero? n
2bd0: 29 20 61 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) a).
2be0: 20 20 20 28 65 6c 73 65 20 0a 20 20 20 20 20 20 (else .
2bf0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
2c00: 74 20 28 6c 61 72 67 65 73 74 2d 73 6b 65 77 2d t (largest-skew-
2c10: 62 69 6e 61 72 79 20 6e 29 29 29 0a 20 20 20 20 binary n))).
2c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
2c30: 6f 70 20 28 2d 20 6e 20 74 29 0a 20 20 20 20 20 op (- n t).
2c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c50: 20 20 28 6d 61 6b 65 2d 6b 6f 6e 73 20 74 20 28 (make-kons t (
2c60: 74 72 3a 6d 61 6b 65 2d 74 72 65 65 20 74 20 6f tr:make-tree t o
2c70: 62 6a 29 20 61 29 29 29 29 29 29 29 29 29 0a 0a bj) a)))))))))..
2c80: 20 20 3b 3b 20 41 20 53 6b 65 77 20 69 73 20 61 ;; A Skew is a
2c90: 20 4e 61 74 20 32 5e 6b 2d 31 20 77 69 74 68 20 Nat 2^k-1 with
2ca0: 6b 20 3e 20 30 2e 0a 20 20 0a 20 20 3b 3b 20 53 k > 0.. . ;; S
2cb0: 6b 65 77 20 2d 3e 20 53 6b 65 77 0a 20 20 28 64 kew -> Skew. (d
2cc0: 65 66 69 6e 65 20 28 73 6b 65 77 2d 73 75 63 63 efine (skew-succ
2cd0: 20 74 29 20 28 61 64 64 31 20 28 62 69 74 77 69 t) (add1 (bitwi
2ce0: 73 65 2d 61 72 69 74 68 6d 65 74 69 63 2d 73 68 se-arithmetic-sh
2cf0: 69 66 74 20 74 20 31 29 29 29 0a 20 20 0a 20 20 ift t 1))). .
2d00: 3b 3b 20 43 6f 6d 70 75 74 65 73 20 74 68 65 20 ;; Computes the
2d10: 6c 61 72 67 65 73 74 20 73 6b 65 77 20 62 69 6e largest skew bin
2d20: 61 72 79 20 74 65 72 6d 20 74 20 3c 3d 20 6e 2e ary term t <= n.
2d30: 0a 20 20 3b 3b 20 4e 61 74 20 2d 3e 20 53 6b 65 . ;; Nat -> Ske
2d40: 77 0a 20 20 28 64 65 66 69 6e 65 20 28 6c 61 72 w. (define (lar
2d50: 67 65 73 74 2d 73 6b 65 77 2d 62 69 6e 61 72 79 gest-skew-binary
2d60: 20 6e 29 0a 20 20 20 20 28 69 66 20 28 3d 20 31 n). (if (= 1
2d70: 20 6e 29 20 0a 20 20 20 20 20 20 20 20 31 0a 20 n) . 1.
2d80: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 (let* ((t
2d90: 20 28 6c 61 72 67 65 73 74 2d 73 6b 65 77 2d 62 (largest-skew-b
2da0: 69 6e 61 72 79 20 28 68 61 6c 66 20 6e 29 29 29 inary (half n)))
2db0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2dc0: 28 73 20 28 73 6b 65 77 2d 73 75 63 63 20 74 29 (s (skew-succ t)
2dd0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 )). (if
2de0: 20 28 3e 20 73 20 6e 29 20 74 20 73 29 29 29 29 (> s n) t s))))
2df0: 20 20 0a 0a 20 20 3b 3b 20 5b 41 6e 79 20 2d 3e .. ;; [Any ->
2e00: 20 42 6f 6f 6c 65 61 6e 5d 0a 20 20 3b 3b 20 49 Boolean]. ;; I
2e10: 73 20 78 20 61 20 50 52 4f 50 45 52 20 6c 69 73 s x a PROPER lis
2e20: 74 3f 0a 20 20 28 64 65 66 69 6e 65 20 28 72 61 t?. (define (ra
2e30: 3a 6c 69 73 74 3f 20 78 29 0a 20 20 20 20 28 6f :list? x). (o
2e40: 72 20 28 72 61 3a 6e 75 6c 6c 3f 20 78 29 0a 20 r (ra:null? x).
2e50: 20 20 20 20 20 20 20 28 61 6e 64 20 28 6b 6f 6e (and (kon
2e60: 73 3f 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 s? x).
2e70: 20 20 20 28 72 61 3a 6c 69 73 74 3f 20 28 6b 6f (ra:list? (ko
2e80: 6e 73 2d 72 65 73 74 20 78 29 29 29 29 29 0a 20 ns-rest x))))).
2e90: 20 0a 20 20 28 64 65 66 69 6e 65 20 72 61 3a 63 . (define ra:c
2ea0: 61 61 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 aar (lambda (ls)
2eb0: 20 28 72 61 3a 63 61 72 20 28 72 61 3a 63 61 72 (ra:car (ra:car
2ec0: 20 6c 73 29 29 29 29 0a 20 20 28 64 65 66 69 6e ls)))). (defin
2ed0: 65 20 72 61 3a 63 61 64 72 20 28 6c 61 6d 62 64 e ra:cadr (lambd
2ee0: 61 20 28 6c 73 29 20 28 72 61 3a 63 61 72 20 28 a (ls) (ra:car (
2ef0: 72 61 3a 63 64 72 20 6c 73 29 29 29 29 0a 20 20 ra:cdr ls)))).
2f00: 28 64 65 66 69 6e 65 20 72 61 3a 63 64 64 72 20 (define ra:cddr
2f10: 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 72 61 (lambda (ls) (ra
2f20: 3a 63 64 72 20 28 72 61 3a 63 64 72 20 6c 73 29 :cdr (ra:cdr ls)
2f30: 29 29 29 0a 20 20 28 64 65 66 69 6e 65 20 72 61 ))). (define ra
2f40: 3a 63 64 61 72 20 28 6c 61 6d 62 64 61 20 28 6c :cdar (lambda (l
2f50: 73 29 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 s) (ra:cdr (ra:c
2f60: 61 72 20 6c 73 29 29 29 29 0a 20 20 20 20 0a 20 ar ls)))). .
2f70: 20 28 64 65 66 69 6e 65 20 72 61 3a 63 61 61 61 (define ra:caaa
2f80: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
2f90: 72 61 3a 63 61 72 20 28 72 61 3a 63 61 72 20 28 ra:car (ra:car (
2fa0: 72 61 3a 63 61 72 20 6c 73 29 29 29 29 29 0a 20 ra:car ls))))).
2fb0: 20 28 64 65 66 69 6e 65 20 72 61 3a 63 61 61 64 (define ra:caad
2fc0: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
2fd0: 72 61 3a 63 61 72 20 28 72 61 3a 63 61 72 20 28 ra:car (ra:car (
2fe0: 72 61 3a 63 64 72 20 6c 73 29 29 29 29 29 0a 20 ra:cdr ls))))).
2ff0: 20 28 64 65 66 69 6e 65 20 72 61 3a 63 61 64 64 (define ra:cadd
3000: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
3010: 72 61 3a 63 61 72 20 28 72 61 3a 63 64 72 20 28 ra:car (ra:cdr (
3020: 72 61 3a 63 64 72 20 6c 73 29 29 29 29 29 0a 20 ra:cdr ls))))).
3030: 20 28 64 65 66 69 6e 65 20 72 61 3a 63 61 64 61 (define ra:cada
3040: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
3050: 72 61 3a 63 61 72 20 28 72 61 3a 63 64 72 20 28 ra:car (ra:cdr (
3060: 72 61 3a 63 61 72 20 6c 73 29 29 29 29 29 0a 20 ra:car ls))))).
3070: 20 28 64 65 66 69 6e 65 20 72 61 3a 63 64 61 61 (define ra:cdaa
3080: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
3090: 72 61 3a 63 64 72 20 28 72 61 3a 63 61 72 20 28 ra:cdr (ra:car (
30a0: 72 61 3a 63 61 72 20 6c 73 29 29 29 29 29 0a 20 ra:car ls))))).
30b0: 20 28 64 65 66 69 6e 65 20 72 61 3a 63 64 61 64 (define ra:cdad
30c0: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
30d0: 72 61 3a 63 64 72 20 28 72 61 3a 63 61 72 20 28 ra:cdr (ra:car (
30e0: 72 61 3a 63 64 72 20 6c 73 29 29 29 29 29 0a 20 ra:cdr ls))))).
30f0: 20 28 64 65 66 69 6e 65 20 72 61 3a 63 64 64 64 (define ra:cddd
3100: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
3110: 72 61 3a 63 64 72 20 28 72 61 3a 63 64 72 20 28 ra:cdr (ra:cdr (
3120: 72 61 3a 63 64 72 20 6c 73 29 29 29 29 29 0a 20 ra:cdr ls))))).
3130: 20 28 64 65 66 69 6e 65 20 72 61 3a 63 64 64 61 (define ra:cdda
3140: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
3150: 72 61 3a 63 64 72 20 28 72 61 3a 63 64 72 20 28 ra:cdr (ra:cdr (
3160: 72 61 3a 63 61 72 20 6c 73 29 29 29 29 29 0a 20 ra:car ls))))).
3170: 20 0a 20 20 28 64 65 66 69 6e 65 20 72 61 3a 63 . (define ra:c
3180: 61 61 61 61 72 20 28 6c 61 6d 62 64 61 20 28 6c aaaar (lambda (l
3190: 73 29 20 28 72 61 3a 63 61 72 20 28 72 61 3a 63 s) (ra:car (ra:c
31a0: 61 72 20 28 72 61 3a 63 61 72 20 28 72 61 3a 63 ar (ra:car (ra:c
31b0: 61 72 20 6c 73 29 29 29 29 29 29 0a 20 20 28 64 ar ls)))))). (d
31c0: 65 66 69 6e 65 20 72 61 3a 63 61 61 61 64 72 20 efine ra:caaadr
31d0: 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 72 61 (lambda (ls) (ra
31e0: 3a 63 61 72 20 28 72 61 3a 63 61 72 20 28 72 61 :car (ra:car (ra
31f0: 3a 63 61 72 20 28 72 61 3a 63 64 72 20 6c 73 29 :car (ra:cdr ls)
3200: 29 29 29 29 29 0a 20 20 28 64 65 66 69 6e 65 20 ))))). (define
3210: 72 61 3a 63 61 61 64 64 72 20 28 6c 61 6d 62 64 ra:caaddr (lambd
3220: 61 20 28 6c 73 29 20 28 72 61 3a 63 61 72 20 28 a (ls) (ra:car (
3230: 72 61 3a 63 61 72 20 28 72 61 3a 63 64 72 20 28 ra:car (ra:cdr (
3240: 72 61 3a 63 64 72 20 6c 73 29 29 29 29 29 29 0a ra:cdr ls)))))).
3250: 20 20 28 64 65 66 69 6e 65 20 72 61 3a 63 61 61 (define ra:caa
3260: 64 61 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 dar (lambda (ls)
3270: 20 28 72 61 3a 63 61 72 20 28 72 61 3a 63 61 72 (ra:car (ra:car
3280: 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 61 72 (ra:cdr (ra:car
3290: 20 6c 73 29 29 29 29 29 29 0a 20 20 28 64 65 66 ls)))))). (def
32a0: 69 6e 65 20 72 61 3a 63 61 64 61 61 72 20 28 6c ine ra:cadaar (l
32b0: 61 6d 62 64 61 20 28 6c 73 29 20 28 72 61 3a 63 ambda (ls) (ra:c
32c0: 61 72 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 ar (ra:cdr (ra:c
32d0: 61 72 20 28 72 61 3a 63 61 72 20 6c 73 29 29 29 ar (ra:car ls)))
32e0: 29 29 29 0a 20 20 28 64 65 66 69 6e 65 20 72 61 ))). (define ra
32f0: 3a 63 61 64 61 64 72 20 28 6c 61 6d 62 64 61 20 :cadadr (lambda
3300: 28 6c 73 29 20 28 72 61 3a 63 61 72 20 28 72 61 (ls) (ra:car (ra
3310: 3a 63 64 72 20 28 72 61 3a 63 61 72 20 28 72 61 :cdr (ra:car (ra
3320: 3a 63 64 72 20 6c 73 29 29 29 29 29 29 0a 20 20 :cdr ls)))))).
3330: 28 64 65 66 69 6e 65 20 72 61 3a 63 61 64 64 64 (define ra:caddd
3340: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
3350: 72 61 3a 63 61 72 20 28 72 61 3a 63 64 72 20 28 ra:car (ra:cdr (
3360: 72 61 3a 63 64 72 20 28 72 61 3a 63 64 72 20 6c ra:cdr (ra:cdr l
3370: 73 29 29 29 29 29 29 0a 20 20 28 64 65 66 69 6e s)))))). (defin
3380: 65 20 72 61 3a 63 61 64 64 61 72 20 28 6c 61 6d e ra:caddar (lam
3390: 62 64 61 20 28 6c 73 29 20 28 72 61 3a 63 61 72 bda (ls) (ra:car
33a0: 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 64 72 (ra:cdr (ra:cdr
33b0: 20 28 72 61 3a 63 61 72 20 6c 73 29 29 29 29 29 (ra:car ls)))))
33c0: 29 0a 20 20 28 64 65 66 69 6e 65 20 72 61 3a 63 ). (define ra:c
33d0: 64 61 61 61 72 20 28 6c 61 6d 62 64 61 20 28 6c daaar (lambda (l
33e0: 73 29 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 s) (ra:cdr (ra:c
33f0: 61 72 20 28 72 61 3a 63 61 72 20 28 72 61 3a 63 ar (ra:car (ra:c
3400: 61 72 20 6c 73 29 29 29 29 29 29 0a 20 20 28 64 ar ls)))))). (d
3410: 65 66 69 6e 65 20 72 61 3a 63 64 61 61 64 72 20 efine ra:cdaadr
3420: 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 72 61 (lambda (ls) (ra
3430: 3a 63 64 72 20 28 72 61 3a 63 61 72 20 28 72 61 :cdr (ra:car (ra
3440: 3a 63 61 72 20 28 72 61 3a 63 64 72 20 6c 73 29 :car (ra:cdr ls)
3450: 29 29 29 29 29 0a 20 20 28 64 65 66 69 6e 65 20 ))))). (define
3460: 72 61 3a 63 64 61 64 64 72 20 28 6c 61 6d 62 64 ra:cdaddr (lambd
3470: 61 20 28 6c 73 29 20 28 72 61 3a 63 64 72 20 28 a (ls) (ra:cdr (
3480: 72 61 3a 63 61 72 20 28 72 61 3a 63 64 72 20 28 ra:car (ra:cdr (
3490: 72 61 3a 63 64 72 20 6c 73 29 29 29 29 29 29 0a ra:cdr ls)))))).
34a0: 20 20 28 64 65 66 69 6e 65 20 72 61 3a 63 64 61 (define ra:cda
34b0: 64 61 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 dar (lambda (ls)
34c0: 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 61 72 (ra:cdr (ra:car
34d0: 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 61 72 (ra:cdr (ra:car
34e0: 20 6c 73 29 29 29 29 29 29 0a 20 20 28 64 65 66 ls)))))). (def
34f0: 69 6e 65 20 72 61 3a 63 64 64 61 61 72 20 28 6c ine ra:cddaar (l
3500: 61 6d 62 64 61 20 28 6c 73 29 20 28 72 61 3a 63 ambda (ls) (ra:c
3510: 64 72 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 dr (ra:cdr (ra:c
3520: 61 72 20 28 72 61 3a 63 61 72 20 6c 73 29 29 29 ar (ra:car ls)))
3530: 29 29 29 0a 20 20 28 64 65 66 69 6e 65 20 72 61 ))). (define ra
3540: 3a 63 64 64 61 64 72 20 28 6c 61 6d 62 64 61 20 :cddadr (lambda
3550: 28 6c 73 29 20 28 72 61 3a 63 64 72 20 28 72 61 (ls) (ra:cdr (ra
3560: 3a 63 64 72 20 28 72 61 3a 63 61 72 20 28 72 61 :cdr (ra:car (ra
3570: 3a 63 64 72 20 6c 73 29 29 29 29 29 29 0a 20 20 :cdr ls)))))).
3580: 28 64 65 66 69 6e 65 20 72 61 3a 63 64 64 64 64 (define ra:cdddd
3590: 72 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 20 28 r (lambda (ls) (
35a0: 72 61 3a 63 64 72 20 28 72 61 3a 63 64 72 20 28 ra:cdr (ra:cdr (
35b0: 72 61 3a 63 64 72 20 28 72 61 3a 63 64 72 20 6c ra:cdr (ra:cdr l
35c0: 73 29 29 29 29 29 29 0a 20 20 28 64 65 66 69 6e s)))))). (defin
35d0: 65 20 72 61 3a 63 64 64 64 61 72 20 28 6c 61 6d e ra:cdddar (lam
35e0: 62 64 61 20 28 6c 73 29 20 28 72 61 3a 63 64 72 bda (ls) (ra:cdr
35f0: 20 28 72 61 3a 63 64 72 20 28 72 61 3a 63 64 72 (ra:cdr (ra:cdr
3600: 20 28 72 61 3a 63 61 72 20 6c 73 29 29 29 29 29 (ra:car ls)))))
3610: 29 0a 20 20 0a 20 20 3b 3b 20 5b 52 61 4c 69 73 ). . ;; [RaLis
3620: 74 20 58 5d 20 2d 3e 20 4e 61 74 0a 20 20 28 64 t X] -> Nat. (d
3630: 65 66 69 6e 65 20 28 72 61 3a 6c 65 6e 67 74 68 efine (ra:length
3640: 20 6c 73 29 0a 20 20 20 20 28 61 73 73 65 72 74 ls). (assert
3650: 20 28 72 61 3a 6c 69 73 74 3f 20 6c 73 29 29 0a (ra:list? ls)).
3660: 20 20 20 20 28 6c 65 74 20 72 65 63 72 20 28 28 (let recr ((
3670: 6c 73 20 6c 73 29 29 0a 20 20 20 20 20 20 28 69 ls ls)). (i
3680: 66 20 28 6b 6f 6e 73 3f 20 6c 73 29 0a 20 20 20 f (kons? ls).
3690: 20 20 20 20 20 20 20 28 2b 20 28 6b 6f 6e 73 2d (+ (kons-
36a0: 73 69 7a 65 20 6c 73 29 20 28 72 65 63 72 20 28 size ls) (recr (
36b0: 6b 6f 6e 73 2d 72 65 73 74 20 6c 73 29 29 29 0a kons-rest ls))).
36c0: 20 20 20 20 20 20 20 20 20 20 30 29 29 29 0a 0a 0)))..
36d0: 20 20 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d (define (make-
36e0: 66 6f 6c 64 6c 20 65 6d 70 74 79 3f 20 66 69 72 foldl empty? fir
36f0: 73 74 20 72 65 73 74 29 0a 20 20 20 20 28 6c 65 st rest). (le
3700: 74 72 65 63 20 28 28 66 20 28 6c 61 6d 62 64 61 trec ((f (lambda
3710: 20 28 63 6f 6e 73 20 65 6d 70 74 79 20 6c 73 29 (cons empty ls)
3720: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3730: 20 20 20 28 69 66 20 28 65 6d 70 74 79 3f 20 6c (if (empty? l
3740: 73 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 s) .
3750: 20 20 20 20 20 20 20 20 20 20 65 6d 70 74 79 0a empty.
3760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3770: 20 20 20 20 20 20 28 66 20 63 6f 6e 73 0a 20 20 (f cons.
3780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3790: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 66 69 (cons (fi
37a0: 72 73 74 20 6c 73 29 20 65 6d 70 74 79 29 20 0a rst ls) empty) .
37b0: 20 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 28 72 65 73 74 20 6c (rest l
37d0: 73 29 29 29 29 29 29 0a 20 20 20 20 20 20 66 29 s)))))). f)
37e0: 29 0a 20 20 0a 20 20 28 64 65 66 69 6e 65 20 28 ). . (define (
37f0: 6d 61 6b 65 2d 66 6f 6c 64 72 20 65 6d 70 74 79 make-foldr empty
3800: 3f 20 66 69 72 73 74 20 72 65 73 74 29 0a 20 20 ? first rest).
3810: 20 20 28 6c 65 74 72 65 63 20 28 28 66 20 28 6c (letrec ((f (l
3820: 61 6d 62 64 61 20 28 63 6f 6e 73 20 65 6d 70 74 ambda (cons empt
3830: 79 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 y ls).
3840: 20 20 20 20 20 20 20 20 28 69 66 20 28 65 6d 70 (if (emp
3850: 74 79 3f 20 6c 73 29 20 0a 20 20 20 20 20 20 20 ty? ls) .
3860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 65 e
3870: 6d 70 74 79 0a 20 20 20 20 20 20 20 20 20 20 20 mpty.
3880: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 (cons
3890: 20 28 66 69 72 73 74 20 6c 73 29 0a 20 20 20 20 (first ls).
38a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38b0: 20 20 20 20 20 20 20 20 28 66 20 63 6f 6e 73 20 (f cons
38c0: 65 6d 70 74 79 20 28 72 65 73 74 20 6c 73 29 29 empty (rest ls))
38d0: 29 29 29 29 29 0a 20 20 20 20 20 20 66 29 29 0a ))))). f)).
38e0: 0a 20 20 3b 3b 20 5b 58 20 59 20 2d 3e 20 59 5d . ;; [X Y -> Y]
38f0: 20 59 20 5b 52 61 4c 69 73 74 6f 66 20 58 5d 20 Y [RaListof X]
3900: 2d 3e 20 59 0a 20 20 28 64 65 66 69 6e 65 20 72 -> Y. (define r
3910: 61 3a 66 6f 6c 64 6c 2f 31 20 28 6d 61 6b 65 2d a:foldl/1 (make-
3920: 66 6f 6c 64 6c 20 72 61 3a 6e 75 6c 6c 3f 20 72 foldl ra:null? r
3930: 61 3a 63 61 72 20 72 61 3a 63 64 72 29 29 0a 20 a:car ra:cdr)).
3940: 20 28 64 65 66 69 6e 65 20 72 61 3a 66 6f 6c 64 (define ra:fold
3950: 72 2f 31 20 28 6d 61 6b 65 2d 66 6f 6c 64 72 20 r/1 (make-foldr
3960: 72 61 3a 6e 75 6c 6c 3f 20 72 61 3a 63 61 72 20 ra:null? ra:car
3970: 72 61 3a 63 64 72 29 29 0a 0a 20 20 3b 3b 20 5b ra:cdr)).. ;; [
3980: 52 61 4c 69 73 74 6f 66 20 58 5d 20 2e 2e 2e 20 RaListof X] ...
3990: 2d 3e 20 5b 52 61 4c 69 73 74 6f 66 20 58 5d 0a -> [RaListof X].
39a0: 20 20 28 64 65 66 69 6e 65 20 28 72 61 3a 61 70 (define (ra:ap
39b0: 70 65 6e 64 20 2e 20 6c 73 73 29 0a 20 20 20 20 pend . lss).
39c0: 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 6c 73 (cond ((null? ls
39d0: 73 29 20 72 61 3a 6e 75 6c 6c 29 0a 20 20 20 20 s) ra:null).
39e0: 20 20 20 20 20 20 28 65 6c 73 65 20 28 6c 65 74 (else (let
39f0: 20 72 65 63 72 20 28 28 6c 73 73 20 6c 73 73 29 recr ((lss lss)
3a00: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3a10: 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c (cond ((null
3a20: 3f 20 28 63 64 72 20 6c 73 73 29 29 20 28 63 61 ? (cdr lss)) (ca
3a30: 72 20 6c 73 73 29 29 0a 20 20 20 20 20 20 20 20 r lss)).
3a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a50: 28 65 6c 73 65 20 28 72 61 3a 66 6f 6c 64 72 2f (else (ra:foldr/
3a60: 31 20 72 61 3a 63 6f 6e 73 0a 20 20 20 20 20 20 1 ra:cons.
3a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a90: 20 20 20 20 28 72 65 63 72 20 28 63 64 72 20 6c (recr (cdr l
3aa0: 73 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ss)).
3ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3ad0: 63 61 72 20 6c 73 73 29 29 29 29 29 29 29 29 0a car lss)))))))).
3ae0: 20 20 0a 20 20 3b 3b 20 5b 52 61 4c 69 73 74 6f . ;; [RaListo
3af0: 66 20 58 5d 20 2d 3e 20 5b 52 61 4c 69 73 74 6f f X] -> [RaListo
3b00: 66 20 58 5d 0a 20 20 28 64 65 66 69 6e 65 20 28 f X]. (define (
3b10: 72 61 3a 72 65 76 65 72 73 65 20 6c 73 29 0a 20 ra:reverse ls).
3b20: 20 20 20 28 72 61 3a 66 6f 6c 64 6c 2f 31 20 72 (ra:foldl/1 r
3b30: 61 3a 63 6f 6e 73 20 72 61 3a 6e 75 6c 6c 20 6c a:cons ra:null l
3b40: 73 29 29 0a 20 20 0a 20 20 3b 3b 20 5b 52 61 4c s)). . ;; [RaL
3b50: 69 73 74 6f 66 20 58 5d 20 4e 61 74 20 2d 3e 20 istof X] Nat ->
3b60: 5b 52 61 4c 69 73 74 6f 66 20 58 5d 0a 20 20 28 [RaListof X]. (
3b70: 64 65 66 69 6e 65 20 28 72 61 3a 6c 69 73 74 2d define (ra:list-
3b80: 74 61 69 6c 20 6c 73 20 69 29 0a 20 20 20 20 28 tail ls i). (
3b90: 6c 65 74 20 6c 6f 6f 70 20 28 28 78 73 20 6c 73 let loop ((xs ls
3ba0: 29 20 28 6a 20 69 29 29 0a 20 20 20 20 20 20 28 ) (j i)). (
3bb0: 63 6f 6e 64 20 28 28 7a 65 72 6f 3f 20 6a 29 20 cond ((zero? j)
3bc0: 78 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 xs).
3bd0: 28 65 6c 73 65 20 28 6c 6f 6f 70 20 28 72 61 3a (else (loop (ra:
3be0: 63 64 72 20 78 73 29 20 28 73 75 62 31 20 6a 29 cdr xs) (sub1 j)
3bf0: 29 29 29 29 29 0a 20 20 0a 20 20 3b 3b 20 5b 52 ))))). . ;; [R
3c00: 61 4c 69 73 74 6f 66 20 58 5d 20 4e 61 74 20 2d aListof X] Nat -
3c10: 3e 20 58 0a 20 20 3b 3b 20 53 70 65 63 69 61 6c > X. ;; Special
3c20: 2d 63 61 73 65 64 20 61 62 6f 76 65 20 74 6f 20 -cased above to
3c30: 61 76 6f 69 64 20 6c 6f 67 61 72 61 74 68 6d 69 avoid logarathmi
3c40: 63 20 61 6d 6f 75 6e 74 20 6f 66 20 63 6f 6e 73 c amount of cons
3c50: 27 69 6e 67 0a 20 20 3b 3b 20 61 6e 64 20 61 6e 'ing. ;; and an
3c60: 79 20 6d 75 6c 74 69 2d 76 61 6c 75 65 73 20 6f y multi-values o
3c70: 76 65 72 68 65 61 64 2e 20 20 4f 70 65 72 61 74 verhead. Operat
3c80: 65 73 20 69 6e 20 63 6f 6e 73 74 61 6e 74 20 73 es in constant s
3c90: 70 61 63 65 2e 0a 20 20 28 64 65 66 69 6e 65 20 pace.. (define
3ca0: 28 72 61 3a 6c 69 73 74 2d 72 65 66 20 6c 73 20 (ra:list-ref ls
3cb0: 69 29 0a 20 20 20 20 3b 28 61 73 73 65 72 74 20 i). ;(assert
3cc0: 28 3c 20 69 20 28 72 61 3a 6c 65 6e 67 74 68 20 (< i (ra:length
3cd0: 6c 73 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c ls))). (let l
3ce0: 6f 6f 70 20 28 28 78 73 20 6c 73 29 20 28 6a 20 oop ((xs ls) (j
3cf0: 69 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 3c i)). (if (<
3d00: 20 6a 20 28 6b 6f 6e 73 2d 73 69 7a 65 20 78 73 j (kons-size xs
3d10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 72 )). (tr
3d20: 65 65 2d 72 65 66 20 28 6b 6f 6e 73 2d 73 69 7a ee-ref (kons-siz
3d30: 65 20 78 73 29 20 28 6b 6f 6e 73 2d 74 72 65 65 e xs) (kons-tree
3d40: 20 78 73 29 20 6a 29 0a 20 20 20 20 20 20 20 20 xs) j).
3d50: 20 20 28 6c 6f 6f 70 20 28 6b 6f 6e 73 2d 72 65 (loop (kons-re
3d60: 73 74 20 78 73 29 20 28 2d 20 6a 20 28 6b 6f 6e st xs) (- j (kon
3d70: 73 2d 73 69 7a 65 20 78 73 29 29 29 29 29 29 0a s-size xs)))))).
3d80: 20 20 0a 20 20 3b 3b 20 5b 52 61 4c 69 73 74 6f . ;; [RaListo
3d90: 66 20 58 5d 20 4e 61 74 20 58 20 2d 3e 20 5b 52 f X] Nat X -> [R
3da0: 61 4c 69 73 74 6f 66 20 58 5d 0a 20 20 28 64 65 aListof X]. (de
3db0: 66 69 6e 65 20 28 72 61 3a 6c 69 73 74 2d 73 65 fine (ra:list-se
3dc0: 74 20 6c 73 20 69 20 76 29 0a 20 20 20 20 28 6c t ls i v). (l
3dd0: 65 74 2d 76 61 6c 75 65 73 20 28 28 28 5f 20 6c et-values (((_ l
3de0: 2a 29 20 28 72 61 3a 6c 69 73 74 2d 72 65 66 2f *) (ra:list-ref/
3df0: 73 65 74 20 6c 73 20 69 20 76 29 29 29 20 6c 2a set ls i v))) l*
3e00: 29 29 0a 20 20 0a 20 20 3b 3b 20 5b 58 20 2e 2e )). . ;; [X ..
3e10: 2e 20 2d 3e 20 79 5d 20 5b 52 61 4c 69 73 74 6f . -> y] [RaListo
3e20: 66 20 58 5d 20 2e 2e 2e 20 2d 3e 20 5b 52 61 4c f X] ... -> [RaL
3e30: 69 73 74 6f 66 20 59 5d 0a 20 20 3b 3b 20 54 61 istof Y]. ;; Ta
3e40: 6b 65 73 20 61 64 76 61 6e 74 61 67 65 20 6f 66 kes advantage of
3e50: 20 74 68 65 20 66 61 63 74 20 74 68 61 74 20 6d the fact that m
3e60: 61 70 20 70 72 6f 64 75 63 65 73 20 61 20 6c 69 ap produces a li
3e70: 73 74 20 6f 66 20 65 71 75 61 6c 20 73 69 7a 65 st of equal size
3e80: 2e 0a 20 20 28 64 65 66 69 6e 65 20 72 61 3a 6d .. (define ra:m
3e90: 61 70 0a 20 20 20 20 28 63 61 73 65 2d 6c 61 6d ap. (case-lam
3ea0: 62 64 61 20 0a 20 20 20 20 20 20 28 28 66 20 6c bda . ((f l
3eb0: 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 72 s). (let r
3ec0: 65 63 72 20 28 28 6c 73 20 6c 73 29 29 0a 20 20 ecr ((ls ls)).
3ed0: 20 20 20 20 20 20 20 28 69 66 20 28 6b 6f 6e 73 (if (kons
3ee0: 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 ? ls).
3ef0: 20 20 20 28 6d 61 6b 65 2d 6b 6f 6e 73 20 28 6b (make-kons (k
3f00: 6f 6e 73 2d 73 69 7a 65 20 6c 73 29 20 0a 20 20 ons-size ls) .
3f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f20: 20 20 20 20 20 20 28 74 72 65 65 2d 6d 61 70 20 (tree-map
3f30: 66 20 28 6b 6f 6e 73 2d 74 72 65 65 20 6c 73 29 f (kons-tree ls)
3f40: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
3f50: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 63 72 (recr
3f60: 20 28 6b 6f 6e 73 2d 72 65 73 74 20 6c 73 29 29 (kons-rest ls))
3f70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 72 ). r
3f80: 61 3a 6e 75 6c 6c 29 29 29 0a 20 20 20 20 20 20 a:null))).
3f90: 28 28 66 20 2e 20 6c 73 73 29 0a 20 20 20 20 20 ((f . lss).
3fa0: 20 20 3b 28 63 68 65 63 6b 2d 6e 61 72 79 2d 6c ;(check-nary-l
3fb0: 6f 6f 70 2d 61 72 67 73 20 27 72 61 3a 6d 61 70 oop-args 'ra:map
3fc0: 20 28 6c 61 6d 62 64 61 20 28 78 29 20 78 29 20 (lambda (x) x)
3fd0: 66 20 6c 73 73 29 0a 20 20 20 20 20 20 20 28 6c f lss). (l
3fe0: 65 74 20 72 65 63 72 20 28 28 6c 73 73 20 6c 73 et recr ((lss ls
3ff0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 28 63 6f s)). (co
4000: 6e 64 20 28 28 72 61 3a 6e 75 6c 6c 3f 20 28 63 nd ((ra:null? (c
4010: 61 72 20 6c 73 73 29 29 20 72 61 3a 6e 75 6c 6c ar lss)) ra:null
4020: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4030: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 (else.
4040: 20 20 20 20 20 20 20 3b 3b 20 49 4d 50 52 4f 56 ;; IMPROV
4050: 45 20 4d 45 3a 20 6d 61 6b 65 20 6f 6e 65 20 70 E ME: make one p
4060: 61 73 73 20 6f 76 65 72 20 6c 73 73 2e 0a 20 20 ass over lss..
4070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
4080: 61 6b 65 2d 6b 6f 6e 73 20 28 6b 6f 6e 73 2d 73 ake-kons (kons-s
4090: 69 7a 65 20 28 63 61 72 20 6c 73 73 29 29 0a 20 ize (car lss)).
40a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40b0: 20 20 20 20 20 20 20 20 20 20 28 74 72 65 65 2d (tree-
40c0: 6d 61 70 2f 6e 20 66 20 28 6d 61 70 20 6b 6f 6e map/n f (map kon
40d0: 73 2d 74 72 65 65 20 6c 73 73 29 29 0a 20 20 20 s-tree lss)).
40e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40f0: 20 20 20 20 20 20 20 20 28 72 65 63 72 20 28 6d (recr (m
4100: 61 70 20 6b 6f 6e 73 2d 72 65 73 74 20 6c 73 73 ap kons-rest lss
4110: 29 29 29 29 29 29 29 29 29 0a 0a 0a 20 20 3b 3b )))))))))... ;;
4120: 20 5b 58 20 2e 2e 2e 20 2d 3e 20 59 5d 20 5b 52 [X ... -> Y] [R
4130: 61 4c 69 73 74 6f 66 20 58 5d 20 2e 2e 2e 20 2d aListof X] ... -
4140: 3e 20 75 6e 73 70 65 63 69 66 69 65 64 0a 20 20 > unspecified.
4150: 28 64 65 66 69 6e 65 20 72 61 3a 66 6f 72 2d 65 (define ra:for-e
4160: 61 63 68 0a 20 20 20 20 28 63 61 73 65 2d 6c 61 ach. (case-la
4170: 6d 62 64 61 20 0a 20 20 20 20 20 20 28 28 66 20 mbda . ((f
4180: 6c 73 29 0a 20 20 20 20 20 20 20 28 77 68 65 6e ls). (when
4190: 20 28 6b 6f 6e 73 3f 20 6c 73 29 0a 20 20 20 20 (kons? ls).
41a0: 20 20 20 20 20 28 74 72 65 65 2d 66 6f 72 2d 65 (tree-for-e
41b0: 61 63 68 20 66 20 28 6b 6f 6e 73 2d 74 72 65 65 ach f (kons-tree
41c0: 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 28 ls)). (
41d0: 72 61 3a 66 6f 72 2d 65 61 63 68 20 66 20 28 6b ra:for-each f (k
41e0: 6f 6e 73 2d 72 65 73 74 20 6c 73 29 29 29 29 0a ons-rest ls)))).
41f0: 20 20 20 20 20 20 28 28 66 20 2e 20 6c 73 73 29 ((f . lss)
4200: 0a 20 20 20 20 20 20 20 3b 28 63 68 65 63 6b 2d . ;(check-
4210: 6e 61 72 79 2d 6c 6f 6f 70 2d 61 72 67 73 20 27 nary-loop-args '
4220: 72 61 3a 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 ra:map (lambda (
4230: 78 29 20 78 29 20 66 20 6c 73 73 29 0a 20 20 20 x) x) f lss).
4240: 20 20 20 20 28 6c 65 74 20 72 65 63 72 20 28 28 (let recr ((
4250: 6c 73 73 20 6c 73 73 29 29 0a 20 20 20 20 20 20 lss lss)).
4260: 20 20 20 28 77 68 65 6e 20 28 72 61 3a 70 61 69 (when (ra:pai
4270: 72 3f 20 28 63 61 72 20 6c 73 73 29 29 0a 20 20 r? (car lss)).
4280: 20 20 20 20 20 20 20 20 20 28 74 72 65 65 2d 6d (tree-m
4290: 61 70 2f 6e 20 66 20 28 6d 61 70 20 6b 6f 6e 73 ap/n f (map kons
42a0: 2d 74 72 65 65 20 6c 73 73 29 29 0a 20 20 20 20 -tree lss)).
42b0: 20 20 20 20 20 20 20 28 72 65 63 72 20 28 6d 61 (recr (ma
42c0: 70 20 6b 6f 6e 73 2d 72 65 73 74 20 6c 73 73 29 p kons-rest lss)
42d0: 29 29 29 29 29 29 0a 0a 20 20 3b 3b 20 5b 52 61 )))))).. ;; [Ra
42e0: 4c 69 73 74 6f 66 20 58 5d 20 2d 3e 20 5b 4c 69 Listof X] -> [Li
42f0: 73 74 6f 66 20 58 5d 0a 20 20 28 64 65 66 69 6e stof X]. (defin
4300: 65 20 28 72 61 3a 72 61 6e 64 6f 6d 2d 61 63 63 e (ra:random-acc
4310: 65 73 73 2d 6c 69 73 74 2d 3e 6c 69 6e 65 61 72 ess-list->linear
4320: 2d 61 63 63 65 73 73 2d 6c 69 73 74 20 78 29 0a -access-list x).
4330: 20 20 20 20 28 72 61 3a 66 6f 6c 64 72 2f 31 20 (ra:foldr/1
4340: 63 6f 6e 73 20 27 28 29 20 78 29 29 0a 0a 20 20 cons '() x))..
4350: 3b 3b 20 5b 4c 69 73 74 6f 66 20 58 5d 20 2d 3e ;; [Listof X] ->
4360: 20 5b 52 61 4c 69 73 74 6f 66 20 58 5d 0a 20 20 [RaListof X].
4370: 28 64 65 66 69 6e 65 20 28 72 61 3a 6c 69 6e 65 (define (ra:line
4380: 61 72 2d 61 63 63 65 73 73 2d 6c 69 73 74 2d 3e ar-access-list->
4390: 72 61 6e 64 6f 6d 2d 61 63 63 65 73 73 2d 6c 69 random-access-li
43a0: 73 74 20 78 29 0a 20 20 20 20 28 66 6f 6c 64 2d st x). (fold-
43b0: 72 69 67 68 74 20 72 61 3a 63 6f 6e 73 20 27 28 right ra:cons '(
43c0: 29 20 78 29 29 0a 0a 20 20 3b 3b 20 54 68 69 73 ) x)).. ;; This
43d0: 20 63 6f 64 65 20 62 61 73 65 64 20 6f 6e 20 63 code based on c
43e0: 6f 64 65 20 77 72 69 74 74 65 6e 20 62 79 20 41 ode written by A
43f0: 62 64 75 6c 61 7a 69 7a 20 47 68 75 6c 6f 75 6d bdulaziz Ghuloum
4400: 0a 20 20 3b 3b 20 68 74 74 70 3a 2f 2f 69 6b 61 . ;; http://ika
4410: 72 75 73 2d 73 63 68 65 6d 65 2e 6f 72 67 2f 70 rus-scheme.org/p
4420: 69 70 65 72 6d 61 69 6c 2f 69 6b 61 72 75 73 2d ipermail/ikarus-
4430: 75 73 65 72 73 2f 32 30 30 39 2d 53 65 70 74 65 users/2009-Septe
4440: 6d 62 65 72 2f 30 30 30 35 39 35 2e 68 74 6d 6c mber/000595.html
4450: 0a 20 20 28 64 65 66 69 6e 65 20 67 65 74 2d 63 . (define get-c
4460: 61 63 68 65 64 0a 20 20 20 20 28 6c 65 74 20 28 ached. (let (
4470: 28 68 20 28 6d 61 6b 65 2d 65 71 2d 68 61 73 68 (h (make-eq-hash
4480: 74 61 62 6c 65 29 29 29 0a 20 20 20 20 20 20 28 table))). (
4490: 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 lambda (x).
44a0: 20 20 20 28 64 65 66 69 6e 65 20 28 66 20 78 29 (define (f x)
44b0: 0a 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 . (cond
44c0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 70 61 . ((pa
44d0: 69 72 3f 20 78 29 20 28 72 61 3a 63 6f 6e 73 20 ir? x) (ra:cons
44e0: 28 66 20 28 63 61 72 20 78 29 29 20 28 66 20 28 (f (car x)) (f (
44f0: 63 64 72 20 78 29 29 29 29 0a 20 20 20 20 20 20 cdr x)))).
4500: 20 20 20 20 20 28 28 76 65 63 74 6f 72 3f 20 78 ((vector? x
4510: 29 20 28 76 65 63 74 6f 72 2d 6d 61 70 20 66 20 ) (vector-map f
4520: 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 x)). (
4530: 65 6c 73 65 20 78 29 29 29 0a 20 20 20 20 20 20 else x))).
4540: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
4550: 20 28 28 6e 6f 74 20 28 6f 72 20 28 70 61 69 72 ((not (or (pair
4560: 3f 20 78 29 20 28 76 65 63 74 6f 72 3f 20 78 29 ? x) (vector? x)
4570: 29 29 20 78 29 0a 20 20 20 20 20 20 20 20 20 28 )) x). (
4580: 28 68 61 73 68 74 61 62 6c 65 2d 72 65 66 20 68 (hashtable-ref h
4590: 20 78 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 x #f)).
45a0: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 (else.
45b0: 20 28 6c 65 74 20 28 28 76 20 28 66 20 78 29 29 (let ((v (f x))
45c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 68 ). (h
45d0: 61 73 68 74 61 62 6c 65 2d 73 65 74 21 20 68 20 ashtable-set! h
45e0: 78 20 76 29 0a 20 20 20 20 20 20 20 20 20 20 20 x v).
45f0: 20 76 29 29 29 29 29 29 0a 0a 20 20 28 64 65 66 v)))))).. (def
4600: 69 6e 65 2d 73 79 6e 74 61 78 20 72 61 3a 71 75 ine-syntax ra:qu
4610: 6f 74 65 0a 20 20 20 20 28 73 79 6e 74 61 78 2d ote. (syntax-
4620: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28 rules (). (
4630: 28 72 61 3a 71 75 6f 74 65 20 64 61 74 75 6d 29 (ra:quote datum)
4640: 20 28 67 65 74 2d 63 61 63 68 65 64 20 27 64 61 (get-cached 'da
4650: 74 75 6d 29 29 29 29 20 0a 0a 20 20 20 20 20 20 tum)))) ..
4660: 0a 20 20 29 20 3b 20 28 73 72 66 69 20 3a 31 30 . ) ; (srfi :10
4670: 31 20 72 61 6e 64 6f 6d 2d 61 63 63 65 73 73 2d 1 random-access-
4680: 6c 69 73 74 73 29 0a lists).