Artifact
00f9340beba85b4e7212dd5bbd1879da77b379da:
0000: 23 21 72 36 72 73 0a 3b 20 3c 50 4c 41 49 4e 54 #!r6rs.; <PLAINT
0010: 45 58 54 3e 0a 3b 20 43 6f 70 79 72 69 67 68 74 EXT>.; Copyright
0020: 20 28 63 29 20 32 30 30 35 2d 32 30 30 36 20 53 (c) 2005-2006 S
0030: 65 62 61 73 74 69 61 6e 20 45 67 6e 65 72 2e 0a ebastian Egner..
0040: 3b 20 0a 3b 20 50 65 72 6d 69 73 73 69 6f 6e 20 ; .; Permission
0050: 69 73 20 68 65 72 65 62 79 20 67 72 61 6e 74 65 is hereby grante
0060: 64 2c 20 66 72 65 65 20 6f 66 20 63 68 61 72 67 d, free of charg
0070: 65 2c 20 74 6f 20 61 6e 79 20 70 65 72 73 6f 6e e, to any person
0080: 20 6f 62 74 61 69 6e 69 6e 67 0a 3b 20 61 20 63 obtaining.; a c
0090: 6f 70 79 20 6f 66 20 74 68 69 73 20 73 6f 66 74 opy of this soft
00a0: 77 61 72 65 20 61 6e 64 20 61 73 73 6f 63 69 61 ware and associa
00b0: 74 65 64 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f ted documentatio
00c0: 6e 20 66 69 6c 65 73 20 28 74 68 65 0a 3b 20 60 n files (the.; `
00d0: 60 53 6f 66 74 77 61 72 65 27 27 29 2c 20 74 6f `Software''), to
00e0: 20 64 65 61 6c 20 69 6e 20 74 68 65 20 53 6f 66 deal in the Sof
00f0: 74 77 61 72 65 20 77 69 74 68 6f 75 74 20 72 65 tware without re
0100: 73 74 72 69 63 74 69 6f 6e 2c 20 69 6e 63 6c 75 striction, inclu
0110: 64 69 6e 67 0a 3b 20 77 69 74 68 6f 75 74 20 6c ding.; without l
0120: 69 6d 69 74 61 74 69 6f 6e 20 74 68 65 20 72 69 imitation the ri
0130: 67 68 74 73 20 74 6f 20 75 73 65 2c 20 63 6f 70 ghts to use, cop
0140: 79 2c 20 6d 6f 64 69 66 79 2c 20 6d 65 72 67 65 y, modify, merge
0150: 2c 20 70 75 62 6c 69 73 68 2c 0a 3b 20 64 69 73 , publish,.; dis
0160: 74 72 69 62 75 74 65 2c 20 73 75 62 6c 69 63 65 tribute, sublice
0170: 6e 73 65 2c 20 61 6e 64 2f 6f 72 20 73 65 6c 6c nse, and/or sell
0180: 20 63 6f 70 69 65 73 20 6f 66 20 74 68 65 20 53 copies of the S
0190: 6f 66 74 77 61 72 65 2c 20 61 6e 64 20 74 6f 0a oftware, and to.
01a0: 3b 20 70 65 72 6d 69 74 20 70 65 72 73 6f 6e 73 ; permit persons
01b0: 20 74 6f 20 77 68 6f 6d 20 74 68 65 20 53 6f 66 to whom the Sof
01c0: 74 77 61 72 65 20 69 73 20 66 75 72 6e 69 73 68 tware is furnish
01d0: 65 64 20 74 6f 20 64 6f 20 73 6f 2c 20 73 75 62 ed to do so, sub
01e0: 6a 65 63 74 20 74 6f 0a 3b 20 74 68 65 20 66 6f ject to.; the fo
01f0: 6c 6c 6f 77 69 6e 67 20 63 6f 6e 64 69 74 69 6f llowing conditio
0200: 6e 73 3a 0a 3b 20 0a 3b 20 54 68 65 20 61 62 6f ns:.; .; The abo
0210: 76 65 20 63 6f 70 79 72 69 67 68 74 20 6e 6f 74 ve copyright not
0220: 69 63 65 20 61 6e 64 20 74 68 69 73 20 70 65 72 ice and this per
0230: 6d 69 73 73 69 6f 6e 20 6e 6f 74 69 63 65 20 73 mission notice s
0240: 68 61 6c 6c 20 62 65 0a 3b 20 69 6e 63 6c 75 64 hall be.; includ
0250: 65 64 20 69 6e 20 61 6c 6c 20 63 6f 70 69 65 73 ed in all copies
0260: 20 6f 72 20 73 75 62 73 74 61 6e 74 69 61 6c 20 or substantial
0270: 70 6f 72 74 69 6f 6e 73 20 6f 66 20 74 68 65 20 portions of the
0280: 53 6f 66 74 77 61 72 65 2e 0a 3b 20 0a 3b 20 54 Software..; .; T
0290: 48 45 20 53 4f 46 54 57 41 52 45 20 49 53 20 50 HE SOFTWARE IS P
02a0: 52 4f 56 49 44 45 44 20 60 60 41 53 20 49 53 27 ROVIDED ``AS IS'
02b0: 27 2c 20 57 49 54 48 4f 55 54 20 57 41 52 52 41 ', WITHOUT WARRA
02c0: 4e 54 59 20 4f 46 20 41 4e 59 20 4b 49 4e 44 2c NTY OF ANY KIND,
02d0: 0a 3b 20 45 58 50 52 45 53 53 20 4f 52 20 49 4d .; EXPRESS OR IM
02e0: 50 4c 49 45 44 2c 20 49 4e 43 4c 55 44 49 4e 47 PLIED, INCLUDING
02f0: 20 42 55 54 20 4e 4f 54 20 4c 49 4d 49 54 45 44 BUT NOT LIMITED
0300: 20 54 4f 20 54 48 45 20 57 41 52 52 41 4e 54 49 TO THE WARRANTI
0310: 45 53 20 4f 46 0a 3b 20 4d 45 52 43 48 41 4e 54 ES OF.; MERCHANT
0320: 41 42 49 4c 49 54 59 2c 20 46 49 54 4e 45 53 53 ABILITY, FITNESS
0330: 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 FOR A PARTICULA
0340: 52 20 50 55 52 50 4f 53 45 20 41 4e 44 0a 3b 20 R PURPOSE AND.;
0350: 4e 4f 4e 49 4e 46 52 49 4e 47 45 4d 45 4e 54 2e NONINFRINGEMENT.
0360: 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 53 48 41 IN NO EVENT SHA
0370: 4c 4c 20 54 48 45 20 41 55 54 48 4f 52 53 20 4f LL THE AUTHORS O
0380: 52 20 43 4f 50 59 52 49 47 48 54 20 48 4f 4c 44 R COPYRIGHT HOLD
0390: 45 52 53 20 42 45 0a 3b 20 4c 49 41 42 4c 45 20 ERS BE.; LIABLE
03a0: 46 4f 52 20 41 4e 59 20 43 4c 41 49 4d 2c 20 44 FOR ANY CLAIM, D
03b0: 41 4d 41 47 45 53 20 4f 52 20 4f 54 48 45 52 20 AMAGES OR OTHER
03c0: 4c 49 41 42 49 4c 49 54 59 2c 20 57 48 45 54 48 LIABILITY, WHETH
03d0: 45 52 20 49 4e 20 41 4e 20 41 43 54 49 4f 4e 0a ER IN AN ACTION.
03e0: 3b 20 4f 46 20 43 4f 4e 54 52 41 43 54 2c 20 54 ; OF CONTRACT, T
03f0: 4f 52 54 20 4f 52 20 4f 54 48 45 52 57 49 53 45 ORT OR OTHERWISE
0400: 2c 20 41 52 49 53 49 4e 47 20 46 52 4f 4d 2c 20 , ARISING FROM,
0410: 4f 55 54 20 4f 46 20 4f 52 20 49 4e 20 43 4f 4e OUT OF OR IN CON
0420: 4e 45 43 54 49 4f 4e 0a 3b 20 57 49 54 48 20 54 NECTION.; WITH T
0430: 48 45 20 53 4f 46 54 57 41 52 45 20 4f 52 20 54 HE SOFTWARE OR T
0440: 48 45 20 55 53 45 20 4f 52 20 4f 54 48 45 52 20 HE USE OR OTHER
0450: 44 45 41 4c 49 4e 47 53 20 49 4e 20 54 48 45 20 DEALINGS IN THE
0460: 53 4f 46 54 57 41 52 45 2e 0a 3b 20 0a 3b 20 2d SOFTWARE..; .; -
0470: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0480: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0490: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
04a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
04b0: 2d 2d 2d 2d 2d 2d 0a 0a 3b 20 4c 69 67 68 74 77 ------..; Lightw
04c0: 65 69 67 68 74 20 74 65 73 74 69 6e 67 20 28 65 eight testing (e
04d0: 78 61 6d 70 6c 65 73 29 0a 3b 20 3d 3d 3d 3d 3d xamples).; =====
04e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 0a 3b 20 53 65 =========.;.; Se
0500: 62 61 73 74 69 61 6e 2e 45 67 6e 65 72 40 70 68 bastian.Egner@ph
0510: 69 6c 69 70 73 2e 63 6f 6d 0a 3b 20 69 6e 20 52 ilips.com.; in R
0520: 35 52 53 20 2b 20 53 52 46 49 20 32 33 20 28 65 5RS + SRFI 23 (e
0530: 72 72 6f 72 29 20 2b 20 53 52 46 49 20 34 32 20 rror) + SRFI 42
0540: 28 63 6f 6d 70 72 65 68 65 6e 73 69 6f 6e 73 29 (comprehensions)
0550: 0a 3b 0a 3b 20 68 69 73 74 6f 72 79 20 6f 66 20 .;.; history of
0560: 74 68 69 73 20 66 69 6c 65 3a 0a 3b 20 20 20 53 this file:.; S
0570: 45 2c 20 32 35 2d 4f 63 74 2d 32 30 30 34 3a 20 E, 25-Oct-2004:
0580: 66 69 72 73 74 20 76 65 72 73 69 6f 6e 0a 0a 3b first version..;
0590: 20 2d 2d 20 70 6f 72 74 61 62 69 6c 69 74 79 20 -- portability
05a0: 2d 2d 0a 0a 3b 20 50 4c 54 3a 0a 3b 20 28 72 65 --..; PLT:.; (re
05b0: 71 75 69 72 65 20 28 6c 69 62 20 22 32 33 2e 73 quire (lib "23.s
05c0: 73 22 20 22 73 72 66 69 22 29 20 28 6c 69 62 20 s" "srfi") (lib
05d0: 22 34 32 2e 73 73 22 20 22 73 72 66 69 22 29 29 "42.ss" "srfi"))
05e0: 20 28 6c 6f 61 64 20 22 63 68 65 63 6b 2e 73 63 (load "check.sc
05f0: 6d 22 29 0a 3b 20 28 6c 6f 61 64 20 22 65 78 61 m").; (load "exa
0600: 6d 70 6c 65 73 2e 73 63 6d 22 29 0a 0a 3b 20 53 mples.scm")..; S
0610: 63 68 65 6d 65 34 38 3a 20 0a 3b 20 2c 6f 70 65 cheme48: .; ,ope
0620: 6e 20 73 72 66 69 2d 32 33 20 73 72 66 69 2d 34 n srfi-23 srfi-4
0630: 32 0a 3b 20 2c 6c 6f 61 64 20 63 68 65 63 6b 2e 2.; ,load check.
0640: 73 63 6d 20 65 78 61 6d 70 6c 65 73 2e 73 63 6d scm examples.scm
0650: 0a 0a 28 69 6d 70 6f 72 74 20 0a 20 20 28 72 6e ..(import . (rn
0660: 72 73 29 0a 20 20 28 72 6e 72 73 20 72 35 72 73 rs). (rnrs r5rs
0670: 29 0a 20 20 28 73 75 72 66 61 67 65 20 73 34 32 ). (surfage s42
0680: 20 65 61 67 65 72 2d 63 6f 6d 70 72 65 68 65 6e eager-comprehen
0690: 73 69 6f 6e 73 29 0a 20 20 28 73 75 72 66 61 67 sions). (surfag
06a0: 65 20 73 37 38 20 6c 69 67 68 74 77 65 69 67 68 e s78 lightweigh
06b0: 74 2d 74 65 73 74 69 6e 67 29 29 0a 0a 28 63 68 t-testing))..(ch
06c0: 65 63 6b 2d 73 65 74 2d 6d 6f 64 65 21 20 27 72 eck-set-mode! 'r
06d0: 65 70 6f 72 74 2d 66 61 69 6c 65 64 29 0a 0a 3b eport-failed)..;
06e0: 20 2d 2d 20 73 69 6d 70 6c 65 20 74 65 73 74 20 -- simple test
06f0: 2d 2d 0a 0a 28 63 68 65 63 6b 20 28 2b 20 31 20 --..(check (+ 1
0700: 31 29 20 3d 3e 20 32 29 0a 3b 3b 20 28 63 68 65 1) => 2).;; (che
0710: 63 6b 20 28 2b 20 31 20 31 29 20 3d 3e 20 33 29 ck (+ 1 1) => 3)
0720: 20 3b 20 66 61 69 6c 73 0a 0a 3b 20 2d 2d 20 64 ; fails..; -- d
0730: 69 66 66 65 72 65 6e 74 20 65 71 75 61 6c 69 74 ifferent equalit
0740: 79 20 70 72 65 64 69 63 61 74 65 20 2d 2d 0a 0a y predicate --..
0750: 28 63 68 65 63 6b 20 28 76 65 63 74 6f 72 20 31 (check (vector 1
0760: 29 20 3d 3e 20 28 76 65 63 74 6f 72 20 31 29 29 ) => (vector 1))
0770: 0a 0a 3b 3b 20 28 63 68 65 63 6b 20 28 76 65 63 ..;; (check (vec
0780: 74 6f 72 20 31 29 20 28 3d 3e 20 65 71 3f 29 20 tor 1) (=> eq?)
0790: 28 76 65 63 74 6f 72 20 31 29 29 20 3b 20 66 61 (vector 1)) ; fa
07a0: 69 6c 73 0a 0a 3b 20 2d 2d 20 70 61 72 61 6d 65 ils..; -- parame
07b0: 74 72 69 63 20 74 65 73 74 73 20 2d 2d 0a 0a 28 tric tests --..(
07c0: 63 68 65 63 6b 2d 65 63 20 28 2b 20 31 20 31 29 check-ec (+ 1 1)
07d0: 20 3d 3e 20 32 29 0a 0a 28 63 68 65 63 6b 2d 65 => 2)..(check-e
07e0: 63 20 28 3a 20 78 20 31 30 29 20 28 2b 20 78 20 c (: x 10) (+ x
07f0: 31 29 20 3d 3e 20 28 2b 20 78 20 31 29 20 28 78 1) => (+ x 1) (x
0800: 29 29 0a 0a 3b 3b 20 28 63 68 65 63 6b 2d 65 63 ))..;; (check-ec
0810: 20 28 3a 20 65 20 31 30 30 29 20 28 70 6f 73 69 (: e 100) (posi
0820: 74 69 76 65 3f 20 28 65 78 70 74 20 32 20 65 29 tive? (expt 2 e)
0830: 29 20 3d 3e 20 23 74 20 28 65 29 29 20 3b 20 66 ) => #t (e)) ; f
0840: 61 69 6c 73 20 6f 6e 20 66 69 78 6e 75 6d 73 0a ails on fixnums.
0850: 0a 3b 3b 20 28 63 68 65 63 6b 2d 65 63 20 28 3a .;; (check-ec (:
0860: 20 65 20 31 30 30 29 20 28 3a 6c 65 74 20 78 20 e 100) (:let x
0870: 28 65 78 70 74 20 32 2e 30 20 65 29 29 20 28 3d (expt 2.0 e)) (=
0880: 20 28 2b 20 78 20 31 29 20 78 29 20 3d 3e 20 23 (+ x 1) x) => #
0890: 66 20 28 78 29 29 20 3b 20 66 61 69 6c 73 0a 0a f (x)) ; fails..
08a0: 3b 3b 20 28 63 68 65 63 6b 2d 65 63 20 28 3a 20 ;; (check-ec (:
08b0: 65 20 31 30 30 29 20 28 3a 6c 65 74 20 78 20 28 e 100) (:let x (
08c0: 65 78 70 74 20 32 2e 30 20 65 29 29 20 28 3d 20 expt 2.0 e)) (=
08d0: 28 2b 20 78 20 31 29 20 78 29 20 3d 3e 20 23 66 (+ x 1) x) => #f
08e0: 29 0a 0a 28 63 68 65 63 6b 2d 65 63 20 28 3a 20 )..(check-ec (:
08f0: 78 20 31 30 29 20 28 3a 20 79 20 31 30 29 20 28 x 10) (: y 10) (
0900: 3a 20 7a 20 31 30 29 0a 20 20 20 20 20 20 20 20 : z 10).
0910: 20 20 28 2a 20 78 20 28 2b 20 79 20 7a 29 29 20 (* x (+ y z))
0920: 3d 3e 20 28 2b 20 28 2a 20 78 20 79 29 20 28 2a => (+ (* x y) (*
0930: 20 78 20 7a 29 29 0a 20 20 20 20 20 20 20 20 20 x z)).
0940: 20 28 78 20 79 20 7a 29 29 20 3b 20 70 61 73 73 (x y z)) ; pass
0950: 65 73 20 77 69 74 68 20 31 30 5e 33 20 63 61 73 es with 10^3 cas
0960: 65 73 20 63 68 65 63 6b 65 64 0a 0a 3b 20 2d 2d es checked..; --
0970: 20 74 6f 79 20 65 78 61 6d 70 6c 65 73 20 2d 2d toy examples --
0980: 0a 0a 28 64 65 66 69 6e 65 20 28 66 69 62 20 6e ..(define (fib n
0990: 29 0a 20 20 28 69 66 20 28 3c 3d 20 6e 20 32 29 ). (if (<= n 2)
09a0: 20 31 20 28 2b 20 28 66 69 62 20 28 2d 20 6e 20 1 (+ (fib (- n
09b0: 31 29 29 20 28 66 69 62 20 28 2d 20 6e 20 32 29 1)) (fib (- n 2)
09c0: 29 29 29 29 0a 0a 28 63 68 65 63 6b 20 28 66 69 ))))..(check (fi
09d0: 62 20 31 29 20 3d 3e 20 31 29 0a 28 63 68 65 63 b 1) => 1).(chec
09e0: 6b 20 28 66 69 62 20 32 29 20 3d 3e 20 31 29 0a k (fib 2) => 1).
09f0: 28 63 68 65 63 6b 2d 65 63 20 28 3a 20 6e 20 31 (check-ec (: n 1
0a00: 20 33 31 29 20 28 65 76 65 6e 3f 20 28 66 69 62 31) (even? (fib
0a10: 20 6e 29 29 20 3d 3e 20 28 3d 20 28 6d 6f 64 75 n)) => (= (modu
0a20: 6c 6f 20 6e 20 33 29 20 30 29 20 28 6e 29 29 0a lo n 3) 0) (n)).
0a30: 0a 3b 20 2d 2d 20 72 65 70 6f 72 74 69 6e 67 20 .; -- reporting
0a40: 2d 2d 0a 0a 3b 3b 20 28 63 68 65 63 6b 2d 72 65 --..;; (check-re
0a50: 70 6f 72 74 29 0a port).