├── .gitignore ├── LICENSE.txt ├── README.md ├── r6rs-doc ├── info.rkt └── r6rs │ ├── scribblings │ ├── info.rkt │ ├── r6rs-lib-std │ │ ├── index.html │ │ ├── r6rs-lib-Z-G-1.gif │ │ ├── r6rs-lib-Z-G-2.gif │ │ ├── r6rs-lib-Z-G-3.gif │ │ ├── r6rs-lib-Z-G-4.gif │ │ ├── r6rs-lib-Z-H-1.html │ │ ├── r6rs-lib-Z-H-10.html │ │ ├── r6rs-lib-Z-H-11.html │ │ ├── r6rs-lib-Z-H-12.html │ │ ├── r6rs-lib-Z-H-13.html │ │ ├── r6rs-lib-Z-H-14.html │ │ ├── r6rs-lib-Z-H-15.html │ │ ├── r6rs-lib-Z-H-16.html │ │ ├── r6rs-lib-Z-H-17.html │ │ ├── r6rs-lib-Z-H-18.html │ │ ├── r6rs-lib-Z-H-19.html │ │ ├── r6rs-lib-Z-H-2.html │ │ ├── r6rs-lib-Z-H-20.html │ │ ├── r6rs-lib-Z-H-21.html │ │ ├── r6rs-lib-Z-H-3.html │ │ ├── r6rs-lib-Z-H-4.html │ │ ├── r6rs-lib-Z-H-5.html │ │ ├── r6rs-lib-Z-H-6.html │ │ ├── r6rs-lib-Z-H-7.html │ │ ├── r6rs-lib-Z-H-8.html │ │ ├── r6rs-lib-Z-H-9.html │ │ ├── r6rs-lib-Z-S.css │ │ └── r6rs-lib.html │ ├── r6rs-std │ │ ├── index.html │ │ ├── r6rs-Z-G-1.gif │ │ ├── r6rs-Z-G-10.gif │ │ ├── r6rs-Z-G-11.gif │ │ ├── r6rs-Z-G-12.gif │ │ ├── r6rs-Z-G-13.gif │ │ ├── r6rs-Z-G-14.gif │ │ ├── r6rs-Z-G-15.gif │ │ ├── r6rs-Z-G-16.gif │ │ ├── r6rs-Z-G-17.gif │ │ ├── r6rs-Z-G-18.gif │ │ ├── r6rs-Z-G-19.gif │ │ ├── r6rs-Z-G-2.gif │ │ ├── r6rs-Z-G-20.gif │ │ ├── r6rs-Z-G-21.gif │ │ ├── r6rs-Z-G-22.gif │ │ ├── r6rs-Z-G-23.gif │ │ ├── r6rs-Z-G-24.gif │ │ ├── r6rs-Z-G-25.gif │ │ ├── r6rs-Z-G-26.gif │ │ ├── r6rs-Z-G-27.gif │ │ ├── r6rs-Z-G-28.gif │ │ ├── r6rs-Z-G-3.gif │ │ ├── r6rs-Z-G-4.gif │ │ ├── r6rs-Z-G-5.gif │ │ ├── r6rs-Z-G-6.gif │ │ ├── r6rs-Z-G-7.gif │ │ ├── r6rs-Z-G-8.gif │ │ ├── r6rs-Z-G-9.gif │ │ ├── r6rs-Z-G-D-1.gif │ │ ├── r6rs-Z-G-D-10.gif │ │ ├── r6rs-Z-G-D-11.gif │ │ ├── r6rs-Z-G-D-12.gif │ │ ├── r6rs-Z-G-D-13.gif │ │ ├── r6rs-Z-G-D-14.gif │ │ ├── r6rs-Z-G-D-15.gif │ │ ├── r6rs-Z-G-D-2.gif │ │ ├── r6rs-Z-G-D-3.gif │ │ ├── r6rs-Z-G-D-4.gif │ │ ├── r6rs-Z-G-D-5.gif │ │ ├── r6rs-Z-G-D-6.gif │ │ ├── r6rs-Z-G-D-7.gif │ │ ├── r6rs-Z-G-D-8.gif │ │ ├── r6rs-Z-G-D-9.gif │ │ ├── r6rs-Z-H-1.html │ │ ├── r6rs-Z-H-10.html │ │ ├── r6rs-Z-H-11.html │ │ ├── r6rs-Z-H-12.html │ │ ├── r6rs-Z-H-13.html │ │ ├── r6rs-Z-H-14.html │ │ ├── r6rs-Z-H-15.html │ │ ├── r6rs-Z-H-16.html │ │ ├── r6rs-Z-H-17.html │ │ ├── r6rs-Z-H-18.html │ │ ├── r6rs-Z-H-19.html │ │ ├── r6rs-Z-H-2.html │ │ ├── r6rs-Z-H-20.html │ │ ├── r6rs-Z-H-21.html │ │ ├── r6rs-Z-H-3.html │ │ ├── r6rs-Z-H-4.html │ │ ├── r6rs-Z-H-5.html │ │ ├── r6rs-Z-H-6.html │ │ ├── r6rs-Z-H-7.html │ │ ├── r6rs-Z-H-8.html │ │ ├── r6rs-Z-H-9.html │ │ ├── r6rs-Z-S.css │ │ └── r6rs.html │ └── r6rs.scrbl │ └── tests │ └── test-docs-complete.rkt ├── r6rs-lib ├── info.rkt ├── r6rs │ ├── info.rkt │ ├── lang │ │ └── reader.rkt │ ├── main.rkt │ ├── private │ │ ├── base-for-syntax.rkt │ │ ├── check-pattern.rkt │ │ ├── conds.rkt │ │ ├── encode-name.rkt │ │ ├── exns.rkt │ │ ├── find-version.rkt │ │ ├── identifier-syntax.rkt │ │ ├── inline-rules.rkt │ │ ├── io-conds.rkt │ │ ├── no-set.rkt │ │ ├── num-inline.rkt │ │ ├── parse-ref.rkt │ │ ├── ports.rkt │ │ ├── prelims.rkt │ │ ├── qq-gen.rkt │ │ ├── readtable.rkt │ │ ├── reconstruct.rkt │ │ ├── records-core.rkt │ │ ├── records-explicit.rkt │ │ └── vector-types.rkt │ └── run.rkt └── rnrs │ ├── arithmetic │ ├── bitwise-6.rkt │ ├── fixnums-6.rkt │ └── flonums-6.rkt │ ├── base-6.rkt │ ├── bytevectors-6.rkt │ ├── conditions-6.rkt │ ├── control-6.rkt │ ├── enums-6.rkt │ ├── eval-6.rkt │ ├── exceptions-6.rkt │ ├── files-6.rkt │ ├── hashtables-6.rkt │ ├── io │ ├── ports-6.rkt │ └── simple-6.rkt │ ├── lists-6.rkt │ ├── main-6.rkt │ ├── main.rkt │ ├── mutable-pairs-6.rkt │ ├── mutable-strings-6.rkt │ ├── programs-6.rkt │ ├── r5rs-6.rkt │ ├── records │ ├── inspection-6.rkt │ ├── procedural-6.rkt │ └── syntactic-6.rkt │ ├── sorting-6.rkt │ ├── syntax-case-6.rkt │ └── unicode-6.rkt ├── r6rs-test ├── info.rkt └── tests │ └── r6rs │ ├── README.txt │ ├── arithmetic │ ├── bitwise.sls │ ├── fixnums.sls │ └── flonums.sls │ ├── base.sls │ ├── bytevectors.sls │ ├── conditions.sls │ ├── contrib.sls │ ├── contrib │ └── helper1.sls │ ├── control.sls │ ├── enums.sls │ ├── eval.sls │ ├── exceptions.sls │ ├── hashtables.sls │ ├── info.rkt │ ├── io │ ├── ports.sls │ ├── simple.sls │ └── sync.rkt │ ├── lists.sls │ ├── mutable-pairs.sls │ ├── mutable-strings.sls │ ├── programs.sls │ ├── r5rs.sls │ ├── reader.sls │ ├── records │ ├── procedural.sls │ └── syntactic.sls │ ├── run-via-eval.sps │ ├── run.sps │ ├── run │ ├── arithmetic │ │ ├── bitwise.sps │ │ ├── fixnums.sps │ │ └── flonums.sps │ ├── base.sps │ ├── bytevectors.sps │ ├── conditions.sps │ ├── contrib.sps │ ├── control.sps │ ├── enums.sps │ ├── eval.sps │ ├── exceptions.sps │ ├── hashtables.sps │ ├── io │ │ ├── ports.sps │ │ └── simple.sps │ ├── lists.sps │ ├── mutable-pairs.sps │ ├── mutable-strings.sps │ ├── programs.sps │ ├── r5rs.sps │ ├── reader.sps │ ├── records │ │ ├── procedural.sps │ │ └── syntactic.sps │ ├── run.sps │ ├── sorting.sps │ ├── syntax-case.sps │ ├── test.sps │ └── unicode.sps │ ├── sorting.sls │ ├── syntax-case.sls │ ├── test.sls │ └── unicode.sls └── r6rs └── info.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | # Racket compiled files 2 | compiled/ 3 | 4 | # common backups, autosaves, lock files, OS meta-files 5 | *~ 6 | \#* 7 | .#* 8 | .DS_Store 9 | *.bak 10 | TAGS 11 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | This component of Racket is distributed under the under the Apache 2.0 2 | and MIT licenses. The user can choose the license under which they 3 | will be using the software. There may be other licenses within the 4 | distribution with which the user must also comply. 5 | 6 | See the files 7 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-APACHE.txt 8 | and 9 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt 10 | for the full text of the licenses. 11 | 12 | This repository contains the text of the R6RS standard, in 13 | r6rs-doc/r6rs/scribblings/r6rs-{lib-std,std}/. That document is 14 | distributed under the SchemeReport license: 15 | 16 | We intend this report to belong to the entire Scheme community, 17 | and so we grant permission to copy it in whole or in part without 18 | fee. In particular, we encourage implementors of Scheme to use 19 | this report as a starting point for manuals and other 20 | documentation, modifying it as necessary. 21 | 22 | 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # r6rs 2 | 3 | This the source for the Racket packages: "r6rs", "r6rs-doc", "r6rs-lib", "r6rs-test". 4 | 5 | ### Contributing 6 | 7 | Contribute to Racket by submitting a [pull request], reporting an 8 | [issue], joining the [development mailing list], or visiting the 9 | IRC or Slack channels. 10 | 11 | ### License 12 | 13 | Racket, including these packages, is free software, see [LICENSE] 14 | for more details. 15 | 16 | By making a contribution, you are agreeing that your contribution 17 | is licensed under the [Apache 2.0] license and the [MIT] license. 18 | 19 | [MIT]: https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt 20 | [Apache 2.0]: https://www.apache.org/licenses/LICENSE-2.0.txt 21 | [pull request]: https://github.com/racket/r6rs/pulls 22 | [issue]: https://github.com/racket/r6rs/issues 23 | [development mailing list]: https://lists.racket-lang.org 24 | [LICENSE]: LICENSE 25 | -------------------------------------------------------------------------------- /r6rs-doc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define build-deps '("racket-index" 6 | "r5rs-doc" 7 | "base" 8 | "scribble-lib" 9 | "r6rs-lib" 10 | "racket-doc")) 11 | (define update-implies '("r6rs-lib")) 12 | 13 | (define pkg-desc "documentation part of \"r6rs\"") 14 | 15 | (define pkg-authors '(mflatt)) 16 | 17 | (define license 18 | '(SchemeReport AND (Apache-2.0 OR MIT))) 19 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings '(("r6rs.scrbl" (multi-page) (language 1)))) 4 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-G-1.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-G-1.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-G-2.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-G-2.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-G-3.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-G-3.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-G-4.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-G-4.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-H-10.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | r6rs-lib 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 9

25 | File system

26 |

27 |

28 | This chapter describes the (rnrs files (6))library for 29 | operations on the file system. This library, in addition to the 30 | procedures described here, also exports the I/O condition types 31 | described in section 8.1.

32 |

33 |

34 |

35 |
(file-exists? filename)    procedure 
36 |

37 | Filename must be a file name (see 38 | section 8.2.1). The file-exists? procedure 39 | returns #t if the named file exists at the time the procedure 40 | is called, #f otherwise. 41 |

42 |

43 |

44 |

45 |

46 |
(delete-file filename)    procedure 
47 |

48 | Filename must be a file name (see 49 | section 8.2.1). The delete-file procedure 50 | deletes the named file if it exists and can be deleted, and returns 51 | unspecified values. If the file does not exist or cannot be deleted, 52 | an exception with condition type &i/o-filename is raised. 53 |

54 |

55 |

56 |

57 |

58 |
59 |

60 |

[Go to first, previous, next page;   contents;   index]
61 |

62 |

63 |
64 | 65 | 66 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-H-11.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | r6rs-lib 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 10

25 | Command-line access and exit values

26 |

27 |

28 | The procedures described in this section are exported by the 29 | (rnrs programs (6))library.

30 |

31 |

32 |

33 |
(command-line)    procedure 
34 |

35 | Returns a nonempty list of strings. 36 | The first element is an implementation-specific 37 | name for the running top-level program. The remaining elements are command-line 38 | arguments according to the operating system’s conventions. 39 |

40 |

41 |

42 |

43 |

44 |
(exit)    procedure 
45 | 46 |
(exit obj)    procedure 
47 |

48 | Exits the running program and communicates an exit value to the 49 | operating system. If no argument is supplied, the exit 50 | procedure should communicate to the operating system that the program 51 | exited normally. If an argument is supplied, the exit procedure 52 | should translate the argument into an appropriate exit value for the 53 | operating system. If obj is #f, the exit is assumed to 54 | be abnormal. 55 |

56 |

57 |

58 |

59 |

60 |
61 |

62 |

[Go to first, previous, next page;   contents;   index]
63 |

64 |

65 |
66 | 67 | 68 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-H-16.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | r6rs-lib 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 15

25 | Composite library

26 |

27 |

28 | The (rnrs (6)) library is a composite of most of the libraries 29 | described in this report. The only exceptions are: 30 |

31 |

41 | The library exports all procedures and syntactic forms provided by the 42 | component libraries.

43 |

44 | All of the bindings exported by (rnrs (6)) are exported for both run 45 | and expand; see report section on “Import and export levels”.

46 |

47 |

48 |

49 |
50 |

51 |

[Go to first, previous, next page;   contents;   index]
52 |

53 |

54 |
55 | 56 | 57 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-H-17.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | r6rs-lib 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 16

25 | eval

26 |

27 |

28 | The (rnrs eval (6)) library allows a program to create Scheme 29 | expressions as data at run time and evaluate them.

30 |

31 |

32 |

33 |
(eval expression environment)    procedure 
34 |

35 | Evaluates expression in the specified environment and returns its value. 36 | Expression must be a syntactically valid Scheme expression represented as a 37 | datum value, and environment must be an 38 | environment, which can be created using the environment procedure described below.

39 |

40 | If the first argument to eval is determined not to be a syntactically correct 41 | expression, then eval must raise an exception with condition 42 | type &syntax. Specifically, if the first argument to eval is a definition or a splicing begin form containing a 43 | definition, it must raise an exception with condition type &syntax. 44 |

45 |

46 |

47 |

48 |

49 |
(environment import-spec ...)    procedure 
50 |

51 | Import-spec must be a datum representing an 52 | <import spec> (see report 53 | section on “Library form”). 54 | The environment procedure returns an environment corresponding 55 | to import-spec.

56 |

57 | The bindings of the environment represented by the specifier are 58 | immutable: If eval is applied to an expression that is 59 | determined to contain an 60 | assignment to one of the variables of the environment, then eval must 61 | raise an exception with a condition type &assertion.

62 |

63 |

64 | 65 | (library (foo)
66 |   (export)
67 |   (import (rnrs))
68 |   (write
69 |     (eval ’(let ((x 3)) x)
70 |           (environment ’(rnrs))))) 
71 |   writes 3
72 |
73 | (library (foo)
74 |   (export)
75 |   (import (rnrs))
76 |   (write
77 |     (eval
78 |       ’(eval:car (eval:cons 2 4))
79 |       (environment
80 |         ’(prefix (only (rnrs) car cdr cons null?)
81 |                  eval:))))) 
82 |   writes 2
83 |

84 |

85 |

86 |

87 |

88 |

89 |
90 |

91 |

[Go to first, previous, next page;   contents;   index]
92 |

93 |

94 |
95 | 96 | 97 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-H-18.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | r6rs-lib 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 17

25 | Mutable pairs

26 |

27 |

28 | The procedures provided by the (rnrs mutable-pairs (6))library 29 | allow new values to be assigned to the car and cdr fields of 30 | previously allocated pairs.

31 |

32 |

33 |

34 |
(set-car! pair obj)    procedure 
35 |

36 | Stores obj in the car field of pair. 37 | The set-car! procedure returns unspecified values.

38 |

39 |

40 | 41 | (define (f) (list ’not-a-constant-list))
42 | (define (g) ’(constant-list))
43 | (set-car! (f) 3)                     ⇒  unspecified
44 | (set-car! (g) 3)                     ⇒  unspecified
45 | ; should raise  &assertion exception
46 |

47 |

48 | If an immutable pair is passed to set-car!, an exception 49 | with condition type &assertion should be raised. 50 |

51 |

52 |

53 |

54 |

55 |
(set-cdr! pair obj)    procedure 
56 |

57 | Stores obj in the cdr field of pair. 58 | The set-cdr! procedure returns unspecified values.

59 |

60 | If an immutable pair is passed to set-cdr!, an exception 61 | with condition type &assertion should be raised.

62 |

63 |

64 | 65 | (let ((x (list ’a ’b ’c ’a))
66 |       (y (list ’a ’b ’c ’a ’b ’c ’a)))
67 |   (set-cdr! (list-tail x 2) x)
68 |   (set-cdr! (list-tail y 5) y)
69 |   (list
70 |    (equal? x x)
71 |    (equal? x y)
72 |    (equal? (list x y ’a) (list y x ’b)))) 
                ⇒  (#t #t #f)
73 |

74 |

75 |

76 |

77 |

78 |

79 |
80 |

81 |

[Go to first, previous, next page;   contents;   index]
82 |

83 |

84 |
85 | 86 | 87 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-H-19.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | r6rs-lib 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 18

25 | Mutable strings

26 |

27 |

28 | The string-set! procedure provided by the (rnrs mutable-strings (6))library allows mutating the characters of a string in-place.

29 |

30 |

31 |

32 |
(string-set! string k char)    procedure 
33 |

34 |

35 | 36 |

K must be a valid index of string. 37 | The string-set! procedure stores char in element

38 | 39 |

k of string 40 | and returns unspecified values.

41 |

42 | Passing an immutable string to string-set! should cause an exception 43 | with condition type &assertion to be raised. 44 |

45 | 46 | (define (f) (make-string 3 #\*))
47 | (define (g) "***")
48 | (string-set! (f) 0 #\?)          ⇒  unspecified
49 | (string-set! (g) 0 #\?)          ⇒  unspecified
50 |              ; should raise  &assertion exception
51 | (string-set! (symbol->string ’immutable)
52 |              0
53 |              #\?)          ⇒  unspecified
54 |              ; should raise  &assertion exception

55 |

56 |

57 |
Note:   58 | Implementors should make string-set! run in constant 59 | time. 60 |
61 |

62 |

63 |

64 |

65 |
(string-fill! string char)    procedure 
66 |

67 | Stores char in every element of the given string and returns unspecified values.

68 |

69 |

70 |

71 |

72 |

73 |

74 |
75 |

76 |

[Go to first, previous, next page;   contents;   index]
77 |

78 |

79 |
80 | 81 | 82 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-H-5.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | r6rs-lib 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 4

25 | Sorting

26 |

27 |

28 | This chapter describes the (rnrs sorting (6))library for 29 | sorting lists and vectors.

30 |

31 |

32 |

33 |
(list-sort proc list)    procedure 
34 | 35 |
(vector-sort proc vector)    procedure 
36 |

37 | Proc should accept any two elements 38 | of list or vector, and should not have any side 39 | effects. Proc should return a true value when its first argument 40 | is strictly less than its second, and #f otherwise.

41 |

42 | The list-sort and vector-sort procedures perform a stable 43 | sort of list or vector in ascending order according to 44 | proc, without changing list or 45 | vector in any way. The list-sort procedure returns a 46 | list, and vector-sort returns a vector. The results may be eq? to the argument when the argument is already sorted, and the 47 | result of list-sort may share structure with a tail of the 48 | original list. The sorting algorithm performs O(n lg n) calls to 49 | proc where n is the length of list or vector, 50 | and all arguments passed to proc are elements of the list or 51 | vector being sorted, but the pairing of arguments and the sequencing 52 | of calls to proc are not specified. 53 | If multiple returns occur from list-sort or vector-sort, the return 54 | values returned by earlier returns are not mutated.

55 |

56 |

57 | 58 | (list-sort < ’(3 5 2 1))         ⇒ (1 2 3 5)
59 | (vector-sort < ’#(3 5 2 1))         ⇒ #(1 2 3 5)

60 |

61 | Implementation responsibilities: The implementation must check the restrictions 62 | on proc to the extent performed by applying it as described. 63 | An 64 | implementation may check whether proc is an appropriate argument 65 | before applying it. 66 |

67 |

68 |

69 |

70 |

71 |
(vector-sort! proc vector)    procedure 
72 |

73 | Proc should accept any two elements 74 | of the vector, and should not have any side 75 | effects. Proc should return a true value when its first 76 | argument is strictly less than its second, and #f otherwise. 77 | The vector-sort! procedure destructively sorts vector in 78 | ascending order according to proc. The sorting algorithm 79 | performs O(n2) calls to proc where n is the length of 80 | vector, and all arguments passed to proc are elements 81 | of the vector being sorted, but the pairing of arguments and the 82 | sequencing of calls to proc are not specified. The sorting 83 | algorithm may be unstable. The procedure returns unspecified values.

84 |

85 |

86 | 87 | (define v (vector 3 5 2 1))
88 | (vector-sort! v)         ⇒ unspecified
89 | v         ⇒ #(1 2 3 5)
90 |

91 | Implementation responsibilities: The implementation must check the restrictions 92 | on proc to the extent performed by applying it as described. 93 | An 94 | implementation may check whether proc is an appropriate argument 95 | before applying it. 96 |

97 |

98 |

99 |

100 |

101 |
102 |

103 |

[Go to first, previous, next page;   contents;   index]
104 |

105 |

106 |
107 | 108 | 109 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-lib-std/r6rs-lib-Z-S.css: -------------------------------------------------------------------------------- 1 | 2 | body { 3 | color: black; 4 | /* background-color: #e5e5e5;*/ 5 | background-color: #ffffff; 6 | /*background-color: beige;*/ 7 | margin-top: 2em; 8 | margin-bottom: 2em; 9 | /* margin-left: 8%; 10 | margin-right: 8%; */ 11 | } 12 | 13 | @media screen { 14 | body { 15 | margin-left: 8%; 16 | margin-right: 8%; 17 | } 18 | } 19 | 20 | @media print { 21 | body { 22 | text-align: justify; 23 | } 24 | } 25 | 26 | @media print { 27 | a:link, a:visited { 28 | text-decoration: none; 29 | color: black; 30 | } 31 | } 32 | 33 | @media print { 34 | p { 35 | text-indent: 2em; 36 | margin-top: 1ex; 37 | margin-bottom: 0; 38 | } 39 | 40 | } 41 | 42 | h1,h2,h3,h4,h5,h6 { 43 | margin-top: .8em; 44 | margin-bottom: .2em; /* ?? */ 45 | } 46 | 47 | 48 | .title { 49 | font-size: 200%; 50 | font-weight: normal; 51 | margin-top: 2.8em; 52 | text-align: center; 53 | } 54 | 55 | .partheading { 56 | font-size: 100%; 57 | } 58 | 59 | .chapterheading { 60 | font-size: 100%; 61 | } 62 | 63 | .beginsection { 64 | margin-top: 1.8em; 65 | font-size: 100%; 66 | } 67 | 68 | .tiny { 69 | font-size: 40%; 70 | } 71 | 72 | .scriptsize { 73 | font-size: 60%; 74 | } 75 | 76 | .footnotesize { 77 | font-size: 75%; 78 | } 79 | 80 | .small { 81 | font-size: 90%; 82 | } 83 | 84 | .normalsize { 85 | font-size: 100%; 86 | } 87 | 88 | .large { 89 | font-size: 120%; 90 | } 91 | 92 | .largecap { 93 | font-size: 150%; 94 | } 95 | 96 | .largeup { 97 | font-size: 200%; 98 | } 99 | 100 | .huge { 101 | font-size: 300%; 102 | } 103 | 104 | .hugecap { 105 | font-size: 350%; 106 | } 107 | 108 | p.noindent { 109 | text-indent: 0; 110 | } 111 | 112 | pre { 113 | margin-left: 2em; 114 | } 115 | 116 | blockquote { 117 | margin-left: 2em; 118 | } 119 | 120 | .smallskip { 121 | margin-top: 2pt; 122 | margin-bottom: 2pt; 123 | min-height: 4pt; 124 | } 125 | 126 | .medskip { 127 | margin-top: 3pt; 128 | margin-bottom: 3pt; 129 | min-height: 7pt; 130 | /*margin-top: 1.6em; 131 | margin-bottom: 2.4em; 132 | margin-top: 1em; 133 | margin-bottom: 1.5em; */ 134 | /* top and bottom have to be different so successive \...skips cause more spacing? */ 135 | } 136 | 137 | .bigskip { 138 | margin-top: 4pt; 139 | margin-bottom: 4pt; 140 | min-height: 13pt; 141 | /*margin-top: 2.8em; 142 | margin-bottom: 3.4em; 143 | margin-top: 2.4em; 144 | margin-bottom: 1.6em; */ 145 | } 146 | 147 | 148 | ol { 149 | list-style-type: decimal; 150 | } 151 | 152 | ol ol { 153 | list-style-type: lower-alpha; 154 | } 155 | 156 | ol ol ol { 157 | list-style-type: lower-roman; 158 | } 159 | 160 | ol ol ol ol { 161 | list-style-type: upper-alpha; 162 | } 163 | 164 | tt i { 165 | font-family: serif; 166 | } 167 | 168 | .verbatim em { 169 | font-family: serif; 170 | } 171 | 172 | /* 173 | .verbatim { 174 | color: #4d0000; 175 | } 176 | */ 177 | 178 | .scheme em { 179 | color: black; 180 | font-family: serif; 181 | } 182 | 183 | .scheme {color: #993333} /* background punctuation */ 184 | .scheme .selfeval {color: #006600} 185 | .scheme .keyword {color: #660000; font-weight: bold} 186 | .scheme .builtin {color: #660000} 187 | .scheme .global {color: #660066} 188 | .scheme .variable {color: #000066} 189 | .scheme .comment {color: #006666; font-style: oblique} 190 | 191 | .schemeresponse { 192 | color: #006600; 193 | } 194 | 195 | .navigation { 196 | color: #993300; 197 | text-align: right; 198 | font-size: medium; 199 | font-style: italic; 200 | } 201 | 202 | @media print { 203 | .navigation { 204 | display: none; 205 | } 206 | } 207 | 208 | .disable { 209 | /* color: #e5e5e5; */ 210 | color: gray; 211 | } 212 | 213 | .smallcaps { 214 | font-size: 75%; 215 | } 216 | 217 | .smallprint { 218 | color: gray; 219 | font-size: 75%; 220 | text-align: right; 221 | } 222 | 223 | /* 224 | .smallprint hr { 225 | text-align: left; 226 | width: 40%; 227 | } 228 | */ 229 | 230 | .footnoterule { 231 | text-align: left; 232 | width: 40%; 233 | } 234 | 235 | @media print { 236 | .footnoterule { 237 | margin-top: 2em; 238 | } 239 | } 240 | 241 | .colophon { 242 | color: gray; 243 | font-size: 80%; 244 | font-style: italic; 245 | text-align: right; 246 | margin-top: 1em; 247 | } 248 | 249 | @media print { 250 | .colophon .advertisement { 251 | display: none; 252 | } 253 | } 254 | 255 | .colophon a { 256 | color: gray; 257 | } 258 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-1.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-1.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-10.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-10.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-11.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-11.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-12.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-12.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-13.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-13.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-14.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-14.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-15.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-15.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-16.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-16.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-17.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-17.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-18.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-18.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-19.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-19.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-2.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-2.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-20.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-20.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-21.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-21.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-22.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-22.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-23.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-23.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-24.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-24.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-25.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-25.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-26.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-26.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-27.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-27.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-28.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-28.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-3.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-3.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-4.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-4.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-5.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-5.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-6.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-6.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-7.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-7.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-8.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-8.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-9.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-9.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-1.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-1.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-10.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-10.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-11.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-11.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-12.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-12.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-13.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-13.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-14.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-14.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-15.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-15.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-2.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-2.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-3.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-3.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-4.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-4.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-5.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-5.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-6.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-6.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-7.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-7.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-8.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-8.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-9.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/r6rs/e845408e9da00673f1dc886b5ec7133e0056638d/r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-G-D-9.gif -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-H-1.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | Revised^6 Report on the Algorithmic Language Scheme 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
 

25 | Summary

26 |

27 |
28 |

29 |

30 |

31 | The report gives a defining description of the programming language 32 | Scheme. Scheme is a statically scoped and properly tail-recursive 33 | dialect of the Lisp programming language invented by Guy Lewis 34 | Steele Jr. and Gerald Jay Sussman. It was designed to have an 35 | exceptionally clear and simple semantics and few different ways to 36 | form expressions. A wide variety of programming paradigms, including 37 | functional, imperative, and message passing styles, find convenient 38 | expression in Scheme.

39 |

40 | This report is accompanied by a report describing standard 41 | libraries [24]; references to this document are 42 | identified by designations such as “library section” or “library 43 | chapter”. It is also accompanied by a report containing 44 | non-normative appendices [22]. A fourth report gives 45 | some historical background and rationales for many aspects of the 46 | language and its libraries [23].

47 |

48 |

49 |
50 |

51 |

52 |

53 | The individuals listed above are not the sole authors of the text of 54 | the report. Over the years, the following individuals were involved 55 | in discussions contributing to the design of the Scheme language, and 56 | were listed as authors of prior reports:

57 |

58 | Hal Abelson, Norman Adams, David Bartley, Gary Brooks, William 59 | Clinger, R. Kent Dybvig, Daniel Friedman, Robert Halstead, Chris 60 | Hanson, Christopher Haynes, Eugene Kohlbecker, Don Oxley, Kent Pitman, 61 | Jonathan Rees, Guillermo Rozas, Guy L. Steele Jr., Gerald Jay Sussman, and 62 | Mitchell Wand.

63 |

64 | In order to highlight recent contributions, they are not listed as 65 | authors of this version of the report. However, their contribution 66 | and service is gratefully acknowledged.

67 |

68 |

69 |
70 |

71 |

72 |

73 | We intend this report to belong to the entire Scheme community, and so 74 | we grant permission to copy it in whole or in part without fee. In 75 | particular, we encourage implementors of Scheme to use this report as 76 | a starting point for manuals and other documentation, modifying it as 77 | necessary. 78 |

79 |

80 |

81 |
82 |

83 |

84 |

85 | 86 |

87 |

88 |

89 |

90 |

91 |
92 |

93 |

[Go to first, previous, next page;   contents;   index]
94 |

95 |

96 |
97 | 98 | 99 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-H-11.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | Revised^6 Report on the Algorithmic Language Scheme 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 8

25 | Top-level programs

26 |

27 |

28 | A top-level program specifies an entry point for defining and running 29 | a Scheme program. A top-level program specifies a set of libraries to import and 30 | code to run. Through the imported libraries, whether directly or through the 31 | transitive closure of importing, a top-level program defines a complete Scheme 32 | program.

33 |

34 |

35 | 36 |

8.1  Top-level program syntax

37 |

38 |

39 | A top-level program is a delimited piece of text, typically a file, that 40 | has the following form: 41 |

42 | 43 | <import form> <top-level body>

44 | An <import form> has the following form: 45 |

46 | 47 | (import <import spec> ...)

48 | A <top-level body> has the following form: 49 |

50 | 51 | <top-level body form> ...

52 | A <top-level body form> is either a <definition> or an 53 | <expression>.

54 |

55 | The <import form> is identical to the import clause in 56 | libraries (see section 7.1), 57 | and specifies a set of libraries to import. A <top-level 58 | body> is like a <library body> (see 59 | section 7.1), except that 60 | definitions and expressions may occur in any order. Thus, the syntax 61 | specified by <top-level body form> refers to the result of macro 62 | expansion.

63 |

64 | When uses of begin, let-syntax, or letrec-syntax 65 | from the (rnrs base (6)) library 66 | occur in a top-level body prior to the first 67 | expression, they are spliced into the body; see section 11.4.7. 68 | Some or all of the body, including portions wrapped in begin, 69 | let-syntax, or letrec-syntax 70 | forms, may be specified by a syntactic abstraction 71 | (see section 9.2).

72 |

73 |

74 | 75 |

8.2  Top-level program semantics

76 |

A top-level program is executed by treating the program similarly to a library, and 77 | evaluating its definitions and expressions. 78 | The semantics of a top-level body may be roughly explained by 79 | a simple translation into a library body: 80 | Each <expression> that appears before a 81 | definition in 82 | the top-level body is converted into a dummy definition 83 |

84 | 85 | (define <variable> (begin <expression> <unspecified>))

86 | where <variable> is a fresh identifier and <unspecified> 87 | is a side-effect-free expression returning an unspecified value. 88 | (It is generally impossible to determine which forms are 89 | definitions and expressions without concurrently expanding the body, so 90 | the actual translation is somewhat more complicated; see 91 | chapter 10.)

92 |

93 | On platforms that support it, a top-level program may access its command line 94 | by calling the command-line procedure (see library 95 | section on “Command-line access and exit values”).

96 |

97 |

98 |

99 |
100 |

101 |

[Go to first, previous, next page;   contents;   index]
102 |

103 |

104 |
105 | 106 | 107 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-H-17.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | Revised^6 Report on the Algorithmic Language Scheme 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Appendix C

25 | Additional material

26 |

27 |

28 | This report itself, as well as more material related to this report 29 | such as reference implementations of some parts of Scheme and archives of 30 | mailing lists discussing this report is at 31 |

32 |
33 | 34 | http://www.r6rs.org/ 35 |
36 |

37 | The Schemers web site at 38 |

39 |
40 | 41 | http://www.schemers.org/ 42 |
43 | 44 | as well as the Readscheme site at 45 |
46 | 47 | http://library.readscheme.org/ 48 |
49 | 50 | contain extensive Scheme bibliographies, as well as papers, 51 | programs, implementations, and other material related to Scheme.

52 |

53 |

54 |
55 |

56 |

[Go to first, previous, next page;   contents;   index]
57 |

58 |

59 |
60 | 61 | 62 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-H-20.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | Revised^6 Report on the Algorithmic Language Scheme 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 |

23 | 24 |

25 |
26 |

27 |

[Go to first, previous, next page;   contents;   index]
28 |

29 |

30 |
31 | 32 | 33 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-H-5.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 11 | 12 | 13 | Revised^6 Report on the Algorithmic Language Scheme 14 | 15 | 16 | 17 | 18 | 19 |
20 |
[Go to first, previous, next page;   contents;   index]
21 |

22 | 23 |

24 |
Chapter 2

25 | Requirement levels

26 |

27 |

28 | The key words “must”, “must not”, “should”, 29 | “should not”, “recommended”, “may”, and “optional” in this 30 | report are to be interpreted as described in RFC 2119 [3]. 31 | Specifically:

32 |

33 |

34 |
35 |
must
This word means that a statement is an absolute 36 | requirement of the specification. 37 |
must not
This phrase means that a statement is an absolute 38 | prohibition of the specification. 39 |
should
This word, or the adjective “recommended”, means that 40 | valid reasons may exist in particular circumstances to ignore a 41 | statement, but that the implications must be understood and weighed 42 | before choosing a different course. 43 |
should not
This phrase, or the phrase “not recommended”, means 44 | that valid reasons may exist in particular circumstances when the 45 | behavior of a statement is acceptable, but that the implications 46 | should be understood and weighed before choosing the course described 47 | by the statement. 48 |
may
This word, or the adjective “optional”, means that an item 49 | is truly optional. 50 |

51 |

52 | In particular, this report occasionally uses “should” to designate 53 | circumstances that are outside the specification of this report, but 54 | cannot be practically detected by an implementation; see 55 | section 5.4. In such circumstances, a 56 | particular implementation may allow the programmer to ignore the 57 | recommendation of the report and even exhibit reasonable behavior. 58 | However, as the report does not specify the behavior, 59 | these programs may be unportable, that is, their execution might 60 | produce different results on different implementations.

61 |

62 | Moreover, this report occasionally uses the phrase “not required” to note the 63 | absence of an absolute requirement.

64 |

65 |

66 |

67 |
68 |

69 |

[Go to first, previous, next page;   contents;   index]
70 |

71 |

72 |
73 | 74 | 75 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/scribblings/r6rs-std/r6rs-Z-S.css: -------------------------------------------------------------------------------- 1 | 2 | body { 3 | color: black; 4 | /* background-color: #e5e5e5;*/ 5 | background-color: #ffffff; 6 | /*background-color: beige;*/ 7 | margin-top: 2em; 8 | margin-bottom: 2em; 9 | /* margin-left: 8%; 10 | margin-right: 8%; */ 11 | } 12 | 13 | @media screen { 14 | body { 15 | margin-left: 8%; 16 | margin-right: 8%; 17 | } 18 | } 19 | 20 | @media print { 21 | body { 22 | text-align: justify; 23 | } 24 | } 25 | 26 | @media print { 27 | a:link, a:visited { 28 | text-decoration: none; 29 | color: black; 30 | } 31 | } 32 | 33 | @media print { 34 | p { 35 | text-indent: 2em; 36 | margin-top: 1ex; 37 | margin-bottom: 0; 38 | } 39 | 40 | } 41 | 42 | h1,h2,h3,h4,h5,h6 { 43 | margin-top: .8em; 44 | margin-bottom: .2em; /* ?? */ 45 | } 46 | 47 | 48 | .title { 49 | font-size: 200%; 50 | font-weight: normal; 51 | margin-top: 2.8em; 52 | text-align: center; 53 | } 54 | 55 | .partheading { 56 | font-size: 100%; 57 | } 58 | 59 | .chapterheading { 60 | font-size: 100%; 61 | } 62 | 63 | .beginsection { 64 | margin-top: 1.8em; 65 | font-size: 100%; 66 | } 67 | 68 | .tiny { 69 | font-size: 40%; 70 | } 71 | 72 | .scriptsize { 73 | font-size: 60%; 74 | } 75 | 76 | .footnotesize { 77 | font-size: 75%; 78 | } 79 | 80 | .small { 81 | font-size: 90%; 82 | } 83 | 84 | .normalsize { 85 | font-size: 100%; 86 | } 87 | 88 | .large { 89 | font-size: 120%; 90 | } 91 | 92 | .largecap { 93 | font-size: 150%; 94 | } 95 | 96 | .largeup { 97 | font-size: 200%; 98 | } 99 | 100 | .huge { 101 | font-size: 300%; 102 | } 103 | 104 | .hugecap { 105 | font-size: 350%; 106 | } 107 | 108 | p.noindent { 109 | text-indent: 0; 110 | } 111 | 112 | pre { 113 | margin-left: 2em; 114 | } 115 | 116 | blockquote { 117 | margin-left: 2em; 118 | } 119 | 120 | .smallskip { 121 | margin-top: 2pt; 122 | margin-bottom: 2pt; 123 | min-height: 4pt; 124 | } 125 | 126 | .medskip { 127 | margin-top: 3pt; 128 | margin-bottom: 3pt; 129 | min-height: 7pt; 130 | /*margin-top: 1.6em; 131 | margin-bottom: 2.4em; 132 | margin-top: 1em; 133 | margin-bottom: 1.5em; */ 134 | /* top and bottom have to be different so successive \...skips cause more spacing? */ 135 | } 136 | 137 | .bigskip { 138 | margin-top: 4pt; 139 | margin-bottom: 4pt; 140 | min-height: 13pt; 141 | /*margin-top: 2.8em; 142 | margin-bottom: 3.4em; 143 | margin-top: 2.4em; 144 | margin-bottom: 1.6em; */ 145 | } 146 | 147 | 148 | ol { 149 | list-style-type: decimal; 150 | } 151 | 152 | ol ol { 153 | list-style-type: lower-alpha; 154 | } 155 | 156 | ol ol ol { 157 | list-style-type: lower-roman; 158 | } 159 | 160 | ol ol ol ol { 161 | list-style-type: upper-alpha; 162 | } 163 | 164 | tt i { 165 | font-family: serif; 166 | } 167 | 168 | .verbatim em { 169 | font-family: serif; 170 | } 171 | 172 | /* 173 | .verbatim { 174 | color: #4d0000; 175 | } 176 | */ 177 | 178 | .scheme em { 179 | color: black; 180 | font-family: serif; 181 | } 182 | 183 | .scheme {color: #993333} /* background punctuation */ 184 | .scheme .selfeval {color: #006600} 185 | .scheme .keyword {color: #660000; font-weight: bold} 186 | .scheme .builtin {color: #660000} 187 | .scheme .global {color: #660066} 188 | .scheme .variable {color: #000066} 189 | .scheme .comment {color: #006666; font-style: oblique} 190 | 191 | .schemeresponse { 192 | color: #006600; 193 | } 194 | 195 | .navigation { 196 | color: #993300; 197 | text-align: right; 198 | font-size: medium; 199 | font-style: italic; 200 | } 201 | 202 | @media print { 203 | .navigation { 204 | display: none; 205 | } 206 | } 207 | 208 | .disable { 209 | /* color: #e5e5e5; */ 210 | color: gray; 211 | } 212 | 213 | .smallcaps { 214 | font-size: 75%; 215 | } 216 | 217 | .smallprint { 218 | color: gray; 219 | font-size: 75%; 220 | text-align: right; 221 | } 222 | 223 | /* 224 | .smallprint hr { 225 | text-align: left; 226 | width: 40%; 227 | } 228 | */ 229 | 230 | .footnoterule { 231 | text-align: left; 232 | width: 40%; 233 | } 234 | 235 | @media print { 236 | .footnoterule { 237 | margin-top: 2em; 238 | } 239 | } 240 | 241 | .colophon { 242 | color: gray; 243 | font-size: 80%; 244 | font-style: italic; 245 | text-align: right; 246 | margin-top: 1em; 247 | } 248 | 249 | @media print { 250 | .colophon .advertisement { 251 | display: none; 252 | } 253 | } 254 | 255 | .colophon a { 256 | color: gray; 257 | } 258 | -------------------------------------------------------------------------------- /r6rs-doc/r6rs/tests/test-docs-complete.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require rackunit/docs-complete) 3 | (check-docs (quote r6rs/run)) 4 | (check-docs (quote r6rs)) 5 | -------------------------------------------------------------------------------- /r6rs-lib/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps '("scheme-lib" 6 | ["base" #:version "8.16.0.4"] 7 | "r5rs-lib" 8 | "compatibility-lib")) 9 | 10 | (define pkg-desc "implementation (no documentation) part of \"r6rs\"") 11 | 12 | (define pkg-authors '(mflatt)) 13 | 14 | (define license 15 | '(Apache-2.0 OR MIT)) 16 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define mzscheme-launcher-names '("PLT R6RS")) 4 | (define mzscheme-launcher-libraries '("run.rkt")) 5 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp syntax/module-reader 2 | 3 | r6rs 4 | 5 | #:wrapper1 with-r6rs-reader-parameters 6 | #:language-info '#(scheme/language-info get-info #f) 7 | 8 | (require "../private/readtable.rkt") 9 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/base-for-syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | ;; This module exists for documentaiton purposes: the 4 | ;; for-syntax exports of `rnrs/base-6' are exported 5 | ;; from here in phase 0 6 | 7 | (require r6rs/private/identifier-syntax 8 | (for-syntax scheme/base 9 | "check-pattern.rkt")) 10 | 11 | (provide (rename-out [r6rs:syntax-rules syntax-rules]) 12 | identifier-syntax 13 | ... 14 | _) 15 | 16 | (define-syntax (r6rs:syntax-rules stx) 17 | (syntax-case stx () 18 | [(_ (lit ...) [pat tmpl] ...) 19 | (let ([lits (syntax->list #'(lit ...))]) 20 | (for-each 21 | (lambda (lit) 22 | (unless (identifier? lit) 23 | (raise-syntax-error #f 24 | "literal is not an identifier" 25 | stx 26 | lit)) 27 | (when (or (free-identifier=? lit (quote-syntax ...)) 28 | (free-identifier=? lit #'_)) 29 | (raise-syntax-error #f 30 | "not allowed as a literal" 31 | stx 32 | lit))) 33 | lits) 34 | (for-each (check-pat-ellipses stx) (syntax->list #'(pat ...))) 35 | (syntax-case stx () 36 | [(_ . rest) 37 | (syntax/loc stx (syntax-rules . rest))]))] 38 | [(_ . rest) 39 | (syntax/loc stx (syntax-rules . rest))])) 40 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/check-pattern.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require (for-template (only-in scheme/base ...))) 4 | 5 | (provide check-pat-ellipses) 6 | 7 | (define ((check-pat-ellipses orig-stx) stx) 8 | (let loop ([stx stx][car-ok? #f]) 9 | (cond 10 | [(syntax? stx) (loop (syntax-e stx) car-ok?)] 11 | [(pair? stx) 12 | (if (and (not car-ok?) 13 | (identifier? (car stx)) 14 | (free-identifier=? (car stx) (quote-syntax ...))) 15 | (raise-syntax-error #f 16 | "ellipsis without preceding form" 17 | orig-stx 18 | (car stx)) 19 | (begin (loop (car stx) #f) 20 | (loop (cdr stx) #t)))] 21 | [(vector? stx) 22 | (for-each (lambda (stx) (loop stx #f)) (vector->list stx))] 23 | [else (void)]))) 24 | 25 | 26 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/encode-name.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (provide encode-name) 4 | 5 | (define (encode-name s) 6 | (let ([s (if (symbol? s) 7 | (symbol->string s) 8 | s)]) 9 | (cond 10 | [(regexp-match #rx"(.*?)([^a-zA-Z0-9_+-]+)(.*)" s) 11 | => (lambda (m) 12 | (string-append 13 | (cadr m) 14 | (apply 15 | string-append 16 | (map (lambda (c) 17 | (let ([s (format "0~x" c)]) 18 | (string-append 19 | "%" 20 | (substring s (- (string-length s) 2))))) 21 | (bytes->list (string->bytes/utf-8 (caddr m))))) 22 | (encode-name (cadddr m))))] 23 | [else s]))) 24 | 25 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/exns.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (provide (struct-out exn:fail:r6rs) 4 | (struct-out exn:fail:contract:r6rs) 5 | (struct-out exn:fail:contract:non-continuable) 6 | (struct-out exn:fail:syntax:r6rs) 7 | (struct-out exn:fail:filesystem:exists-not)) 8 | 9 | (define-struct (exn:fail:r6rs exn:fail) (message who irritants)) 10 | (define-struct (exn:fail:contract:r6rs exn:fail:contract) (message who irritants)) 11 | (define-struct (exn:fail:contract:non-continuable exn:fail:contract) ()) 12 | (define-struct (exn:fail:syntax:r6rs exn:fail:syntax) (message who form subform)) 13 | 14 | (define-struct (exn:fail:filesystem:exists-not exn:fail:filesystem) (filename)) 15 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/find-version.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (provide find-version) 4 | 5 | (define (find-version base-path vers) 6 | (let-values ([(dir name _) (split-path (bytes->path base-path))]) 7 | (let ([files (with-handlers ([exn:fail:filesystem? (lambda (exn) null)]) 8 | (directory-list dir))]) 9 | (and files 10 | (let* ([p (path-element->bytes name)] 11 | [len (bytes-length p)] 12 | [candidate-versions 13 | (filter 14 | values 15 | (map 16 | (lambda (file) 17 | (let ([s (path-element->bytes file)]) 18 | (and 19 | (and (len . < . (bytes-length s)) 20 | (bytes=? p (subbytes s 0 len))) 21 | (let ([ext (let ([m (regexp-match #rx#"([.][a-z]+)?[.](rkt|ss|sls)$" 22 | (subbytes s len))]) 23 | (and m 24 | (or (not (cadr m)) 25 | (bytes=? (cadr m) #".mzscheme")) 26 | (car m)))]) 27 | (and ext 28 | (or (and (= (bytes-length s) (+ len (bytes-length ext))) 29 | (cons null ext)) 30 | (let ([vers (subbytes s len (- (bytes-length s) (bytes-length ext)))]) 31 | (and (regexp-match #rx#"^(-[0-9]+)+$" vers) 32 | (cons 33 | (map string->number 34 | (cdr 35 | (map bytes->string/latin-1 36 | (regexp-split #rx#"-" vers)))) 37 | ext))))))))) 38 | files))] 39 | [versions 40 | (let* ([eo '(#".mzscheme.ss" #".mzscheme.sls" #".ss" #".sls" #".rkt")] 41 | [ext< (lambda (a b) 42 | (> (length (member a eo)) (length (member b eo))))]) 43 | (sort candidate-versions 44 | (lambda (a b) 45 | (if (equal? (car a) (car b)) 46 | (ext< (cdr a) (cdr b)) 47 | (let loop ([a (car a)] [b (car b)]) 48 | (cond 49 | [(null? a) #t] 50 | [(null? b) #f] 51 | [(> (car a) (car b)) #t] 52 | [(< (car a) (car b)) #f] 53 | [else (loop (cdr a) (cdr b))]))))))]) 54 | (ormap (lambda (candidate-version) 55 | (and (version-match? (car candidate-version) vers) 56 | (cons (car candidate-version) 57 | (bytes->string/latin-1 (cdr candidate-version))))) 58 | versions)))))) 59 | 60 | (define (version-match? cand vers) 61 | (cond 62 | [(null? vers) #t] 63 | [(null? cand) #f] 64 | [(eq? (car vers) 'and) 65 | (andmap (lambda (v) 66 | (version-match? cand v)) 67 | (cdr vers))] 68 | [(eq? (car vers) 'or) 69 | (ormap (lambda (v) 70 | (version-match? cand v)) 71 | (cdr vers))] 72 | [(eq? (car vers) 'not) 73 | (not (version-match? cand (cadr vers)))] 74 | [(sub-version-match? (car cand) (car vers)) 75 | (version-match? (cdr cand) (cdr vers))] 76 | [else #f])) 77 | 78 | (define (sub-version-match? cand subvers) 79 | (cond 80 | [(number? subvers) (= cand subvers)] 81 | [else (case (car subvers) 82 | [(>=) (>= cand (cadr subvers))] 83 | [(<=) (<= cand (cadr subvers))] 84 | [(and) (andmap (lambda (sv) 85 | (sub-version-match? cand sv)) 86 | (cdr subvers))] 87 | [(or) (ormap (lambda (sv) 88 | (sub-version-match? cand sv)) 89 | (cdr subvers))] 90 | [(not) (not (sub-version-match? cand (cadr subvers)))] 91 | [else (error "bad subversion")])])) 92 | 93 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/identifier-syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | (require (for-syntax scheme/base) 3 | (for-template "no-set.rkt" 4 | (only-in scheme/base #%app set!))) 5 | 6 | (provide identifier-syntax) 7 | 8 | (define-syntax (identifier-syntax stx) 9 | (syntax-case* stx (r6rs:set!) (lambda (a b) 10 | (free-template-identifier=? a b)) 11 | [(identifier-syntax template) 12 | #'(... 13 | (make-set!-transformer 14 | (lambda (stx) 15 | (syntax-case stx (set!) 16 | [(set! . _) (raise-syntax-error 17 | #f 18 | "cannot assign to identifier macro" 19 | stx)] 20 | [(_ arg ...) #'(template arg ...)] 21 | [_ #'template]))))] 22 | [(identifier-syntax 23 | [id1 template1] 24 | [(r6rs:set! id2 pat) template2]) 25 | (and (identifier? #'id1) 26 | (identifier? #'id2)) 27 | #'(... 28 | (make-set!-transformer 29 | (lambda (stx) 30 | (syntax-case stx (set!) 31 | [(set! id2 pat) #'template2] 32 | [(_ arg ...) #'(template1 arg ...)] 33 | [_ #'template1]))))])) 34 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/inline-rules.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require (for-syntax scheme/base) 4 | (for-template scheme/base)) 5 | 6 | (provide inline-rules) 7 | 8 | (define-syntax-rule (inline-rules orig-id [pat result] ...) 9 | (make-set!-transformer 10 | (lambda (stx) 11 | (syntax-case stx (set!) 12 | [(set! . _) 13 | (raise-syntax-error #f 14 | "cannot mutate" 15 | stx)] 16 | [pat #'result] ... 17 | [(id . args) #'(orig-id . args)] 18 | [id #'orig-id])))) 19 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/io-conds.rkt: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (r6rs private io-conds) 4 | (export &i/o make-i/o-error i/o-error? 5 | &i/o-read make-i/o-read-error i/o-read-error? 6 | &i/o-write make-i/o-write-error i/o-write-error? 7 | &i/o-invalid-position make-i/o-invalid-position-error i/o-invalid-position-error? i/o-error-position 8 | &i/o-filename make-i/o-filename-error i/o-filename-error? i/o-error-filename 9 | &i/o-file-protection make-i/o-file-protection-error i/o-file-protection-error? 10 | &i/o-file-is-read-only make-i/o-file-is-read-only-error i/o-file-is-read-only-error? 11 | &i/o-file-already-exists make-i/o-file-already-exists-error i/o-file-already-exists-error? 12 | &i/o-file-does-not-exist make-i/o-file-does-not-exist-error i/o-file-does-not-exist-error? 13 | &i/o-port make-i/o-port-error i/o-port-error? i/o-error-port) 14 | (import (r6rs private conds))) 15 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/no-set.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | (require (for-syntax scheme/base 3 | syntax/boundmap)) 4 | 5 | (provide (for-syntax add-no-set!-identifiers) 6 | r6rs:set!) 7 | 8 | ;; Provided identifier cannot be `set!'ed. The list 9 | ;; is relevant only within the module being compiled. 10 | (define-for-syntax no-set!-identifiers (make-free-identifier-mapping)) 11 | 12 | (define-for-syntax (add-no-set!-identifiers ids) 13 | (for ([id (in-list ids)]) 14 | (free-identifier-mapping-put! no-set!-identifiers id #t))) 15 | 16 | (define-for-syntax (no-set!-identifier? id) 17 | (free-identifier-mapping-get no-set!-identifiers id (lambda () #f))) 18 | 19 | ;; ---------------------------------------- 20 | 21 | (define-syntax (r6rs:set! stx) 22 | (syntax-case stx () 23 | [(_ id rhs) 24 | (identifier? #'id) 25 | (if (no-set!-identifier? #'id) 26 | (raise-syntax-error 27 | #f 28 | "cannot mutate exported identifier" 29 | stx 30 | #'id) 31 | (syntax/loc stx (set! id rhs)))] 32 | [(_ . rest) 33 | (syntax/loc stx (set! . rest))])) 34 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/num-inline.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require (for-syntax scheme/base 4 | r6rs/private/inline-rules)) 5 | 6 | (provide define-inliner 7 | nocheck 8 | implementation-restriction) 9 | 10 | (define-syntax-rule (nocheck v . _) 11 | v) 12 | 13 | (define (implementation-restriction who what) 14 | (raise 15 | (make-exn:fail:unsupported 16 | (format "~a: result is out of range: ~e" who what) 17 | (current-continuation-marks)))) 18 | 19 | (define-syntax-rule (define-inliner define-fx numtype? numtype-str) 20 | (... 21 | (begin 22 | (define-syntax (define-an-fx stx) 23 | (syntax-case stx () 24 | [(_ orig fx binary-op check-result base-body ([(arg ...) (tmp ...)] ...) . rest) 25 | (with-syntax ([(extra-clauses ...) 26 | (if (syntax-e #'binary-op) 27 | #'([(_ arg1 arg2) (binary-op arg1 arg2)]) 28 | #'())] 29 | [(base-clause ...) 30 | (if (syntax-e #'base-body) 31 | #'([() . base-body]) 32 | #'())]) 33 | #'(begin 34 | (provide fx) 35 | (define fx-proc 36 | (let ([fx (case-lambda 37 | base-clause ... 38 | [(arg ...) 39 | (unless (numtype? arg) 40 | (raise-type-error 'fx numtype-str arg)) 41 | ... 42 | (let ([r (orig arg ...)]) 43 | (check-result r (implementation-restriction 'fx r)))] 44 | ... 45 | . rest)]) 46 | fx)) 47 | (define-syntax fx 48 | (inline-rules 49 | fx-proc 50 | extra-clauses ... 51 | [(_ arg ...) 52 | (let ([tmp arg] ...) 53 | (if (and (numtype? tmp) ...) 54 | (let ([v (orig tmp ...)]) 55 | (check-result v (fx-proc tmp ...))) 56 | (fx-proc tmp ...)))] 57 | ...))))])) 58 | 59 | (define-syntax define-an-fx+rest 60 | (syntax-rules () 61 | [(_ orig fx binary-op check base-body clauses) 62 | (define-an-fx orig fx binary-op check base-body clauses 63 | [args (for-each (lambda (arg) 64 | (unless (numtype? arg) 65 | (raise-type-error 'fx numtype-str arg))) 66 | args) 67 | (let ([r (apply orig args)]) 68 | (check r (implementation-restriction 'fx r)) 69 | r)])])) 70 | 71 | 72 | (define-syntax define-fx 73 | (syntax-rules (...) 74 | [(_ orig fx binary-op [(a) (b c)] check) 75 | (define-an-fx orig fx binary-op check #f 76 | ([(a) (t1)] 77 | [(b c) (t1 t2)]))] 78 | [(_ orig fx binary-op [(a) (b c (... ...))] check) 79 | (define-an-fx+rest orig fx binary-op check #f 80 | ([(a) (t1)] 81 | [(b c) (t1 t2)]))] 82 | [(_ orig fx binary-op (a b c (... ...)) check) 83 | (define-an-fx+rest orig fx binary-op check #f 84 | ([(a b) (t1 t2)]))] 85 | [(_ orig fx binary-op (a b (... ...)) check) 86 | (define-an-fx+rest orig fx binary-op check #f 87 | ([(a) (t1)] 88 | [(a b) (t1 t2)] 89 | [(a b c) (t1 t2 t3)]))] 90 | [(_ orig fx binary-op #:base base (a b (... ...)) check) 91 | (define-an-fx+rest orig fx binary-op check (base) 92 | ([(a) (t1)] 93 | [(a b) (t1 t2)] 94 | [(a b c) (t1 t2 t3)]))] 95 | [(_ orig fx binary-op (a) check) 96 | (define-an-fx+rest orig fx binary-op check #f 97 | ([(a) (t1)]))] 98 | [(_ orig fx binary-op (a b) check) 99 | (define-an-fx orig fx binary-op check #f 100 | ([(a b) (t1 t2)]))] 101 | [(_ orig fx binary-op (a b c) check) 102 | (define-an-fx orig fx binary-op check #f 103 | ([(a b c) (t1 t2 t3)]))]))))) 104 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/prelims.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | ;; PLT Scheme pre-requisites for any phase 4 | 5 | (require (for-syntax scheme/base)) 6 | 7 | (provide 8 | (rename-out [datum #%datum]) 9 | (rename-out [#%plain-app #%app]) 10 | #%top #%top-interaction) 11 | 12 | ;; ---------------------------------------- 13 | ;; Datum 14 | 15 | (define-syntax (datum stx) 16 | (syntax-case stx () 17 | [(_ . thing) 18 | (if (vector? (syntax-e #'thing)) 19 | (raise-syntax-error 'r6rs 20 | "a vector is not an expression" 21 | #'thing) 22 | #`(quote thing))])) 23 | 24 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/qq-gen.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | ;; used for quasiquote and quasisyntax 4 | 5 | (require (for-syntax scheme/base)) 6 | 7 | (provide define-generalized-qq) 8 | 9 | (define-syntax-rule (define-generalized-qq r6rs:quasiquote 10 | quasiquote unquote unquote-splicing uq-wrap) 11 | (... 12 | (define-syntax (r6rs:quasiquote stx) 13 | ;; Replace (unquote expr ...) with (unquote expr) ... 14 | (syntax-case stx () 15 | [(_ tmpl) 16 | (let ([new-tmpl 17 | (let loop ([tmpl #'tmpl][level 0]) 18 | (syntax-case tmpl (r6rs:quasiquote) 19 | [((u expr ...) . rest) 20 | (and (identifier? #'u) 21 | (or (free-identifier=? #'u #'unquote) 22 | (free-identifier=? #'u #'unquote-splicing))) 23 | (let ([new-rest (loop #'rest level)]) 24 | (if (zero? level) 25 | (if (and (eq? new-rest #'rest) 26 | (= 1 (length (syntax->list #'(expr ...)))) 27 | (free-identifier=? #'uq-wrap #'values)) 28 | tmpl 29 | (datum->syntax 30 | tmpl 31 | (append (let ([a (car (syntax-e tmpl))]) 32 | (map (lambda (expr) 33 | (datum->syntax 34 | a 35 | (list (car (syntax-e a)) 36 | (list (syntax uq-wrap) 37 | expr)) 38 | a a a)) 39 | (syntax->list #'(expr ...)))) 40 | new-rest) 41 | tmpl tmpl tmpl)) 42 | (let* ([first (car (syntax-e tmpl))] 43 | [new-first (loop first (sub1 level))]) 44 | (if (and (eq? new-first first) 45 | (eq? new-rest #'rest)) 46 | tmpl 47 | (datum->syntax 48 | tmpl 49 | (cons new-first new-rest) 50 | tmpl tmpl tmpl)))))] 51 | [(r6rs:quasiquote expr) 52 | (let ([new-expr (loop #'(expr) (add1 level))]) 53 | ;; We have to replace the old qq with the new one: 54 | (datum->syntax 55 | tmpl 56 | (cons (datum->syntax #'quasiquote 57 | 'quasiquote 58 | (car (syntax-e tmpl))) 59 | new-expr) 60 | tmpl tmpl tmpl))] 61 | [(a . b) 62 | (let ([new-a (loop #'a level)] 63 | [new-b (loop #'b level)]) 64 | (if (and (eq? new-a #'a) 65 | (eq? new-b #'b)) 66 | tmpl 67 | (datum->syntax 68 | tmpl 69 | (cons new-a new-b) 70 | tmpl tmpl tmpl)))] 71 | [#(a ...) 72 | (let* ([as (syntax->list #'(a ...))] 73 | [new-as (loop as level)]) 74 | (if (eq? as new-as) 75 | tmpl 76 | (datum->syntax 77 | tmpl 78 | (list->vector new-as) 79 | tmpl tmpl tmpl)))] 80 | [_ tmpl]))]) 81 | (datum->syntax 82 | stx 83 | (list #'quasiquote new-tmpl) 84 | stx stx stx))])))) 85 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/reconstruct.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (provide reconstruction-memory wrap) 4 | 5 | (define reconstruction-memory (make-weak-hasheq)) 6 | 7 | (define (wrap r stx srcloc no-symbols?) 8 | (let wrap ([r r]) 9 | (cond 10 | [(syntax? r) r] 11 | [(and (symbol? r) 12 | no-symbols?) 13 | (error 'macro 14 | "transformer result included a raw symbol: ~e" 15 | r)] 16 | [(mpair? r) 17 | (let ([istx (or (hash-ref reconstruction-memory r #f) 18 | stx)]) 19 | (datum->syntax 20 | istx 21 | (cons (wrap (mcar r)) 22 | (wrap (mcdr r))) 23 | (if (eq? istx stx) 24 | srcloc 25 | istx)))] 26 | [(vector? r) (datum->syntax 27 | stx 28 | (list->vector 29 | (map (lambda (r) (wrap r)) 30 | (vector->list r))) 31 | srcloc)] 32 | [else (datum->syntax stx r srcloc)]))) 33 | -------------------------------------------------------------------------------- /r6rs-lib/r6rs/private/vector-types.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | ; PLT module definition for vector types for R6RS Records 4 | 5 | ; Copyright (C) Matthew Flatt (2006). All Rights Reserved. 6 | ; 7 | ; Permission is hereby granted, free of charge, to any person 8 | ; obtaining a copy of this software and associated documentation files 9 | ; (the "Software"), to deal in the Software without restriction, 10 | ; including without limitation the rights to use, copy, modify, merge, 11 | ; publish, distribute, sublicense, and/or sell copies of the Software, 12 | ; and to permit persons to whom the Software is furnished to do so, 13 | ; subject to the following conditions: 14 | ; 15 | ; The above copyright notice and this permission notice shall be 16 | ; included in all copies or substantial portions of the Software. 17 | ; 18 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 19 | ; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 20 | ; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 21 | ; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS 22 | ; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN 23 | ; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 24 | ; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 25 | ; SOFTWARE. 26 | 27 | (require scheme/mpair) 28 | 29 | (provide (rename-out [make-a-vector-type make-vector-type]) 30 | vector-type? 31 | vector-type-data 32 | vector-type-predicate 33 | typed-vector-constructor 34 | typed-vector-accessor typed-vector-mutator 35 | typed-vector? 36 | typed-vector-type) 37 | 38 | (define-struct vector-type (data field-count supertype 39 | struct-type constructor predicate accessor mutator)) 40 | 41 | (define-values (prop:typed-vector typed-vector? typed-vector-ref) 42 | (make-struct-type-property 'typed-vector)) 43 | 44 | (define (make-a-vector-type name supertype data field-mutability opaque?) 45 | (let* ([super-field-count (if supertype 46 | (vector-type-field-count supertype) 47 | 0)] 48 | [field-mutability (list-tail (mlist->list field-mutability) super-field-count)] 49 | [bx (box #f)]) 50 | (let-values ([(struct: make-s s? s-ref s-set!) 51 | (make-struct-type name 52 | (and supertype 53 | (vector-type-struct-type supertype)) 54 | (length field-mutability) 0 #f 55 | (append (list (cons prop:typed-vector bx)) 56 | (if opaque? 57 | null 58 | ;; `equal?' shouldn't work on transparent structs: 59 | (list 60 | (cons prop:equal+hash 61 | (list 62 | (lambda (a b equal?) (eqv? a b)) 63 | (lambda (a hash-code) (hash-code a)) 64 | (lambda (a hash-code) (hash-code a))))))) 65 | (and opaque? (current-inspector)) 66 | #f ; not a procedure 67 | (let loop ([field-mutability field-mutability] 68 | [index 0]) 69 | (cond 70 | [(null? field-mutability) null] 71 | [(not (car field-mutability)) (cons index 72 | (loop (cdr field-mutability) 73 | (add1 index)))] 74 | [else (loop (cdr field-mutability) (add1 index))])))]) 75 | (let ([vt (make-vector-type data 76 | (+ (length field-mutability) super-field-count) 77 | supertype 78 | struct: make-s s? 79 | s-ref s-set!)]) 80 | (set-box! bx vt) 81 | vt)))) 82 | 83 | (define (vector-type-index t pos) 84 | (let* ([supertype (vector-type-supertype t)] 85 | [super-field-count (if supertype 86 | (vector-type-field-count supertype) 87 | 0)]) 88 | (if (pos . < . super-field-count) 89 | (vector-type-index supertype pos) 90 | (- pos super-field-count)))) 91 | 92 | (define (typed-vector-constructor t) 93 | (vector-type-constructor t)) 94 | 95 | (define (typed-vector-type v) 96 | (unbox (typed-vector-ref v))) 97 | 98 | (define (typed-vector-accessor t pos) 99 | (make-struct-field-accessor (vector-type-accessor t) (vector-type-index t pos))) 100 | 101 | (define (typed-vector-mutator t pos) 102 | (make-struct-field-mutator (vector-type-mutator t) (vector-type-index t pos))) 103 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/arithmetic/bitwise-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | (require (only-in racket/base 3 | bitwise-first-bit-set)) 4 | 5 | (provide bitwise-and 6 | bitwise-ior 7 | bitwise-xor 8 | bitwise-not 9 | bitwise-if 10 | (rename-out [integer-length bitwise-length]) 11 | bitwise-bit-count 12 | bitwise-first-bit-set 13 | bitwise-bit-set? 14 | bitwise-copy-bit 15 | bitwise-bit-field 16 | (rename-out [arithmetic-shift bitwise-arithmetic-shift]) 17 | bitwise-arithmetic-shift-left 18 | bitwise-arithmetic-shift-right 19 | bitwise-copy-bit-field 20 | bitwise-rotate-bit-field 21 | bitwise-reverse-bit-field) 22 | 23 | 24 | (define (bitwise-if a b c) 25 | (bitwise-ior (bitwise-and a b) 26 | (bitwise-and (bitwise-not a) c))) 27 | 28 | (define (bitwise-bit-count i) 29 | (if (negative? i) 30 | (bitwise-not (bitwise-bit-count (bitwise-not i))) 31 | (let loop ([i i][cnt 0]) 32 | (if (zero? i) 33 | cnt 34 | (loop (arithmetic-shift i -1) 35 | (+ cnt (if (eq? 1 (bitwise-and i 1)) 1 0))))))) 36 | 37 | (define (bitwise-copy-bit b n bit) 38 | (unless (exact-nonnegative-integer? n) 39 | (raise-type-error 'bitwise-copy-bit "exact nonnegative integer" n)) 40 | (unless (or (eq? bit 1) 41 | (eq? bit 0)) 42 | (raise-type-error 'bitwise-copy-bit "0 or 1" bit)) 43 | (if (eq? bit 1) 44 | (bitwise-ior b (arithmetic-shift 1 n)) 45 | (bitwise-and b (bitwise-not (arithmetic-shift 1 n))))) 46 | 47 | (define (bitwise-copy-bit-field to start end from) 48 | (unless (exact-nonnegative-integer? start) 49 | (raise-type-error 'bitwise-copy-bit-field "exact nonnegative integer" start)) 50 | (unless (exact-nonnegative-integer? end) 51 | (raise-type-error 'bitwise-copy-bit-field "exact nonnegative integer" end)) 52 | (unless (start . <= . end) 53 | (error 'bitwise-copy-bit-field "ending position ~e is not as big a starting position ~e" start end)) 54 | (let* ([mask1 (arithmetic-shift -1 start)] 55 | [mask2 (bitwise-not (arithmetic-shift -1 end))] 56 | [mask (bitwise-and mask1 mask2)]) 57 | (bitwise-if mask 58 | (arithmetic-shift from start) 59 | to))) 60 | 61 | (define (bitwise-arithmetic-shift-left v s) 62 | (arithmetic-shift v s)) 63 | (define (bitwise-arithmetic-shift-right v s) 64 | (arithmetic-shift v (- s))) 65 | 66 | (define (bitwise-rotate-bit-field n start end count) 67 | (unless (exact-nonnegative-integer? start) 68 | (raise-type-error 'bitwise-rotate-bit-field "exact nonnegative integer" start)) 69 | (unless (exact-nonnegative-integer? end) 70 | (raise-type-error 'bitwise-rotate-bit-field "exact nonnegative integer" end)) 71 | (unless (start . <= . end) 72 | (error 'bitwise-rotate-bit-field "ending position ~e is not as big a starting position ~e" start end)) 73 | (unless (exact-nonnegative-integer? count) 74 | (raise-type-error 'bitwise-rotate-bit-field "exact nonnegative integer" count)) 75 | (let* ([width (- end start)] 76 | [count (modulo count width)] 77 | [field0 (bitwise-bit-field n start end)] 78 | [field1 (arithmetic-shift field0 count)] 79 | [field2 (arithmetic-shift field0 (- count width))] 80 | [field (bitwise-ior field1 field2)]) 81 | (bitwise-copy-bit-field n start end field))) 82 | 83 | (define (bitwise-reverse-bit-field n start end) 84 | (unless (exact-nonnegative-integer? start) 85 | (raise-type-error 'bitwise-rotate-bit-field "exact nonnegative integer" start)) 86 | (unless (exact-nonnegative-integer? end) 87 | (raise-type-error 'bitwise-rotate-bit-field "exact nonnegative integer" end)) 88 | (unless (start . <= . end) 89 | (error 'bitwise-rotate-bit-field "ending position ~e is not as big a starting position ~e" start end)) 90 | (let ([field (bitwise-bit-field n start end)] 91 | [width (- end start)]) 92 | (let loop ([old field][new 0][width width]) 93 | (cond 94 | [(zero? width) (bitwise-copy-bit-field n start end new)] 95 | [else (loop (arithmetic-shift old -1) 96 | (bitwise-ior (arithmetic-shift new 1) 97 | (bitwise-and old 1)) 98 | (sub1 width))])))) 99 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/arithmetic/flonums-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require (only-in rnrs/base-6 4 | div-and-mod div mod 5 | div0-and-mod0 div0 mod0 6 | [integer? r6rs:integer?] 7 | finite? infinite? nan?) 8 | (prefix-in core: scheme/flonum) 9 | scheme/fixnum 10 | (only-in rnrs/arithmetic/fixnums-6 11 | fixnum?) 12 | rnrs/conditions-6 13 | r6rs/private/num-inline) 14 | 15 | (provide (rename-out [inexact-real? flonum?]) 16 | real->flonum 17 | flnumerator 18 | fldenominator 19 | fllog (rename-out [core:flsqrt flsqrt]) flexpt 20 | &no-infinities make-no-infinities-violation no-infinities-violation? 21 | &no-nans make-no-nans-violation no-nans-violation?) 22 | ;; More provided via macros 23 | 24 | (define-inliner define-fl inexact-real? "flonum") 25 | 26 | (define-fl = fl=? core:fl= (a b c ...) nocheck) 27 | (define-fl > fl>? core:fl> (a b c ...) nocheck) 28 | (define-fl < fl= fl>=? core:fl>= (a b c ...) nocheck) 31 | 32 | (define-fl integer? flinteger? #f (a) nocheck) 33 | (define-fl zero? flzero? #f (a) nocheck) 34 | (define-fl positive? flpositive? #f (a) nocheck) 35 | (define-fl negative? flnegative? #f (a) nocheck) 36 | (define-fl odd? flodd? #f (a) nocheck) 37 | (define-fl even? fleven? #f (a) nocheck) 38 | (define-fl finite? flfinite? #f (a) nocheck) 39 | (define-fl infinite? flinfinite? #f (a) nocheck) 40 | (define-fl nan? flnan? #f (a) nocheck) 41 | 42 | (define-fl max flmax core:flmax (a b ...) nocheck) 43 | (define-fl min flmin core:flmin (a b ...) nocheck) 44 | 45 | (define-fl + fl+ core:fl+ #:base 0.0 (a b ...) nocheck) 46 | (define-fl * fl* core:fl* #:base 1.0 (a b ...) nocheck) 47 | (define-fl - fl- core:fl- [(a) (a b ...)] nocheck) 48 | (define-fl / fl/ core:fl/ [(a) (a b ...)] nocheck) 49 | 50 | (define-fl abs flabs core:flabs (a) nocheck) 51 | 52 | (provide fldiv-and-mod 53 | fldiv0-and-mod0) 54 | (define (fldiv-and-mod a b) 55 | (unless (inexact-real? a) 56 | (raise-type-error 'fldiv-and-mod "flonum" a)) 57 | (unless (inexact-real? b) 58 | (raise-type-error 'fldiv-and-mod "flonum" b)) 59 | (div-and-mod a b)) 60 | (define-fl div fldiv #f (a b) nocheck) 61 | (define-fl mod flmod #f (a b) nocheck) 62 | (define (fldiv0-and-mod0 a b) 63 | (unless (inexact-real? a) 64 | (raise-type-error 'fldiv0-and-mod0 "flonum" a)) 65 | (unless (inexact-real? b) 66 | (raise-type-error 'fldiv0-and-mod0 "flonum" b)) 67 | (div0-and-mod0 a b)) 68 | (define-fl div0 fldiv0 #f (a b) nocheck) 69 | (define-fl mod0 flmod0 #f (a b) nocheck) 70 | 71 | (define (flnumerator c) 72 | (if (inexact-real? c) 73 | (if (and (rational? c) 74 | (not (equal? c -0.0))) 75 | (numerator c) 76 | c) 77 | (raise-type-error 'flnumerator "flonum" c))) 78 | 79 | (define (fldenominator c) 80 | (if (inexact-real? c) 81 | (if (rational? c) 82 | (denominator c) 83 | 1.0) 84 | (raise-type-error 'fldenominator "flonum" c))) 85 | 86 | (provide (rename-out [core:flfloor flfloor] 87 | [core:flceiling flceiling] 88 | [core:flround flround] 89 | [core:fltruncate fltruncate] 90 | [core:flexp flexp])) 91 | 92 | (define fllog 93 | (case-lambda 94 | [(v) (core:fllog v)] 95 | [(v1 v2) 96 | (/ (fllog v1) (fllog v2))])) 97 | 98 | (provide (rename-out [core:flsin flsin] 99 | [core:flcos flcos] 100 | [core:fltan fltan] 101 | [core:flasin flasin] 102 | [core:flacos flacos])) 103 | 104 | (define-fl atan flatan #f [(a) (a b)] nocheck) 105 | 106 | (define (flexpt a b) 107 | (unless (inexact-real? a) 108 | (raise-type-error 'flexpt "flonum" a)) 109 | (unless (inexact-real? b) 110 | (raise-type-error 'flexpt "flonum" b)) 111 | (let ([v (expt a b)]) 112 | (if (inexact-real? v) 113 | v 114 | +nan.0))) 115 | 116 | (define-condition-type &no-infinities 117 | &implementation-restriction 118 | make-no-infinities-violation 119 | no-infinities-violation?) 120 | 121 | (define-condition-type &no-nans 122 | &implementation-restriction 123 | make-no-nans-violation no-nans-violation?) 124 | 125 | (define (real->flonum r) 126 | (unless (real? r) 127 | (raise-type-error 'real->flonum "real" r)) 128 | (exact->inexact r)) 129 | 130 | (provide (rename-out [fx->fl fixnum->flonum])) 131 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/conditions-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require r6rs/private/conds) 4 | 5 | (provide &condition 6 | condition? 7 | condition 8 | simple-conditions 9 | condition-predicate 10 | condition-accessor 11 | define-condition-type 12 | 13 | &message make-message-condition message-condition? condition-message 14 | &warning make-warning warning? 15 | &serious make-serious-condition serious-condition? 16 | &error make-error error? 17 | &violation make-violation violation? 18 | &assertion make-assertion-violation assertion-violation? 19 | &irritants make-irritants-condition irritants-condition? condition-irritants 20 | &who make-who-condition who-condition? condition-who 21 | &non-continuable make-non-continuable-violation non-continuable-violation? 22 | &implementation-restriction make-implementation-restriction-violation implementation-restriction-violation? 23 | &lexical make-lexical-violation lexical-violation? 24 | &syntax make-syntax-violation syntax-violation? syntax-violation-form syntax-violation-subform 25 | &undefined make-undefined-violation undefined-violation?) 26 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/control-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require (for-syntax scheme/base) 4 | scheme/mpair) 5 | 6 | (provide when unless do 7 | (rename-out [r6rs:case-lambda case-lambda])) 8 | 9 | (define-syntax (r6rs:case-lambda stx) 10 | (syntax-case stx () 11 | [(_ clause ...) 12 | (quasisyntax/loc stx 13 | (case-lambda 14 | . #,(map (lambda (clause) 15 | (syntax-case clause () 16 | [[formals body1 body ...] 17 | (syntax-case #'formals () 18 | [(id ...) 19 | (andmap identifier? (syntax->list #'(id ...))) 20 | clause] 21 | [(id ... . rest) 22 | (and (identifier? #'rest) 23 | (andmap identifier? (syntax->list #'(id ...)))) 24 | #`[formals 25 | (let ([rest (list->mlist rest)]) 26 | (#%stratified-body body1 body ...))]] 27 | [rest 28 | (identifier? #'rest) 29 | #`[formals 30 | (let ([rest (list->mlist rest)]) 31 | (#%stratified-body body1 body ...))]] 32 | [_ 33 | (raise-syntax-error 34 | #f 35 | "ill-formed argument sequence" 36 | stx 37 | #'formals)])] 38 | [else 39 | (raise-syntax-error 40 | #f 41 | "ill-formed clause" 42 | stx 43 | clause)])) 44 | (syntax->list #'(clause ...)))))])) 45 | 46 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/eval-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require (only-in r6rs) 4 | (only-in r6rs/private/prelims) 5 | scheme/mpair 6 | r6rs/private/parse-ref) 7 | 8 | (provide (rename-out [r6rs:eval eval]) 9 | environment) 10 | 11 | (define-namespace-anchor anchor) 12 | 13 | (define (mpair->pair p) 14 | (cond 15 | [(mpair? p) (cons (mpair->pair (mcar p)) 16 | (mpair->pair (mcdr p)))] 17 | [(vector? p) (list->vector 18 | (map mpair->pair 19 | (vector->list p)))] 20 | [else p])) 21 | 22 | (define (r6rs:eval expr env) 23 | (eval (datum->syntax #f `(#%expression ,(mpair->pair expr))) env)) 24 | 25 | (define (environment . specs) 26 | (let ([reqs 27 | (map (lambda (spec) 28 | (parse-import 29 | (datum->syntax #f spec) 30 | (datum->syntax #f (mpair->pair spec)) 31 | (lambda (msg orig stx) 32 | (error 'environment "~a: ~e" msg spec)))) 33 | specs)]) 34 | (let ([ns (namespace-anchor->empty-namespace anchor)]) 35 | ;; Make sure all modules are instantiated here: 36 | (parameterize ([current-namespace ns]) 37 | (namespace-require '(rename scheme/base #%base-require require)) 38 | (namespace-require '(only scheme/base #%expression)) 39 | (eval `(#%base-require r6rs/private/prelims 40 | . ,(apply append reqs)))) 41 | ns))) 42 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/exceptions-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require r6rs/private/exns 4 | (only-in r6rs/private/conds serious-condition? simple-conditions condition?) 5 | (only-in rnrs/io/ports-6 standard-error-port)) 6 | 7 | (provide with-exception-handler 8 | guard else => 9 | (rename-out [r6rs:raise raise]) 10 | raise-continuable) 11 | 12 | (define-struct (exn:continuable exn:fail) (base continuation)) 13 | 14 | (define (with-exception-handler proc thunk) 15 | (unless (and (procedure? proc) 16 | (procedure-arity-includes? proc 1)) 17 | (raise-type-error 'with-exception-handler "procedure (arity 1)" proc)) 18 | (unless (and (procedure? thunk) 19 | (procedure-arity-includes? thunk 0)) 20 | (raise-type-error 'with-exception-handler "procedure (arity 0)" thunk)) 21 | (call-with-exception-handler 22 | (lambda (exn) 23 | (let/ec esc 24 | (call-with-exception-handler 25 | (lambda (new-exn) 26 | ;; Chain to enclosing handler by returning: 27 | (esc new-exn)) 28 | (lambda () 29 | (call-with-values (lambda () (proc (if (exn:continuable? exn) 30 | (exn:continuable-base exn) 31 | exn))) 32 | (if (continuable? exn) 33 | (lambda args 34 | ((continuable-continuation exn) (lambda () (apply values args)))) 35 | (lambda args 36 | (make-exn:fail:contract:non-continuable 37 | (format "raise: when handling a non-continuable exception, exception handler returned~a" 38 | (if (null? args) 39 | " (no values)" 40 | (apply 41 | string-append 42 | ":" 43 | (let loop ([args args][n 10]) 44 | (cond 45 | [(null? args) null] 46 | [(zero? n) 47 | (list " ...")] 48 | [else 49 | (cons (format " ~e" (car args)) 50 | (loop (cdr args) (sub1 n)))]))))) 51 | (current-continuation-marks))))))))) 52 | thunk)) 53 | 54 | (define (continuable? exn) 55 | (or (exn:break? exn) 56 | (exn:continuable? exn))) 57 | 58 | (define (continuable-continuation exn) 59 | (if (exn:break? exn) 60 | (exn:break-continuation exn) 61 | (exn:continuable-continuation exn))) 62 | 63 | (define-syntax-rule (guard (id cond-clause ...) body0 body ...) 64 | (with-handlers* ([(lambda (x) #t) 65 | (lambda (id) 66 | (let ([id (if (exn:continuable? id) 67 | (exn:continuable-base id) 68 | id)]) 69 | (exn-cond id 70 | cond-clause ...)))]) 71 | body0 body ...)) 72 | 73 | (define-syntax exn-cond 74 | (syntax-rules (else) 75 | [(_ id [else . rhs]) 76 | (cond [else . rhs])] 77 | [(_ id clause . more) 78 | (cond clause 79 | [else (exn-cond id . more)])] 80 | [(_ id) 81 | (raise id)])) 82 | 83 | (define (r6rs:raise exn) 84 | (parameterize ([uncaught-exception-handler 85 | ;; Simulate an initial exception handler that 86 | ;; behaves as specified in R6RS for non-&serious 87 | ;; exceptions: 88 | (let ([ueh (uncaught-exception-handler)]) 89 | (lambda (exn) 90 | (let ([base (if (exn:continuable? exn) 91 | (exn:continuable-base exn) 92 | exn)]) 93 | (if (serious-condition? base) 94 | (ueh base) 95 | ;; Not &serious, so try to "continue": 96 | (begin 97 | ((error-display-handler) 98 | (if (exn? base) 99 | (exn-message base) 100 | (format "uncaught exception: ~s" 101 | base)) 102 | base) 103 | ;; If it's continuable, then continue 104 | ;; by resuming the old continuation. 105 | ;; (Otherwise, let the a handler- 106 | ;; didn't-escape error get reported.) 107 | (when (exn:continuable? exn) 108 | ((exn:continuable-continuation exn) 109 | (lambda () (values)))))))))]) 110 | ;; No barrier: 111 | (raise exn #f))) 112 | 113 | (define (raise-continuable exn) 114 | ((let/cc cont 115 | (r6rs:raise 116 | (make-exn:continuable 117 | (if (exn? exn) (exn-message exn) "continuable exception") 118 | (if (exn? exn) (exn-continuation-marks exn) (current-continuation-marks)) 119 | exn 120 | cont))))) 121 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/files-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (provide file-exists? 4 | delete-file) 5 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/hashtables-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require scheme/dict) 4 | 5 | (provide make-eq-hashtable 6 | make-eqv-hashtable 7 | (rename-out [r6rs:make-hashtable make-hashtable]) 8 | hashtable? 9 | hashtable-size 10 | hashtable-ref 11 | hashtable-set! 12 | hashtable-delete! 13 | hashtable-contains? 14 | hashtable-update! 15 | hashtable-copy 16 | hashtable-clear! 17 | hashtable-keys 18 | hashtable-entries 19 | hashtable-equivalence-function 20 | hashtable-hash-function 21 | hashtable-mutable? 22 | equal-hash 23 | string-hash 24 | string-ci-hash 25 | symbol-hash) 26 | 27 | (define-struct hashtable ([ht #:mutable] 28 | wrap 29 | unwrap 30 | mutable? 31 | equivalence-function 32 | hash-function) 33 | #:property prop:dict 34 | (vector (case-lambda 35 | [(ht key) 36 | (hash-ref (hashtable-ht ht) ((hashtable-wrap ht) key))] 37 | [(ht key default) 38 | (hash-ref (hashtable-ht ht) ((hashtable-wrap ht) key) default)]) 39 | (lambda (ht key val) (hashtable-set! ht key val)) 40 | #f 41 | (lambda (ht key) (hashtable-delete! ht key)) 42 | #f 43 | (lambda (ht) (hashtable-size ht)) 44 | (lambda (ht) (hash-iterate-first (hashtable-ht ht))) 45 | (lambda (ht pos) (hash-iterate-next (hashtable-ht ht) pos)) 46 | (lambda (ht pos) ((hashtable-unwrap ht) 47 | (hash-iterate-key (hashtable-ht ht) pos))) 48 | (lambda (ht pos) (hash-iterate-value (hashtable-ht ht) pos)))) 49 | 50 | (define-struct eqv-box (val) 51 | #:property prop:equal+hash (list 52 | (lambda (a b recur) (eqv? (eqv-box-val a) 53 | (eqv-box-val b))) 54 | (lambda (v recur) (equal-hash-code (eqv-box-val v))) 55 | (lambda (v recur) (equal-secondary-hash-code (eqv-box-val v))))) 56 | 57 | 58 | (define (make-eq-hashtable [k 0]) 59 | (unless (exact-nonnegative-integer? k) 60 | (raise-type-error 'make-eq-hashtable "exact, nonnegative integer" k)) 61 | (make-hashtable (make-hasheq) values values #t eq? #f)) 62 | 63 | (define (make-eqv-hashtable [k 0]) 64 | (unless (exact-nonnegative-integer? k) 65 | (raise-type-error 'make-eqv-hashtable "exact, nonnegative integer" k)) 66 | (make-hashtable (make-hash) make-eqv-box eqv-box-val #t eqv? #f)) 67 | 68 | (define r6rs:make-hashtable 69 | (let ([make-hashtable 70 | (lambda (hash =? [k 0]) 71 | (unless (and (procedure? hash) 72 | (procedure-arity-includes? hash 1)) 73 | (raise-type-error 'make-hashtable "procedure (arity 1)" hash)) 74 | (unless (and (procedure? =?) 75 | (procedure-arity-includes? =? 2)) 76 | (raise-type-error 'make-hashtable "procedure (arity 2)" =?)) 77 | (unless (exact-nonnegative-integer? k) 78 | (raise-type-error 'make-hashtable "exact, nonnegative integer" k)) 79 | (let () 80 | (define-struct hash-box (val) 81 | #:property prop:equal+hash (list 82 | (lambda (a b recur) (=? (hash-box-val a) 83 | (hash-box-val b))) 84 | (lambda (v recur) (hash (hash-box-val v))) 85 | (lambda (v recur) 10001))) 86 | (make-hashtable (make-hash) make-hash-box hash-box-val #t =? hash)))]) 87 | make-hashtable)) 88 | 89 | (define (hashtable-size ht) 90 | (hash-count (hashtable-ht ht))) 91 | 92 | (define tag (gensym)) 93 | 94 | (define (hashtable-ref ht key default) 95 | (let ([v (hash-ref (hashtable-ht ht) ((hashtable-wrap ht) key) tag)]) 96 | (if (eq? v tag) 97 | default 98 | v))) 99 | 100 | (define (hashtable-set! ht key val) 101 | (if (hashtable-mutable? ht) 102 | (hash-set! (hashtable-ht ht) ((hashtable-wrap ht) key) val) 103 | (raise-type-error 'hashtable-set! "mutable hashtable" ht))) 104 | 105 | (define (hashtable-delete! ht key) 106 | (if (hashtable-mutable? ht) 107 | (hash-remove! (hashtable-ht ht) ((hashtable-wrap ht) key)) 108 | (raise-type-error 'hashtable-delete! "mutable hashtable" ht))) 109 | 110 | (define (hashtable-contains? ht key) 111 | (not (eq? (hash-ref (hashtable-ht ht) ((hashtable-wrap ht) key) tag) 112 | tag))) 113 | 114 | (define (hashtable-update! ht key proc default) 115 | (if (hashtable-mutable? ht) 116 | (hashtable-set! ht key (proc (hashtable-ref ht key default))) 117 | (raise-type-error 'hashtable-update! "mutable hashtable" ht))) 118 | 119 | (define (hashtable-copy ht [mutable? #f]) 120 | (make-hashtable (hash-copy (hashtable-ht ht)) 121 | (hashtable-wrap ht) 122 | (hashtable-unwrap ht) 123 | mutable? 124 | (hashtable-equivalence-function ht) 125 | (hashtable-hash-function ht))) 126 | 127 | (define (hashtable-clear! ht [k 0]) 128 | (unless (exact-nonnegative-integer? k) 129 | (raise-type-error 'hashtable-clear! "exact, nonnegative integer" k)) 130 | (if (hashtable-mutable? ht) 131 | (set-hashtable-ht! ht (if (eq? values (hashtable-wrap ht)) 132 | (make-hasheq) 133 | (make-hash))) 134 | (raise-type-error 'hashtable-clear! "mutable hashtable" ht))) 135 | 136 | (define (hashtable-keys ht) 137 | (let ([unwrap (hashtable-unwrap ht)]) 138 | (list->vector (hash-map (hashtable-ht ht) (lambda (a b) (unwrap a)))))) 139 | 140 | (define (hashtable-entries ht) 141 | (let ([ps (hash-map (hashtable-ht ht) cons)] 142 | [unwrap (hashtable-unwrap ht)]) 143 | (values (list->vector (map (lambda (p) (unwrap (car p))) ps)) 144 | (list->vector (map cdr ps))))) 145 | 146 | (define (equal-hash v) 147 | (abs (equal-hash-code v))) 148 | 149 | (define (string-hash s) 150 | (unless (string? s) 151 | (raise-type-error 'string-hash "string" s)) 152 | (abs (equal-hash-code s))) 153 | 154 | (define (string-ci-hash s) 155 | (unless (string? s) 156 | (raise-type-error 'string-ci-hash "string" s)) 157 | (abs (equal-hash-code (string-foldcase s)))) 158 | 159 | (define (symbol-hash s) 160 | (unless (symbol? s) 161 | (raise-type-error 'symbol-hash "symbol" s)) 162 | (abs (eq-hash-code s))) 163 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/io/ports-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require r6rs/private/ports) 4 | (provide (except-out (all-from-out r6rs/private/ports) 5 | r6rs-port->port)) 6 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/io/simple-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require (prefix-in r6rs: rnrs/io/ports-6)) 4 | 5 | (provide (rename-out [r6rs:eof-object eof-object]) 6 | eof-object? 7 | (rename-out [r6rs:call-with-input-file call-with-input-file] 8 | [r6rs:call-with-output-file call-with-output-file]) 9 | input-port? 10 | output-port? 11 | (rename-out [r6rs:current-input-port current-input-port] 12 | [r6rs:current-output-port current-output-port] 13 | [r6rs:current-error-port current-error-port] 14 | [r6rs:with-input-from-file with-input-from-file] 15 | [r6rs:with-output-to-file with-output-to-file] 16 | [r6rs:open-input-file open-input-file] 17 | [r6rs:open-output-file open-output-file]) 18 | close-input-port 19 | close-output-port 20 | (rename-out [r6rs:read-char read-char] 21 | [r6rs:peek-char peek-char] 22 | [r6rs:read read] 23 | [r6rs:write-char write-char] 24 | [r6rs:newline newline] 25 | [r6rs:display display] 26 | [r6rs:write write])) 27 | 28 | (define (r6rs:call-with-input-file file proc) 29 | (r6rs:call-with-port 30 | (r6rs:open-input-file file) 31 | proc)) 32 | 33 | (define (r6rs:call-with-output-file file proc) 34 | (r6rs:call-with-port 35 | (r6rs:open-output-file file) 36 | proc)) 37 | 38 | (define (r6rs:with-input-from-file file proc) 39 | (let ([p (r6rs:open-input-file file)]) 40 | (begin0 41 | (parameterize ([current-input-port p]) 42 | (proc)) 43 | (close-input-port p)))) 44 | 45 | (define (r6rs:with-output-to-file file proc) 46 | (let ([p (r6rs:open-output-file file)]) 47 | (begin0 48 | (parameterize ([current-output-port p]) 49 | (proc)) 50 | (close-output-port p)))) 51 | 52 | (define (r6rs:open-input-file file) 53 | (r6rs:transcoded-port (r6rs:open-file-input-port file) (r6rs:native-transcoder))) 54 | 55 | (define (r6rs:open-output-file file) 56 | (r6rs:transcoded-port (r6rs:open-file-output-port file) (r6rs:native-transcoder))) 57 | 58 | (define (r6rs:read-char [in (r6rs:current-input-port)]) 59 | (r6rs:get-char in)) 60 | 61 | (define (r6rs:peek-char [in (r6rs:current-input-port)]) 62 | (r6rs:lookahead-char in)) 63 | 64 | (define (r6rs:read [in (r6rs:current-input-port)]) 65 | (r6rs:get-datum in)) 66 | 67 | (define (r6rs:write-char ch [out (r6rs:current-output-port)]) 68 | (r6rs:put-char out ch)) 69 | 70 | (define (r6rs:newline [out (r6rs:current-output-port)]) 71 | (r6rs:put-char out #\newline)) 72 | 73 | (define (r6rs:display v [out (r6rs:current-output-port)]) 74 | (unless (r6rs:textual-port? out) 75 | (raise-type-error 'display "textual port" out)) 76 | ;; Should we make mpairs print with parens? 77 | (display v out)) 78 | 79 | (define (r6rs:write v [out (r6rs:current-output-port)]) 80 | (r6rs:put-datum out v)) 81 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/main-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (define-syntax re-export 4 | (syntax-rules () 5 | [(_) (re-export rnrs/base-6 6 | rnrs/exceptions-6 7 | rnrs/programs-6 8 | rnrs/files-6 9 | rnrs/bytevectors-6 10 | rnrs/hashtables-6 11 | rnrs/sorting-6 12 | rnrs/syntax-case-6 13 | rnrs/conditions-6 14 | rnrs/unicode-6 15 | rnrs/control-6 16 | rnrs/lists-6 17 | rnrs/enums-6 18 | rnrs/arithmetic/bitwise-6 19 | rnrs/arithmetic/fixnums-6 20 | rnrs/arithmetic/flonums-6 21 | rnrs/io/ports-6 22 | rnrs/io/simple-6 23 | rnrs/records/inspection-6 24 | rnrs/records/syntactic-6 25 | rnrs/records/procedural-6)] 26 | [(_ id) (begin 27 | (require id 28 | ;; Shift any run time exports to for-syntax: 29 | (for-syntax (only-meta-in 0 id)) 30 | ;; Shift any for-syntax exports for run time: 31 | (for-template (only-meta-in 1 id))) 32 | (provide (all-from-out id) 33 | (for-template (all-from-out id)) 34 | (for-syntax (all-from-out id))))] 35 | [(_ id ...) 36 | (begin (re-export id) ...)])) 37 | 38 | (re-export) 39 | 40 | ;; Also need to export prelims for syntax, since there will 41 | ;; not be a for-syntax import when this module is imported: 42 | (require (for-syntax r6rs/private/prelims)) 43 | (provide (for-syntax (all-from-out r6rs/private/prelims))) 44 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/main.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (define-syntax-rule (bounce) 4 | (begin 5 | (require rnrs/main-6) 6 | (provide (all-from-out rnrs/main-6)))) 7 | (bounce) 8 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/mutable-pairs-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require scheme/mpair) 4 | 5 | (provide (rename-out [set-mcdr! set-cdr!] 6 | [set-mcar! set-car!])) 7 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/mutable-strings-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (provide string-set! string-fill!) 4 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/programs-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require scheme/mpair) 4 | 5 | (provide command-line 6 | (rename-out [r6rs-exit exit])) 7 | 8 | (define (command-line) 9 | (mcons (path->string (find-system-path 'run-file)) 10 | (list->mlist (vector->list (current-command-line-arguments))))) 11 | 12 | (define r6rs-exit 13 | (let () 14 | (lambda ([x 0]) 15 | (if x 16 | (exit x) 17 | (exit 1))))) 18 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/r5rs-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require (prefix-in r5rs: r5rs)) 4 | 5 | (provide exact->inexact 6 | inexact->exact 7 | quotient 8 | remainder 9 | modulo 10 | (rename-out [r5rs:delay delay] 11 | [r5rs:force force] 12 | [r5rs:null-environment null-environment] 13 | [r5rs:scheme-report-environment scheme-report-environment])) 14 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/records/inspection-6.rkt: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (rnrs records inspection (6)) 4 | (export record-type-name 5 | record-type-parent 6 | record-type-sealed? 7 | record-type-uid 8 | record-type-generative? 9 | record-type-field-names 10 | record-type-opaque? 11 | record-field-mutable? 12 | record? record-rtd) 13 | (import (r6rs private records-core))) 14 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/records/procedural-6.rkt: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (rnrs records procedural (6)) 4 | (export make-record-type-descriptor 5 | record-type-descriptor? 6 | make-record-constructor-descriptor record-constructor 7 | record-predicate 8 | record-accessor record-mutator) 9 | (import (r6rs private records-core))) 10 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/sorting-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require scheme/mpair) 4 | 5 | (provide list-sort 6 | vector-sort 7 | vector-sort!) 8 | 9 | (define (list-sort < l) 10 | ;; FIXME (performance): `sort' internally converts 11 | ;; a list to an mlist! 12 | (list->mlist (sort (mlist->list l) <))) 13 | 14 | (define (vector-sort < v) 15 | (list->vector (sort (vector->list v) <))) 16 | 17 | (define (vector-sort! < v) 18 | (let ([v2 (vector-sort < v)]) 19 | (vector-copy! v 0 v2))) 20 | -------------------------------------------------------------------------------- /r6rs-lib/rnrs/unicode-6.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | ;; FIXME: there could be all sorts of mismatches between the R6RS 4 | ;; definitions and those in `scheme/base'. 5 | 6 | (provide 7 | char-upcase 8 | char-downcase 9 | char-titlecase 10 | char-foldcase 11 | char-ci=? 12 | char-ci? 14 | char-ci<=? 15 | char-ci>=? 16 | char-alphabetic? 17 | char-numeric? 18 | char-whitespace? 19 | char-upper-case? 20 | char-lower-case? 21 | char-title-case? 22 | (rename-out [r6rs:char-general-category char-general-category]) 23 | 24 | string-upcase 25 | string-downcase 26 | string-titlecase 27 | string-foldcase 28 | string-ci=? 29 | string-ci? 31 | string-ci<=? 32 | string-ci>=? 33 | 34 | string-normalize-nfd 35 | string-normalize-nfkd 36 | string-normalize-nfc 37 | string-normalize-nfkc) 38 | 39 | (define (r6rs:char-general-category ch) 40 | (hash-ref #hasheq((ll . Ll) 41 | (lu . Lu) 42 | (lt . Lt) 43 | (lm . Lm) 44 | (lo . Lo) 45 | (mn . Mn) 46 | (mc . Mc) 47 | (me . Me) 48 | (nl . Nl) 49 | (no . No) 50 | (nd . Nd) 51 | (zl . Zl) 52 | (zs . Zs) 53 | (zp . Zp) 54 | (pc . Pc) 55 | (pd . Pd) 56 | (ps . Ps) 57 | (pe . Pe) 58 | (pi . Pi) 59 | (pf . Pf) 60 | (po . Po) 61 | (sm . Sm) 62 | (sc . Sc) 63 | (sk . Sk) 64 | (so . So) 65 | (cf . Cf) 66 | (cn . Cn) 67 | (co . Co) 68 | (cc . Cc)) 69 | (char-general-category ch))) 70 | -------------------------------------------------------------------------------- /r6rs-test/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | (define deps '("base")) 5 | (define build-deps '("r6rs-lib")) 6 | 7 | (define pkg-desc "tests for \"r6rs\"") 8 | 9 | (define pkg-authors '(mflatt)) 10 | 11 | (define license 12 | '(Apache-2.0 OR MIT)) 13 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/README.txt: -------------------------------------------------------------------------------- 1 | 2 | ------------------------- An R6RS Test Suite ------------------------- 3 | 4 | ====================================================================== 5 | Files and libraries 6 | ====================================================================== 7 | 8 | Files that end ".sps" are R6RS programs. The main one is "run.sps", 9 | which runs all the tests. 10 | 11 | Files that end ".sls" are R6RS libraries. For example, "base.sls" is a 12 | library that implements `(tests r6rs base)', which is a set of tests 13 | for `(rnrs base)'. Many R6RS implementations will auto-load ".sls" 14 | files if you put the directory of tests in the right place. 15 | 16 | In general, for each `(rnrs ... )' in the standard: 17 | 18 | * There's a library of tests "/.../.sls". It defines and 19 | exports a function `run--...-tests'. 20 | 21 | * There's a program "run//.../.sps" that imports 22 | "/.../.sls", runs the tests, and reports the results. 23 | 24 | And then there's 25 | 26 | * "run.sps", which runs all the tests (as noted above) 27 | 28 | * "run-via-eval.sps", which is similar to "run.ss" but runs each set 29 | of tests via `eval' 30 | 31 | * "test.sls", containing `(tests r6rs test)', which implements the 32 | testing utilities that are used by all the other libraries 33 | 34 | * "contrib.sls" and "run/contrib.sps", which implement and run 35 | contributed tests; these tests might be contributed when someone 36 | finds a bug in an implementation that seems worth testing in other 37 | implementations; also, they may be difficult to pin to a particular 38 | R6RS library; finally, they may use extra libraries from the 39 | "contrib" sub-directory 40 | 41 | ====================================================================== 42 | Limitations and feedback 43 | ====================================================================== 44 | 45 | The test suite tries to cover all of the bindings of R6RS, and it 46 | tries to check a variety of uses 47 | 48 | One goal of this test suite is to avoid using `eval' (except when 49 | specifcally testing `eval'). Avoiding `eval' makes the test suite as 50 | useful as possible to ahead-of-time compilers that implement `eval' 51 | with a separate interpreter. A drawback of the current approach, 52 | however, is that if an R6RS implementation doesn't supply one binding 53 | or does not support a bit of syntax used in a set of tests, then the 54 | whole set of tests fails to load. 55 | 56 | A related problem is that each set of tests is placed into one 57 | function that runs all the tests. This format creates a block of code 58 | that is much larger than in a typical program, which might give some 59 | compilers trouble. 60 | 61 | In any case, reports of bugs (in the tests) and new tests would be 62 | very much appreciated. File either as a Racket bug report at 63 | 64 | http://bugs.racket-lang.org 65 | 66 | ====================================================================== 67 | Hints on running the tests 68 | ====================================================================== 69 | 70 | Ikarus (version 0.0.3+) 71 | ------ 72 | 73 | Put this directory at "/tests/r6rs" and run with "run.sps" 74 | 75 | cd 76 | ikarus --r6rs-script tests/r6rs/run.sps 77 | 78 | or run an individual library's test, such as "run/program.sps" as 79 | 80 | cd 81 | ikarus --r6rs-script tests/r6rs/run/program.sps 82 | 83 | Larceny (version 0.962) 84 | ------- 85 | 86 | Put this directory at "/tests/r6rs" and run with "run.sps" 87 | 88 | larceny -path -r6rs -program run.sps 89 | 90 | or run an individual library's test, such as "run/program.sps" as 91 | 92 | larceny -path -r6rs -program run/program.sps 93 | 94 | PLT Scheme (version 4.0.2.5) 95 | ---------- 96 | 97 | If you get an SVN-based or the "Full" nightly build, then these tests are 98 | in a `tests/r6rs' collection already. You can run all of the tests using 99 | 100 | mzscheme -l tests/r6rs/run.sps 101 | 102 | and so on. 103 | 104 | Otherwise, install this directory as a `tests/r6rs' collection, 105 | perhaps in the location reported by 106 | 107 | (build-path (find-system-path 'addon-dir) 108 | (version) "collects" 109 | "tests" "r6rs") 110 | 111 | Four tests fail; they correspond to documented non-conformance with 112 | R6RS. 113 | 114 | Ypsilon (version 0.9.6) 115 | ------- 116 | 117 | Put this directory at "/tests/r6rs" and run with "run.sps": 118 | 119 | cd 120 | ypsilon --sitelib=. --clean-acc tests/r6rs/run.sps 121 | 122 | or run an individual library's test, such as "run/program.sps" as 123 | 124 | cd 125 | ypsilon --sitelib=. --clean-acc tests/r6rs/run/program.sps 126 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/contrib.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs contrib) 4 | (export run-contrib-tests) 5 | (import (rnrs) 6 | (tests r6rs test) 7 | (prefix (tests r6rs contrib helper1) L:)) 8 | 9 | ;; Definitions ---------------------------------------- 10 | 11 | ;; from Derick Eddington: 12 | (define-syntax my-letrec 13 | (syntax-rules () 14 | [(_ ([v e] ...) . b) 15 | (let () 16 | (define t (list e ...)) 17 | (define v (let ([v (car t)]) (set! t (cdr t)) v)) 18 | ... 19 | . b)])) 20 | 21 | ;; Expressions ---------------------------------------- 22 | 23 | (define (run-contrib-tests) 24 | 25 | ;; from Derick Eddington: 26 | (test (my-letrec ([f (lambda (x) (g x 2))] 27 | [g (lambda (x y) (+ x y))]) 28 | (f 1)) 29 | 3) 30 | 31 | ;; from Derick Eddington: 32 | (test (L:s L:x) 'ok) 33 | 34 | ;;; 35 | )) 36 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/contrib/helper1.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | ;; from Derick Eddington 4 | 5 | (library (tests r6rs contrib helper1) 6 | (export x s) 7 | (import (rnrs)) 8 | 9 | (define-syntax x (lambda (_) #f)) 10 | 11 | (define-syntax s 12 | (syntax-rules (x) ;; This x refers only to the one in scope above. 13 | [(_ x) ;; This pattern matches only if the 2nd subform is an 14 | ;; identifier that is free-identifier=? to the x in the literals list. 15 | 'ok]))) 16 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/control.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs control) 4 | (export run-control-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define (run-control-tests) 9 | 10 | (test (when (> 3 2) 'greater) 'greater) 11 | (test/unspec (when (< 3 2) 'greater)) 12 | (test/unspec (unless (> 3 2) 'less)) 13 | (test (unless (< 3 2) 'less) 'less) 14 | 15 | (test (do ((vec (make-vector 5)) 16 | (i 0 (+ i 1))) 17 | ((= i 5) vec) 18 | (vector-set! vec i i)) 19 | '#(0 1 2 3 4)) 20 | 21 | (test (let ((x '(1 3 5 7 9))) 22 | (do ((x x (cdr x)) 23 | (sum 0 (+ sum (car x)))) 24 | ((null? x) sum))) 25 | 25) 26 | 27 | (let ([foo 28 | (case-lambda 29 | (() 'zero) 30 | ((x) (list 'one x)) 31 | ((x y) (list 'two x y)) 32 | ((a b c d . e) (list 'four a b c d e)) 33 | (rest (list 'rest rest)))]) 34 | 35 | (test (foo) 'zero) 36 | (test (foo 1) '(one 1)) 37 | (test (foo 1 2) '(two 1 2)) 38 | (test (foo 1 2 3) '(rest (1 2 3))) 39 | (test (foo 1 2 3 4) '(four 1 2 3 4 ()))) 40 | 41 | ;; 42 | )) 43 | 44 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/enums.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs enums) 4 | (export run-enums-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | ;; ---------------------------------------- 9 | 10 | (define-enumeration color 11 | (black white purple maroon) 12 | color-set) 13 | 14 | ;; ---------------------------------------- 15 | 16 | (define (run-enums-tests) 17 | 18 | (test (let* ((e (make-enumeration '(red green blue))) 19 | (i (enum-set-indexer e))) 20 | (list (i 'red) (i 'green) (i 'blue) (i 'yellow))) 21 | '(0 1 2 #f)) 22 | 23 | (let* ((e (make-enumeration '(red green blue))) 24 | (r ((enum-set-constructor e) '(red)))) 25 | (test (enum-set->list (enum-set-universe e)) 26 | '(red green blue)) 27 | (test (enum-set->list (enum-set-universe r)) 28 | '(red green blue)) 29 | (test ((enum-set-indexer 30 | ((enum-set-constructor e) '(red))) 31 | 'green) 32 | 1) 33 | (test (enum-set-member? 'red e) #t) 34 | (test (enum-set-member? 'black e) #f) 35 | (test (enum-set-subset? e e) #t) 36 | (test (enum-set-subset? r e) #t) 37 | (test (enum-set-subset? e r) #f) 38 | (test (enum-set-subset? e (make-enumeration '(blue green red))) #t) 39 | (test (enum-set-subset? e (make-enumeration '(blue green red black))) #t) 40 | (test (enum-set-subset? (make-enumeration '(blue green red black)) e) #f) 41 | (test (enum-set-subset? ((enum-set-constructor 42 | (make-enumeration '(blue green red black))) 43 | '(red)) 44 | e) #f) 45 | (test (enum-set-subset? ((enum-set-constructor 46 | (make-enumeration '(green red))) 47 | '(red)) 48 | e) #t) 49 | (test (enum-set=? e e) #t) 50 | (test (enum-set=? r e) #f) 51 | (test (enum-set=? e r) #f) 52 | (test (enum-set=? e (make-enumeration '(blue green red))) #t)) 53 | 54 | (test (let* ((e (make-enumeration '(red green blue))) 55 | (c (enum-set-constructor e))) 56 | (list 57 | (enum-set-member? 'blue (c '(red blue))) 58 | (enum-set-member? 'green (c '(red blue))) 59 | (enum-set-subset? (c '(red blue)) e) 60 | (enum-set-subset? (c '(red blue)) (c '(blue red))) 61 | (enum-set-subset? (c '(red blue)) (c '(red))) 62 | (enum-set=? (c '(red blue)) (c '(blue red))))) 63 | (list #t #f #t #t #f #t)) 64 | 65 | (test (let* ((e (make-enumeration '(red green blue))) 66 | (c (enum-set-constructor e))) 67 | (enum-set->list (c '(blue red)))) 68 | '(red blue)) 69 | 70 | (test (let* ((e (make-enumeration '(red green blue))) 71 | (c (enum-set-constructor e))) 72 | (list (enum-set->list 73 | (enum-set-union (c '(blue)) (c '(red)))) 74 | (enum-set->list 75 | (enum-set-intersection (c '(red green)) 76 | (c '(red blue)))) 77 | (enum-set->list 78 | (enum-set-difference (c '(red green)) 79 | (c '(red blue)))))) 80 | '((red blue) (red) (green))) 81 | 82 | (test (let* ((e (make-enumeration '(red green blue))) 83 | (c (enum-set-constructor e))) 84 | (enum-set->list 85 | (enum-set-complement (c '(red))))) 86 | '(green blue)) 87 | 88 | (test (let ((e1 (make-enumeration 89 | '(red green blue black))) 90 | (e2 (make-enumeration 91 | '(red black white)))) 92 | (enum-set->list 93 | (enum-set-projection e1 e2))) 94 | '(red black)) 95 | 96 | (test (color black) 'black) 97 | ; (test/exn (color purpel) &syntax) ; not a runtime exception 98 | (test (enum-set->list (color-set)) '()) 99 | (test (enum-set->list 100 | (color-set maroon white)) 101 | '(white maroon)) 102 | 103 | ;; 104 | )) 105 | 106 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/eval.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs eval) 4 | (export run-eval-tests) 5 | (import (rnrs) 6 | (rnrs eval) 7 | (tests r6rs test)) 8 | 9 | (define (run-eval-tests) 10 | 11 | (test (eval '(let ((x 3)) x) 12 | (environment '(rnrs))) 13 | 3) 14 | 15 | (test (eval 16 | '(eval:car (eval:cons 2 4)) 17 | (environment 18 | '(prefix (only (rnrs) car cdr cons null?) 19 | eval:))) 20 | 2) 21 | 22 | ;; Check that `eval' at compile-time produces values (such as conditions) 23 | ;; that make sense at compile time (i.e., no phase crossing): 24 | (test (eval 25 | '(let-syntax ([x (lambda (stx) 26 | (datum->syntax 27 | #'here 28 | (condition-message 29 | (call/cc 30 | (lambda (esc) 31 | (with-exception-handler 32 | (lambda (exn) (esc exn)) 33 | (lambda () 34 | (eval '(assertion-violation 'exptime "ok") 35 | (environment 36 | '(rnrs) 37 | '(rnrs eval))))))))))]) 38 | x) 39 | (environment '(rnrs) '(for (rnrs eval) expand))) 40 | "ok") 41 | 42 | ;; 43 | )) 44 | 45 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/exceptions.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs exceptions) 4 | (export run-exceptions-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define (run-exceptions-tests) 9 | 10 | (test/output 11 | (guard (con 12 | ((error? con) 13 | (if (message-condition? con) 14 | (display (condition-message con)) 15 | (display "an error has occurred")) 16 | 'error) 17 | ((violation? con) 18 | (if (message-condition? con) 19 | (display (condition-message con)) 20 | (display "the program has a bug")) 21 | 'violation)) 22 | (raise 23 | (condition 24 | (make-error) 25 | (make-message-condition "I am an error")))) 26 | 'error 27 | "I am an error") 28 | 29 | (test/exn 30 | (guard (con 31 | ((error? con) 32 | (if (message-condition? con) 33 | (display (condition-message con)) 34 | (display "an error has occurred")) 35 | 'error)) 36 | (raise 37 | (condition 38 | (make-violation) 39 | (make-message-condition "I am an error")))) 40 | &violation) 41 | 42 | (test/output 43 | (guard (con 44 | ((error? con) 45 | (display "error opening file") 46 | #f)) 47 | (call-with-input-file "foo-must-not-exist.scm" read)) 48 | #f 49 | "error opening file") 50 | 51 | (test/output 52 | (with-exception-handler 53 | (lambda (con) 54 | (cond 55 | ((not (warning? con)) 56 | (raise con)) 57 | ((message-condition? con) 58 | (display (condition-message con))) 59 | (else 60 | (display "a warning has been issued"))) 61 | 42) 62 | (lambda () 63 | (+ (raise-continuable 64 | (condition 65 | (make-warning) 66 | (make-message-condition 67 | "should be a number"))) 68 | 23))) 69 | 65 70 | "should be a number") 71 | 72 | (test/exn (with-exception-handler (lambda (x) 0) 73 | (lambda () (error #f "bad"))) 74 | &non-continuable) 75 | 76 | 77 | (let ([v '()]) 78 | (test (guard (exn [(equal? exn 5) 'five]) 79 | ;; `guard' should jump back in before re-raising 80 | (guard (exn [(equal? exn 6) 'six]) 81 | (dynamic-wind 82 | (lambda () (set! v (cons 'in v))) 83 | (lambda () (raise 5)) 84 | (lambda () (set! v (cons 'out v)))))) 85 | 'five) 86 | (test v '(out in out in))) 87 | 88 | 89 | (test/output 90 | (guard (con 91 | ((violation? con) 92 | (display (condition-message con)) 93 | 'violation)) 94 | (read (open-string-input-port "\\xDDDD;"))) 95 | 'violation 96 | "out of range escape: `\\xDDDD;'") 97 | 98 | ;; 99 | )) 100 | 101 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/hashtables.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs hashtables) 4 | (export run-hashtables-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define-syntax test-ht 9 | (syntax-rules () 10 | [(_ mk key=? ([key val] ...) 11 | key/r orig-val new-val 12 | key/a a-val 13 | key/rm) 14 | (let ([h mk]) 15 | (test (hashtable? h) #t) 16 | (test (hashtable-size h) 0) 17 | (test (hashtable-ref h key/r 'nope) 'nope) 18 | (test/unspec (hashtable-delete! h key)) ... 19 | (test (hashtable-size h) 0) 20 | 21 | (test (hashtable-ref h key/r 'nope) 'nope) 22 | (test (hashtable-contains? h key/r) #f) 23 | (test/unspec (hashtable-set! h key/r orig-val)) 24 | (test (hashtable-ref h key/r 'nope) orig-val) 25 | (test (hashtable-contains? h key/r) #t) 26 | (test (hashtable-size h) 1) 27 | 28 | (test/unspec (hashtable-set! h key val)) ... 29 | (test (hashtable-size h) (length '(key ...))) 30 | (test (hashtable-ref h key/r 'nope) orig-val) 31 | (test (hashtable-ref h key 'nope) val) ... 32 | 33 | (let ([h1 (hashtable-copy h #t)] 34 | [h1i (hashtable-copy h)]) 35 | (test (hashtable-mutable? h) #t) 36 | (test (hashtable-mutable? h1) #t) 37 | (test (hashtable-mutable? h1i) #f) 38 | 39 | (test (vector-length (hashtable-keys h)) 40 | (hashtable-size h)) 41 | (test (vector-length (let-values ([(k e) (hashtable-entries h)]) 42 | e)) 43 | (hashtable-size h)) 44 | (test (exists (lambda (v) (key=? v key/r)) 45 | (vector->list (hashtable-keys h))) 46 | #t) 47 | 48 | (test/unspec (hashtable-set! h key/r new-val)) 49 | (test (hashtable-contains? h key/r) #t) 50 | (test (hashtable-ref h key/r 'nope) new-val) 51 | 52 | (test/unspec (hashtable-update! h key/r (lambda (v) 53 | (test v new-val) 54 | orig-val) 55 | 'nope)) 56 | (test (hashtable-ref h key/r 'nope) orig-val) 57 | (test/unspec (hashtable-update! h key/r (lambda (v) 58 | (test v orig-val) 59 | new-val) 60 | 'nope)) 61 | (test (hashtable-ref h key/r 'nope) new-val) 62 | 63 | (test/unspec (hashtable-update! h key/a (lambda (v) 64 | (test v 'nope) 65 | a-val) 66 | 'nope)) 67 | (test (hashtable-ref h key/a 'nope) a-val) 68 | (test/unspec (hashtable-delete! h key/a)) 69 | 70 | (test (hashtable-contains? h key/rm) #t) 71 | (hashtable-delete! h key/rm) 72 | (test (hashtable-contains? h key/rm) #f) 73 | (test (hashtable-ref h key/rm 'nope) 'nope) 74 | 75 | (test (hashtable-ref h1 key 'nope) val) ... 76 | (test (hashtable-ref h1i key 'nope) val) ... 77 | (test (hashtable-contains? h1 key/rm) #t) 78 | (test (hashtable-contains? h1i key/rm) #t) 79 | 80 | (hashtable-clear! h) 81 | (test (hashtable-contains? h key) #f) ... 82 | (test (hashtable-contains? h1 key) #t) ... 83 | (test (hashtable-contains? h1i key) #t) ... 84 | 85 | (test/unspec (hashtable-clear! h1)) 86 | 87 | (test/exn (hashtable-set! h1i key/r #f) &violation) 88 | (test/exn (hashtable-delete! h1i key/r) &violation) 89 | (test/exn (hashtable-update! h1i key/r (lambda (q) q) 'none) &violation) 90 | (test/exn (hashtable-clear! h1i) &violation)))])) 91 | 92 | ;; ---------------------------------------- 93 | 94 | (define (run-hashtables-tests) 95 | 96 | (let-values ([(kv vv) 97 | (let ((h (make-eqv-hashtable))) 98 | (hashtable-set! h 1 'one) 99 | (hashtable-set! h 2 'two) 100 | (hashtable-set! h 3 'three) 101 | (hashtable-entries h))]) 102 | (test/alts (cons kv vv) 103 | '(#(1 2 3) . #(one two three)) 104 | '(#(1 3 2) . #(one three two)) 105 | '(#(2 1 3) . #(two one three)) 106 | '(#(2 3 1) . #(two three one)) 107 | '(#(3 1 2) . #(three one two)) 108 | '(#(3 2 1) . #(three two one)))) 109 | 110 | (test-ht (make-eq-hashtable) eq? 111 | (['a 7] ['b "bee"] 112 | [#t 8] [#f 9] 113 | ['c 123456789101112]) 114 | 'b "bee" "bumble" 115 | 'd 12 116 | 'c) 117 | 118 | (test-ht (make-eqv-hashtable) eqv? 119 | (['a 7] [#\b "bee"] 120 | [#t 8] [0.0 85] 121 | [123456789101112 'c]) 122 | #\b "bee" "bumble" 123 | 'd 12 124 | 123456789101112) 125 | 126 | (let ([val-of (lambda (a) 127 | (if (number? a) 128 | a 129 | (string->number a)))]) 130 | (test-ht (make-hashtable val-of 131 | (lambda (a b) 132 | (= (val-of a) (val-of b)))) 133 | equal? 134 | ([1 'one]["2" 'two] 135 | [3 'three]["4" 'four]) 136 | 2 'two 'er 137 | 5 'five 138 | 4)) 139 | 140 | (test (hashtable? (make-eq-hashtable 10)) #t) 141 | (test (hashtable? (make-eqv-hashtable 10)) #t) 142 | (test (hashtable? (make-hashtable (lambda (x) 0) equal? 10)) #t) 143 | 144 | (let ([zero (lambda (a) 0)] 145 | [same? (lambda (a b) #t)]) 146 | (let ([ht (make-hashtable zero same?)]) 147 | (test (hashtable-equivalence-function ht) same?) 148 | (test (hashtable-hash-function ht) zero))) 149 | 150 | (test (equal-hash "a") (equal-hash (make-string 1 #\a))) 151 | (test (equal-hash 1024) (equal-hash (expt 2 10))) 152 | (test (equal-hash '(1 2 3)) (equal-hash (list 1 2 3))) 153 | 154 | (test (string-hash "a") (string-hash (make-string 1 #\a))) 155 | (test (string-hash "aaaaa") (string-hash (make-string 5 #\a))) 156 | (test (string-ci-hash "aAaAA") (string-ci-hash (make-string 5 #\a))) 157 | (test (string-ci-hash "aAaAA") (string-ci-hash (make-string 5 #\A))) 158 | 159 | (test (symbol-hash 'a) (symbol-hash 'a)) 160 | 161 | ;; 162 | )) 163 | 164 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-command-line-arguments '(("run.sps" ()))) 4 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/io/simple.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs io simple) 4 | (export run-io-simple-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define (run-io-simple-tests) 9 | 10 | (test/unspec 11 | (when (file-exists? "io-tmp2") 12 | (delete-file "io-tmp2"))) 13 | 14 | (test/values (call-with-output-file "io-tmp2" 15 | (lambda (p) 16 | (test (output-port? p) #t) 17 | (test (binary-port? p) #f) 18 | (test (textual-port? p) #t) 19 | (test/unspec (write-char #\q p)) 20 | (test/unspec (newline p)) 21 | (test/unspec (display "more" p)) 22 | (test/unspec (write "last" p)) 23 | (values 3 4))) 24 | 3 4) 25 | 26 | (test/values (call-with-input-file "io-tmp2" 27 | (lambda (p) 28 | (test (input-port? p) #t) 29 | (test (binary-port? p) #f) 30 | (test (textual-port? p) #t) 31 | (test (peek-char p) #\q) 32 | (test (read-char p) #\q) 33 | (test (read-char p) #\newline) 34 | (test (read-char p) #\m) 35 | (test (read-char p) #\o) 36 | (test (peek-char p) #\r) 37 | (test (read-char p) #\r) 38 | (test (read-char p) #\e) 39 | (test (read p) "last") 40 | (test (read p) (eof-object)) 41 | (values 7 8 9))) 42 | 7 8 9) 43 | 44 | (test/unspec (delete-file "io-tmp2")) 45 | 46 | (let ([p (open-output-file "io-tmp2")]) 47 | (test (output-port? p) #t) 48 | (test (binary-port? p) #f) 49 | (test (textual-port? p) #t) 50 | (test/unspec (write-char #\! p)) 51 | (test/unspec (close-output-port p))) 52 | 53 | (let ([p (open-input-file "io-tmp2")]) 54 | (test (input-port? p) #t) 55 | (test (binary-port? p) #f) 56 | (test (textual-port? p) #t) 57 | (test (read-char p) #\!) 58 | (test/unspec (close-input-port p))) 59 | 60 | (test/unspec (delete-file "io-tmp2")) 61 | 62 | (test/values (with-output-to-file "io-tmp2" 63 | (lambda () 64 | (test/unspec (write-char #\z)) 65 | (test/unspec (newline)) 66 | (test/unspec (display "a")) 67 | (test/unspec (write "a")) 68 | (values 30 40))) 69 | 30 40) 70 | 71 | (test/values (with-input-from-file "io-tmp2" 72 | (lambda () 73 | (test (peek-char) #\z) 74 | (test (read-char) #\z) 75 | (test (read) 'a) 76 | (test (read) "a") 77 | (test (read) (eof-object)) 78 | (values 70 80 90))) 79 | 70 80 90) 80 | 81 | (test/unspec 82 | (when (file-exists? "io-tmp2") 83 | (delete-file "io-tmp2"))) 84 | 85 | (test (input-port? (current-input-port)) #t) 86 | (test (binary-port? (current-input-port)) #f) 87 | (test (textual-port? (current-input-port)) #t) 88 | 89 | (test (output-port? (current-output-port)) #t) 90 | (test (binary-port? (current-output-port)) #f) 91 | (test (textual-port? (current-output-port)) #t) 92 | 93 | (test (output-port? (current-error-port)) #t) 94 | (test (binary-port? (current-error-port)) #f) 95 | (test (textual-port? (current-error-port)) #t) 96 | 97 | ;; 98 | )) 99 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/io/sync.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require rnrs/io/ports-6) 3 | 4 | ;; Make sure that an R6RS port plays ok with sync, 5 | ;; particularly when no input is available. 6 | (void (sync/timeout 0 (standard-input-port))) 7 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/lists.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs lists) 4 | (export run-lists-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define (run-lists-tests) 9 | 10 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11 | ;; Tests originally from R6RS 12 | 13 | (test (find even? '(3 1 4 1 5 9)) 4) 14 | (test (find even? '(3 1 5 1 5 9)) #f) 15 | 16 | (test (for-all even? '()) #t) 17 | (test (for-all even? '(3 1 4 1 5 9)) #f) 18 | ;; (test (for-all even? '(3 1 4 1 5 9 . 2)) #f) ; removed from R6RS 19 | (test (for-all even? '(2 4 14)) #t) 20 | (test/exn (for-all even? '(2 4 14 . 9)) &assertion) 21 | (test (for-all (lambda (n) (and (even? n) n)) 22 | '(2 4 14)) 23 | 14) 24 | (test (for-all < '(1 2 3) '(2 3 4)) #t) 25 | (test (for-all < '(1 2 4) '(2 3 4)) #f) 26 | 27 | (test (exists even? '(3 1 4 1 5 9)) #t) 28 | (test (exists even? '(3 1 1 5 9)) #f) 29 | (test (exists even? '()) #f) 30 | (test/exn (exists even? '(3 1 1 5 9 . 2)) &assertion) 31 | (test (exists (lambda (n) (and (even? n) n)) '(2 1 4 14)) 2) 32 | (test (exists < '(1 2 4) '(2 3 4)) #t) 33 | (test (exists > '(1 2 3) '(2 3 4)) #f) 34 | 35 | (test (filter even? '(3 1 4 1 5 9 2 6)) '(4 2 6)) 36 | 37 | (test/values (partition even? '(3 1 4 1 5 9 2 6)) '(4 2 6) '(3 1 1 5 9)) 38 | 39 | (test (fold-left + 0 '(1 2 3 4 5)) 15) 40 | 41 | (test (fold-left (lambda (a e) (cons e a)) '() 42 | '(1 2 3 4 5)) 43 | '(5 4 3 2 1)) 44 | 45 | (test (fold-left (lambda (count x) 46 | (if (odd? x) (+ count 1) count)) 47 | 0 48 | '(3 1 4 1 5 9 2 6 5 3)) 49 | 7) 50 | (test (fold-left (lambda (max-len s) 51 | (max max-len (string-length s))) 52 | 0 53 | '("longest" "long" "longer")) 54 | 7) 55 | 56 | (test (fold-left cons '(q) '(a b c)) '((((q) . a) . b) . c)) 57 | 58 | (test (fold-left + 0 '(1 2 3) '(4 5 6)) 21) 59 | 60 | (test (fold-right + 0 '(1 2 3 4 5)) 15) 61 | 62 | (test (fold-right cons '() '(1 2 3 4 5)) '(1 2 3 4 5)) 63 | 64 | (test (fold-right (lambda (x l) 65 | (if (odd? x) (cons x l) l)) 66 | '() 67 | '(3 1 4 1 5 9 2 6 5)) 68 | '(3 1 1 5 9 5)) 69 | 70 | (test (fold-right cons '(q) '(a b c)) '(a b c q)) 71 | 72 | (test (fold-right + 0 '(1 2 3) '(4 5 6)) 21) 73 | 74 | (test (remp even? '(3 1 4 1 5 9 2 6 5)) '(3 1 1 5 9 5)) 75 | 76 | (test (remove 1 '(3 1 4 1 5 9 2 6 5)) '(3 4 5 9 2 6 5)) 77 | 78 | (test (remv 1 '(3 1 4 1 5 9 2 6 5)) '(3 4 5 9 2 6 5)) 79 | 80 | (test (remq 'foo '(bar foo baz)) '(bar baz)) 81 | 82 | (test (memp even? '(3 1 4 1 5 9 2 6 5)) '(4 1 5 9 2 6 5)) 83 | 84 | (test (memq 'a '(a b c)) '(a b c)) 85 | (test (memq 'b '(a b c)) '(b c)) 86 | (test (memq 'a '(b c d)) #f) 87 | (test (memq (list 'a) '(b (a) c)) #f) 88 | (test (member (list 'a) '(b (a) c)) '((a) c)) 89 | (test/unspec (memq 101 '(100 101 102))) 90 | (test (memv 101 '(100 101 102)) '(101 102)) 91 | 92 | (let ([d '((3 a) (1 b) (4 c))]) 93 | (test (assp even? d) '(4 c)) 94 | (test (assp odd? d) '(3 a))) 95 | 96 | (let ([e '((a 1) (b 2) (c 3))]) 97 | (test (assq 'a e) '(a 1)) 98 | (test (assq 'b e) '(b 2)) 99 | (test (assq 'd e) #f)) 100 | 101 | 102 | (test (assq (list 'a) '(((a)) ((b)) ((c)))) 103 | #f) 104 | (test (assoc (list 'a) '(((a)) ((b)) ((c)))) 105 | '((a))) 106 | (test/unspec (assq 5 '((2 3) (5 7) (11 13)))) 107 | (test (assv 5 '((2 3) (5 7) (11 13))) '(5 7)) 108 | 109 | (test (cons* 1 2 '(3 4 5)) '(1 2 3 4 5)) 110 | (test (cons* 1 2 3) '(1 2 . 3)) 111 | (test (cons* 1) 1) 112 | 113 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 114 | ;; Tests originally from Ikarus 115 | 116 | (test (for-all even? '(1 2 3 4)) #f) 117 | (test (for-all even? '(10 12 14 16)) #t) 118 | (test (for-all even? '(2 3 4)) #f) 119 | (test (for-all even? '(12 14 16)) #t) 120 | (test (for-all (lambda (x) x) '(12 14 16)) 16) 121 | (test (for-all (lambda (x) x) '(12 14)) 14) 122 | (test (for-all (lambda (x) x) '(12)) 12) 123 | (test (for-all (lambda (x) x) '()) #t) 124 | ;; (test (for-all even? '(13 . 14)) #f) ; removed from R6RS 125 | (test (for-all cons '(1 2 3) '(a b c)) '(3 . c)) 126 | (test (for-all (lambda (a b) (= a 1)) '(1 2 3) '(a b c)) #f) 127 | ;; R6RS merely says that this *should* work, but not must: 128 | ;; (test (for-all (lambda (a b) (= a 1)) '(1 2) '(a b c)) #f) 129 | (test (fold-left + 0 '(1 2 3 4 5)) 15) 130 | (test (fold-left (lambda (a b) (cons b a)) '() '(1 2 3 4 5)) 131 | '(5 4 3 2 1)) 132 | (test (fold-left (lambda (count x) 133 | (if (odd? x) 134 | (+ count 1) 135 | count)) 136 | 0 137 | '(3 1 4 1 5 9 2 6 5 3)) 138 | 7) 139 | (test (fold-left cons '(q) '(a b c)) '((((q) . a) . b) . c)) 140 | (test (fold-left + 0 '(1 2 3) '(4 5 6)) 21) 141 | (test (fold-right + 0 '(1 2 3 4 5)) 15) 142 | (test (fold-right cons '() '(1 2 3 4 5)) 143 | '(1 2 3 4 5)) 144 | (test (fold-right (lambda (x l) 145 | (if (odd? x) 146 | (cons x l) 147 | l)) 148 | '() 149 | '(3 1 4 1 5 9 2 6 5 3)) 150 | '(3 1 1 5 9 5 3)) 151 | (test (fold-right + 0 '(1 2 3) '(4 5 6)) 21) 152 | 153 | ;; 154 | )) 155 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/mutable-pairs.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs mutable-pairs) 4 | (export run-mutable-pairs-tests) 5 | (import (rnrs) 6 | (rnrs mutable-pairs) 7 | (tests r6rs test)) 8 | 9 | (define (f) (list 'not-a-constant-list)) 10 | (define (g) '(constant-list)) 11 | 12 | (define (run-mutable-pairs-tests) 13 | 14 | (test/unspec (set-car! (f) 3)) 15 | (test/unspec-or-exn (set-car! (g) 3) 16 | &assertion) 17 | 18 | (test (let ((x (list 'a 'b 'c 'a)) 19 | (y (list 'a 'b 'c 'a 'b 'c 'a))) 20 | (set-cdr! (list-tail x 2) x) 21 | (set-cdr! (list-tail y 5) y) 22 | (list 23 | (equal? x x) 24 | (equal? x y) 25 | (equal? (list x y 'a) (list y x 'b)))) 26 | '(#t #t #f)) 27 | 28 | ;; 29 | )) 30 | 31 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/mutable-strings.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs mutable-strings) 4 | (export run-mutable-strings-tests) 5 | (import (rnrs) 6 | (rnrs mutable-strings) 7 | (tests r6rs test)) 8 | 9 | (define (f) (make-string 3 #\*)) 10 | (define (g) "***") 11 | 12 | (define (run-mutable-strings-tests) 13 | 14 | (test/unspec (string-set! (f) 0 #\?)) 15 | (test/unspec-or-exn (string-set! (g) 0 #\?) 16 | &assertion) 17 | (test/unspec-or-exn (string-set! (symbol->string 'immutable) 18 | 0 19 | #\?) 20 | &assertion) 21 | 22 | ;; 23 | )) 24 | 25 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/programs.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs programs) 4 | (export run-programs-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define (run-programs-tests) 9 | 10 | (test (list? (command-line)) #t) 11 | (test (string? (car (command-line))) #t) 12 | 13 | ;; 14 | )) 15 | 16 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/r5rs.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs r5rs) 4 | (export run-r5rs-tests) 5 | (import (rnrs) 6 | (rnrs r5rs) 7 | (rnrs eval) 8 | (tests r6rs test)) 9 | 10 | ;; ---------------------------------------- 11 | 12 | (define a-stream 13 | (letrec ((next 14 | (lambda (n) 15 | (cons n (delay (next (+ n 1))))))) 16 | (next 0))) 17 | (define head car) 18 | (define tail 19 | (lambda (stream) (force (cdr stream)))) 20 | 21 | (define count 0) 22 | (define p 23 | (delay (begin (set! count (+ count 1)) 24 | (if (> count x) 25 | count 26 | (force p))))) 27 | (define x 5) 28 | 29 | ;; ---------------------------------------- 30 | 31 | (define (run-r5rs-tests) 32 | 33 | (test (modulo 13 4) 1) 34 | (test (remainder 13 4) 1) 35 | 36 | (test (modulo -13 4) 3) 37 | (test (remainder -13 4) -1) 38 | 39 | (test (modulo 13 -4) -3) 40 | (test (remainder 13 -4) 1) 41 | 42 | (test (modulo -13 -4) -1) 43 | (test (remainder -13 -4) -1) 44 | 45 | (test (remainder -13 -4.0) -1.0) 46 | 47 | (test (force (delay (+ 1 2))) 3) 48 | 49 | (test (let ((p (delay (+ 1 2)))) 50 | (list (force p) (force p))) 51 | '(3 3)) 52 | 53 | 54 | (test (head (tail (tail a-stream))) 2) 55 | 56 | (test/unspec p) 57 | (test (force p) 6) 58 | (test/unspec p) 59 | (test (begin (set! x 10) 60 | (force p)) 61 | 6) 62 | 63 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 64 | ;; quotient, remainder, and modulo tests from Ikarus's 65 | ;; "bignums" test suite 66 | 67 | (test (quotient 348972 3434) 68 | 101) 69 | (test (quotient -348972 3434) 70 | -101) 71 | (test (quotient 348972 -3434) 72 | -101) 73 | (test (quotient -348972 -3434) 74 | 101) 75 | (test (quotient 536870912 238) 76 | 2255760) 77 | (test (quotient -536870912 238) 78 | -2255760) 79 | (test (quotient 536870912 -238) 80 | -2255760) 81 | (test (quotient -536870912 -238) 82 | 2255760) 83 | (test (quotient 536870912238479837489374 324873) 84 | 1652556267336712615) 85 | (test (quotient -536870912238479837489374 324873) 86 | -1652556267336712615) 87 | (test (quotient 536870912238479837489374 -324873) 88 | -1652556267336712615) 89 | (test (quotient -536870912238479837489374 -324873) 90 | 1652556267336712615) 91 | (test (quotient 536870912238479837489374 3248732398479823749283) 92 | 165) 93 | (test (quotient -536870912238479837489374 3248732398479823749283) 94 | -165) 95 | (test (quotient 536870912238479837489374 -3248732398479823749283) 96 | -165) 97 | (test (quotient -536870912238479837489374 -3248732398479823749283) 98 | 165) 99 | (test (quotient 5368709122384798374893743894798327498234 3248732398479823749283) 100 | 1652555047284588078) 101 | (test (quotient -5368709122384798374893743894798327498234 3248732398479823749283) 102 | -1652555047284588078) 103 | (test (quotient 5368709122384798374893743894798327498234 -3248732398479823749283) 104 | -1652555047284588078) 105 | (test (quotient -5368709122384798374893743894798327498234 -3248732398479823749283) 106 | 1652555047284588078) 107 | (test (remainder 23 349839489348) 108 | 23) 109 | (test (remainder -23 349839489348) 110 | -23) 111 | (test (remainder 23 -349839489348) 112 | 23) 113 | (test (remainder -23 -349839489348) 114 | -23) 115 | (test (modulo 348972 3434) 116 | 2138) 117 | (test (modulo -348972 3434) 118 | 1296) 119 | (test (modulo 348972 -3434) 120 | -1296) 121 | (test (modulo -348972 -3434) 122 | -2138) 123 | (test (modulo -23 349839489348) 124 | 349839489325) 125 | (test (modulo -23 -349839489348) 126 | -23) 127 | (test (modulo 23 349839489348) 128 | 23) 129 | (test (modulo 23 -349839489348) 130 | -349839489325) 131 | (test (remainder 536870912 238) 132 | 32) 133 | (test (remainder -536870912 238) 134 | -32) 135 | (test (remainder 536870912 -238) 136 | 32) 137 | (test (remainder -536870912 -238) 138 | -32) 139 | (test (modulo 536870912 238) 140 | 32) 141 | (test (modulo -536870912 238) 142 | 206) 143 | (test (modulo 536870912 -238) 144 | -206) 145 | (test (modulo -536870912 -238) 146 | -32) 147 | (test (modulo 536870912238479837489374 324873) 148 | 116479) 149 | (test (modulo -536870912238479837489374 324873) 150 | 208394) 151 | (test (modulo 536870912238479837489374 -324873) 152 | -208394) 153 | (test (modulo -536870912238479837489374 -324873) 154 | -116479) 155 | (test (modulo 536870912238479837489374 3248732398479823749283) 156 | 830066489308918857679) 157 | (test (modulo 536870912238479837489374 -3248732398479823749283) 158 | -2418665909170904891604) 159 | (test (modulo -536870912238479837489374 3248732398479823749283) 160 | 2418665909170904891604) 161 | (test (modulo -536870912238479837489374 -3248732398479823749283) 162 | -830066489308918857679) 163 | 164 | ;; ---------------------------------------- 165 | 166 | (test (exact->inexact 1) 1.0) 167 | (test (exact->inexact 1.0) 1.0) 168 | (test (inexact->exact 1) 1) 169 | (test (inexact->exact 1.0) 1) 170 | 171 | ;; ---------------------------------------- 172 | 173 | (test (eval '(cond [#t 1]) (null-environment 5)) 1) 174 | (test (eval '(cond [#t => (lambda (x) x)]) (null-environment 5)) #t) 175 | 176 | 177 | (test (eval '(cons 1 2) (scheme-report-environment 5)) '(1 . 2)) 178 | 179 | ;; 180 | )) 181 | 182 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/reader.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs reader) 4 | (export run-reader-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define-syntax number-test 9 | (syntax-rules () 10 | [(_ str ...) 11 | (begin 12 | (test (read (open-string-input-port str)) 13 | (string->number str)) 14 | ...)])) 15 | 16 | (define (run-reader-tests) 17 | (number-test 18 | "12" 19 | "+12" 20 | "3427384783264876238746784234" 21 | "0" 22 | "+0" 23 | "-12" 24 | "-3498738947983748939478347834" 25 | "-0" 26 | "#x-238973897AAAAAFFFFbb00bbdddcc" 27 | "#x238973897AAAAA000FFFFbbbbdddcc" 28 | "#x+07edf387" 29 | "#x+0" 30 | "#x-0" 31 | "#x0" 32 | "#b01010101010000000111111111110000" 33 | "#b-01010101010000000111111111110000" 34 | "#b+01010101010000000111111111110000" 35 | "#b+0" 36 | "#b-0" 37 | "#b0" 38 | "#d2398128321308912830912830912839" 39 | "#d-2398128321308912830912830912839" 40 | "#d+2398128321308912830912830912839" 41 | "#d+0" 42 | "#d-0" 43 | "#d0" 44 | "#o237612036721631263126371263712" 45 | "#o-2376120036721631263126371263712" 46 | "#o+23761236721631263126371263712" 47 | "#o+0" 48 | "#o-0" 49 | "#o0" 50 | 51 | "#X-238973897AAAAAFFFFbb00bbdddcc" 52 | "#X238973897AAAAA000FFFFbbbbdddcc" 53 | "#X+07edf387" 54 | "#X+0" 55 | "#X-0" 56 | "#X0" 57 | "#B01010101010000000111111111110000" 58 | "#B-01010101010000000111111111110000" 59 | "#B+01010101010000000111111111110000" 60 | "#B+0" 61 | "#B-0" 62 | "#B0" 63 | "#D2398128321308912830912830912839" 64 | "#D-2398128321308912830912830912839" 65 | "#D+2398128321308912830912830912839" 66 | "#D+0" 67 | "#D-0" 68 | "#D0" 69 | "#O237612036721631263126371263712" 70 | "#O-2376120036721631263126371263712" 71 | "#O+23761236721631263126371263712" 72 | "#O+0" 73 | "#O-0" 74 | "#O0" 75 | "#i#xf/e" 76 | "#x#if/e") 77 | 78 | (test (read (open-string-input-port "#\\nul")) 79 | (integer->char #x0)) 80 | (test (read (open-string-input-port "#\\alarm")) 81 | (integer->char #x7)) 82 | (test (read (open-string-input-port "#\\backspace")) 83 | (integer->char #x8)) 84 | (test (read (open-string-input-port "#\\tab")) 85 | (integer->char #x9)) 86 | (test (read (open-string-input-port "#\\linefeed")) 87 | (integer->char #xA)) 88 | (test (read (open-string-input-port "#\\newline")) 89 | (integer->char #xA)) 90 | (test (read (open-string-input-port "#\\vtab")) 91 | (integer->char #xB)) 92 | (test (read (open-string-input-port "#\\page")) 93 | (integer->char #xC)) 94 | (test (read (open-string-input-port "#\\return")) 95 | (integer->char #xD)) 96 | (test (read (open-string-input-port "#\\esc")) 97 | (integer->char #x1B)) 98 | (test (read (open-string-input-port "#\\space")) 99 | (integer->char #x20)) 100 | (test (read (open-string-input-port "#\\delete")) 101 | (integer->char #x7F)) 102 | 103 | ;; 104 | )) 105 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/records/procedural.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs records procedural) 4 | (export run-records-procedural-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | ;; ---------------------------------------- 9 | 10 | (define rtd1 11 | (make-record-type-descriptor 12 | 'rtd1 #f #f #f #f 13 | '#((immutable x1) (immutable x2)))) 14 | 15 | (define rtd2 16 | (make-record-type-descriptor 17 | 'rtd2 rtd1 #f #f #f 18 | '#((immutable x3) (immutable x4)))) 19 | 20 | (define rtd3 21 | (make-record-type-descriptor 22 | 'rtd3 rtd2 #f #f #f 23 | '#((immutable x5) (immutable x6)))) 24 | 25 | (define protocol1 26 | (lambda (p) 27 | (lambda (a b c) 28 | (p (+ a b) (+ b c))))) 29 | 30 | (define protocol2 31 | (lambda (n) 32 | (lambda (a b c d e f) 33 | (let ((p (n a b c))) 34 | (p (+ d e) (+ e f)))))) 35 | 36 | (define protocol3 37 | (lambda (n) 38 | (lambda (a b c d e f g h i) 39 | (let ((p (n a b c d e f))) 40 | (p (+ g h) (+ h i)))))) 41 | 42 | (define cd1 43 | (make-record-constructor-descriptor 44 | rtd1 #f protocol1)) 45 | 46 | (define cd2 47 | (make-record-constructor-descriptor 48 | rtd2 cd1 protocol2)) 49 | 50 | (define cd3 51 | (make-record-constructor-descriptor 52 | rtd3 cd2 protocol3)) 53 | 54 | (define make-rtd1 (record-constructor cd1)) 55 | 56 | (define make-rtd2 (record-constructor cd2)) 57 | 58 | (define make-rtd3 (record-constructor cd3)) 59 | 60 | 61 | (define :point 62 | (make-record-type-descriptor 63 | 'point #f 64 | #f #f #f 65 | '#((mutable x) (mutable y)))) 66 | 67 | (define :point-cd 68 | (make-record-constructor-descriptor :point #f #f)) 69 | 70 | (define make-point (record-constructor :point-cd)) 71 | 72 | (define point? (record-predicate :point)) 73 | (define point-x (record-accessor :point 0)) 74 | (define point-y (record-accessor :point 1)) 75 | (define point-x-set! (record-mutator :point 0)) 76 | (define point-y-set! (record-mutator :point 1)) 77 | 78 | (define p1 (make-point 1 2)) 79 | 80 | (define :point2 81 | (make-record-type-descriptor 82 | 'point2 :point 83 | #f #f #f '#((mutable x) (mutable y)))) 84 | 85 | (define make-point2 86 | (record-constructor 87 | (make-record-constructor-descriptor :point2 88 | #f #f))) 89 | (define point2? (record-predicate :point2)) 90 | (define point2-xx (record-accessor :point2 0)) 91 | (define point2-yy (record-accessor :point2 1)) 92 | 93 | (define p2 (make-point2 1 2 3 4)) 94 | 95 | (define :point-cd/abs 96 | (make-record-constructor-descriptor 97 | :point #f 98 | (lambda (new) 99 | (lambda (x y) 100 | (new (abs x) (abs y)))))) 101 | 102 | (define make-point/abs 103 | (record-constructor :point-cd/abs)) 104 | 105 | (define :cpoint 106 | (make-record-type-descriptor 107 | 'cpoint :point 108 | #f #f #f 109 | '#((mutable rgb)))) 110 | 111 | (define make-cpoint 112 | (record-constructor 113 | (make-record-constructor-descriptor 114 | :cpoint :point-cd 115 | (lambda (p) 116 | (lambda (x y c) 117 | ((p x y) (color->rgb c))))))) 118 | 119 | (define make-cpoint/abs 120 | (record-constructor 121 | (make-record-constructor-descriptor 122 | :cpoint :point-cd/abs 123 | (lambda (p) 124 | (lambda (x y c) 125 | ((p x y) (color->rgb c))))))) 126 | 127 | (define cpoint-rgb 128 | (record-accessor :cpoint 0)) 129 | 130 | (define (color->rgb c) 131 | (cons 'rgb c)) 132 | 133 | ;; ---------------------------------------- 134 | 135 | (define (run-records-procedural-tests) 136 | 137 | (let ([r (make-rtd3 1 2 3 4 5 6 7 8 9)]) 138 | (test ((record-accessor rtd1 0) r) 3) 139 | (test ((record-accessor rtd1 1) r) 5) 140 | (test ((record-accessor rtd2 0) r) 9) 141 | (test ((record-accessor rtd2 1) r) 11) 142 | (test ((record-accessor rtd3 0) r) 15) 143 | (test ((record-accessor rtd3 1) r) 17)) 144 | 145 | (test (point? p1) #t) 146 | (test (point-x p1) 1) 147 | (test (point-y p1) 2) 148 | (test/unspec (point-x-set! p1 5)) 149 | (test (point-x p1) 5) 150 | 151 | (test (point? p2) #t) 152 | (test (point-x p2) 1) 153 | (test (point-y p2) 2) 154 | (test (point2-xx p2) 3) 155 | (test (point2-yy p2) 4) 156 | 157 | (test (point-x (make-point/abs -1 -2)) 1) 158 | (test (point-y (make-point/abs -1 -2)) 2) 159 | 160 | (test (cpoint-rgb (make-cpoint -1 -3 'red)) '(rgb . red)) 161 | (test (point-x (make-cpoint -1 -3 'red)) -1) 162 | (test (point-x (make-cpoint/abs -1 -3 'red)) 1) 163 | 164 | ;; 165 | )) 166 | 167 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/records/syntactic.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs records syntactic) 4 | (export run-records-syntactic-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | ;; ---------------------------------------- 9 | 10 | (define-record-type (point make-point point?) 11 | (fields (immutable x point-x) 12 | (mutable y point-y set-point-y!)) 13 | (nongenerative 14 | point-4893d957-e00b-11d9-817f-00111175eb9e)) 15 | 16 | (define-record-type (cpoint make-cpoint cpoint?) 17 | (parent point) 18 | (protocol 19 | (lambda (n) 20 | (lambda (x y c) 21 | ((n x y) (color->rgb c))))) 22 | (fields 23 | (mutable rgb cpoint-rgb cpoint-rgb-set!))) 24 | 25 | (define-record-type (cpoint2 make-cpoint2 cpoint2?) 26 | (parent-rtd (record-type-descriptor point) 27 | (record-constructor-descriptor point)) 28 | (fields rgb) 29 | (opaque #f) (sealed #f)) 30 | 31 | (define (color->rgb c) 32 | (cons 'rgb c)) 33 | 34 | (define p1 (make-point 1 2)) 35 | (define p2 (make-cpoint 3 4 'red)) 36 | 37 | (define-record-type (ex1 make-ex1 ex1?) 38 | (protocol (lambda (p) (lambda a (p a)))) 39 | (fields (immutable f ex1-f))) 40 | 41 | (define ex1-i1 (make-ex1 1 2 3)) 42 | 43 | (define-record-type (ex2 make-ex2 ex2?) 44 | (protocol 45 | (lambda (p) (lambda (a . b) (p a b)))) 46 | (fields (immutable a ex2-a) 47 | (immutable b ex2-b))) 48 | 49 | (define ex2-i1 (make-ex2 1 2 3)) 50 | 51 | (define-record-type (unit-vector 52 | make-unit-vector 53 | unit-vector?) 54 | (protocol 55 | (lambda (p) 56 | (lambda (x y z) 57 | (let ((length 58 | (sqrt (+ (* x x) 59 | (* y y) 60 | (* z z))))) 61 | (p (/ x length) 62 | (/ y length) 63 | (/ z length)))))) 64 | (fields (immutable x unit-vector-x) 65 | (immutable y unit-vector-y) 66 | (immutable z unit-vector-z))) 67 | 68 | (define *ex3-instance* #f) 69 | 70 | (define-record-type ex3 71 | (parent cpoint) 72 | (protocol 73 | (lambda (n) 74 | (lambda (x y t) 75 | (let ((r ((n x y 'red) t))) 76 | (set! *ex3-instance* r) 77 | r)))) 78 | (fields 79 | (mutable thickness)) 80 | (sealed #t) (opaque #t)) 81 | 82 | (define ex3-i1 (make-ex3 1 2 17)) 83 | 84 | (define-record-type (tag make-tag tag?)) 85 | (define-record-type (otag make-otag otag?) (opaque #t)) 86 | (define-record-type (stag make-stag stag?) (sealed #t)) 87 | (define-record-type (ostag make-ostag ostag?) (opaque #t) (sealed #t)) 88 | 89 | ;; ---------------------------------------- 90 | 91 | (define (run-records-syntactic-tests) 92 | (test (point? p1) #t) 93 | (test (point? p2) #t) 94 | (test (point? (vector)) #f) 95 | (test (point? (cons 'a 'b)) #f) 96 | (test (cpoint? p1) #f) 97 | (test (cpoint? p2) #t) 98 | (test (point-x p1) 1) 99 | (test (point-y p1) 2) 100 | (test (point-x p2) 3) 101 | (test (point-y p2) 4) 102 | (test (cpoint-rgb p2) '(rgb . red)) 103 | 104 | (test/unspec (set-point-y! p1 17)) 105 | (test (point-y p1) 17) 106 | 107 | (test (record-rtd p1) (record-type-descriptor point)) 108 | 109 | (test (ex1-f ex1-i1) '(1 2 3)) 110 | 111 | (test (ex2-a ex2-i1) 1) 112 | (test (ex2-b ex2-i1) '(2 3)) 113 | 114 | (test (ex3? ex3-i1) #t) 115 | (test (cpoint-rgb ex3-i1) '(rgb . red)) 116 | (test (ex3-thickness ex3-i1) 17) 117 | (test/unspec (ex3-thickness-set! ex3-i1 18)) 118 | (test (ex3-thickness ex3-i1) 18) 119 | (test *ex3-instance* ex3-i1) 120 | 121 | (test (record? p1) #t) 122 | (test (record? ex3-i1) #f) 123 | 124 | (test (record-type-name (record-type-descriptor point)) 'point) 125 | (test (record-type-name (record-type-descriptor cpoint2)) 'cpoint2) 126 | (test (record-type-name (record-type-descriptor ex1)) 'ex1) 127 | 128 | (test (record-type-parent (record-type-descriptor point)) #f) 129 | (test (record-type-parent (record-type-descriptor cpoint2)) (record-type-descriptor point)) 130 | 131 | (test (record-type-uid (record-type-descriptor point)) 'point-4893d957-e00b-11d9-817f-00111175eb9e) 132 | (test/unspec (record-type-uid (record-type-descriptor cpoint2))) 133 | (test/unspec (record-type-uid (record-type-descriptor ex1))) 134 | 135 | (test (record-type-generative? (record-type-descriptor point)) #f) 136 | (test (record-type-generative? (record-type-descriptor cpoint2)) #t) 137 | (test (record-type-generative? (record-type-descriptor ex1)) #t) 138 | 139 | (test (record-type-sealed? (record-type-descriptor point)) #f) 140 | (test (record-type-sealed? (record-type-descriptor ex3)) #t) 141 | 142 | (test (record-type-opaque? (record-type-descriptor point)) #f) 143 | (test (record-type-opaque? (record-type-descriptor ex3)) #t) 144 | 145 | (test (record-type-field-names (record-type-descriptor point)) '#(x y)) 146 | (test (record-type-field-names (record-type-descriptor cpoint2)) '#(rgb)) 147 | 148 | (test (record-field-mutable? (record-type-descriptor point) 0) #f) 149 | (test (record-field-mutable? (record-type-descriptor point) 1) #t) 150 | (test (record-field-mutable? (record-type-descriptor cpoint) 0) #t) 151 | 152 | ;; Tests from Alan Watson: 153 | (test (eqv? (equal? (make-tag) (make-tag)) (eqv? (make-tag) (make-tag))) 154 | #t) 155 | (test (eqv? (equal? (make-otag) (make-otag)) (eqv? (make-otag) (make-otag))) 156 | #t) 157 | (test (eqv? (equal? (make-stag) (make-stag)) (eqv? (make-stag) (make-stag))) 158 | #t) 159 | (test (eqv? (equal? (make-ostag) (make-ostag)) (eqv? (make-ostag) (make-ostag))) 160 | #t) 161 | (test (let ([t (make-tag)]) 162 | (eqv? (equal? t t) (eqv? t t))) 163 | #t) 164 | (test (let ([t (make-otag)]) 165 | (eqv? (equal? t t) (eqv? t t))) 166 | #t) 167 | (test (let ([t (make-stag)]) 168 | (eqv? (equal? t t) (eqv? t t))) 169 | #t) 170 | (test (let ([t (make-ostag)]) 171 | (eqv? (equal? t t) (eqv? t t))) 172 | #t) 173 | 174 | ;; 175 | )) 176 | 177 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run-via-eval.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (import (rnrs) (rnrs eval) (tests r6rs test)) 4 | 5 | (define-syntax test-library 6 | (syntax-rules () 7 | [(_ test-proc library-name) 8 | (test/unspec (eval '(test-proc) (environment 'library-name)))])) 9 | 10 | (test-library run-base-tests (tests r6rs base)) 11 | (test-library run-reader-tests (tests r6rs reader)) 12 | (test-library run-unicode-tests (tests r6rs unicode)) 13 | (test-library run-bytevectors-tests (tests r6rs bytevectors)) 14 | (test-library run-lists-tests (tests r6rs lists)) 15 | (test-library run-sorting-tests (tests r6rs sorting)) 16 | (test-library run-control-tests (tests r6rs control)) 17 | (test-library run-records-syntactic-tests (tests r6rs records syntactic)) 18 | (test-library run-records-procedural-tests (tests r6rs records procedural)) 19 | (test-library run-exceptions-tests (tests r6rs exceptions)) 20 | (test-library run-conditions-tests (tests r6rs conditions)) 21 | (test-library run-io-ports-tests (tests r6rs io ports)) 22 | (test-library run-io-simple-tests (tests r6rs io simple)) 23 | (test-library run-programs-tests (tests r6rs programs)) 24 | (test-library run-arithmetic-fixnums-tests (tests r6rs arithmetic fixnums)) 25 | (test-library run-arithmetic-flonums-tests (tests r6rs arithmetic flonums)) 26 | (test-library run-arithmetic-bitwise-tests (tests r6rs arithmetic bitwise)) 27 | (test-library run-syntax-case-tests (tests r6rs syntax-case)) 28 | (test-library run-hashtables-tests (tests r6rs hashtables)) 29 | (test-library run-enums-tests (tests r6rs enums)) 30 | (test-library run-eval-tests (tests r6rs eval)) 31 | (test-library run-mutable-pairs-tests (tests r6rs mutable-pairs)) 32 | (test-library run-mutable-strings-tests (tests r6rs mutable-strings)) 33 | (test-library run-r5rs-tests (tests r6rs r5rs)) 34 | (test-library run-contrib-tests (tests r6rs contrib)) 35 | 36 | (report-test-results) 37 | 38 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (import (rnrs) 4 | (tests r6rs test) 5 | (tests r6rs base) 6 | (tests r6rs reader) 7 | (tests r6rs unicode) 8 | (tests r6rs bytevectors) 9 | (tests r6rs lists) 10 | (tests r6rs sorting) 11 | (tests r6rs control) 12 | (tests r6rs records syntactic) 13 | (tests r6rs records procedural) 14 | (tests r6rs exceptions) 15 | (tests r6rs conditions) 16 | (tests r6rs io ports) 17 | (tests r6rs io simple) 18 | (tests r6rs programs) 19 | (tests r6rs arithmetic fixnums) 20 | (tests r6rs arithmetic flonums) 21 | (tests r6rs arithmetic bitwise) 22 | (tests r6rs syntax-case) 23 | (tests r6rs hashtables) 24 | (tests r6rs enums) 25 | (tests r6rs eval) 26 | (tests r6rs mutable-pairs) 27 | (tests r6rs mutable-strings) 28 | (tests r6rs r5rs) 29 | (tests r6rs contrib)) 30 | 31 | (run-base-tests) 32 | 33 | (run-reader-tests) 34 | (run-unicode-tests) 35 | (run-bytevectors-tests) 36 | (run-lists-tests) 37 | (run-sorting-tests) 38 | (run-control-tests) 39 | (run-records-syntactic-tests) 40 | (run-records-procedural-tests) 41 | (run-exceptions-tests) 42 | (run-conditions-tests) 43 | (run-io-ports-tests) 44 | (run-io-simple-tests) 45 | (run-programs-tests) 46 | (run-arithmetic-fixnums-tests) 47 | (run-arithmetic-flonums-tests) 48 | (run-arithmetic-bitwise-tests) 49 | (run-syntax-case-tests) 50 | (run-hashtables-tests) 51 | (run-enums-tests) 52 | (run-eval-tests) 53 | (run-mutable-pairs-tests) 54 | (run-mutable-strings-tests) 55 | (run-r5rs-tests) 56 | (run-contrib-tests) 57 | 58 | (report-test-results) 59 | 60 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/arithmetic/bitwise.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs arithmetic bitwise) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs arithmetic bitwise)\n") 6 | (run-arithmetic-bitwise-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/arithmetic/fixnums.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs arithmetic fixnums) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs arithmetic fixnums)\n") 6 | (run-arithmetic-fixnums-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/arithmetic/flonums.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs arithmetic flonums) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs arithmetic flonums)\n") 6 | (run-arithmetic-flonums-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/base.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs base) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs base)\n") 6 | (run-base-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/bytevectors.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs bytevectors) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs bytevectors)\n") 6 | (run-bytevectors-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/conditions.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs conditions) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs conditions)\n") 6 | (run-conditions-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/contrib.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs contrib) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running contributed tests\n") 6 | (run-contrib-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/control.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs control) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs control)\n") 6 | (run-control-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/enums.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs enums) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs enums)\n") 6 | (run-enums-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/eval.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs eval) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs eval)\n") 6 | (run-eval-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/exceptions.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs exceptions) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs exceptions)\n") 6 | (run-exceptions-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/hashtables.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs hashtables) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs hashtables)\n") 6 | (run-hashtables-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/io/ports.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs io ports) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs io ports)\n") 6 | (run-io-ports-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/io/simple.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs io simple) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs io simple)\n") 6 | (run-io-simple-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/lists.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs lists) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs lists)\n") 6 | (run-lists-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/mutable-pairs.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs mutable-pairs) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs mutable-pairs)\n") 6 | (run-mutable-pairs-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/mutable-strings.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs mutable-strings) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs mutable-strings)\n") 6 | (run-mutable-strings-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/programs.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs programs) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs programs)\n") 6 | (run-programs-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/r5rs.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs r5rs) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs r5rs)\n") 6 | (run-r5rs-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/reader.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs reader) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs reader)\n") 6 | (run-reader-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/records/procedural.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs records procedural) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs records procedural)\n") 6 | (run-records-procedural-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/records/syntactic.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs records syntactic) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs records syntactic)\n") 6 | (run-records-syntactic-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/run.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs run) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs run)\n") 6 | (run-run-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/sorting.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs sorting) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs sorting)\n") 6 | (run-sorting-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/syntax-case.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs syntax-case) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs syntax-case)\n") 6 | (run-syntax-case-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/test.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs test) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs test)\n") 6 | (run-test-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/run/unicode.sps: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (import (tests r6rs unicode) 3 | (tests r6rs test) 4 | (rnrs io simple)) 5 | (display "Running tests for (rnrs unicode)\n") 6 | (run-unicode-tests) 7 | (report-test-results) 8 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/sorting.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs sorting) 4 | (export run-sorting-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define (run-sorting-tests) 9 | 10 | (test (list-sort < '(3 5 2 1)) '(1 2 3 5)) 11 | (test (vector-sort < '#(3 5 2 1)) '#(1 2 3 5)) 12 | 13 | (let ([v (vector 3 5 2 1)]) 14 | (test/unspec (vector-sort! < v)) 15 | (test v '#(1 2 3 5))) 16 | 17 | ;; 18 | )) 19 | 20 | -------------------------------------------------------------------------------- /r6rs-test/tests/r6rs/unicode.sls: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | 3 | (library (tests r6rs unicode) 4 | (export run-unicode-tests) 5 | (import (rnrs) 6 | (tests r6rs test)) 7 | 8 | (define (run-unicode-tests) 9 | 10 | (test (char-upcase #\i) #\I) 11 | (test (char-downcase #\i) #\i) 12 | (test (char-titlecase #\i) #\I) 13 | (test (char-foldcase #\i) #\i) 14 | 15 | (test (char-upcase #\xDF) #\xDF) 16 | (test (char-downcase #\xDF) #\xDF) 17 | (test (char-titlecase #\xDF) #\xDF) 18 | (test (char-foldcase #\xDF) #\xDF) 19 | 20 | (test (char-upcase #\x3A3) #\x3A3) 21 | (test (char-downcase #\x3A3) #\x3C3) 22 | (test (char-titlecase #\x3A3) #\x3A3) 23 | (test (char-foldcase #\x3A3) #\x3C3) 24 | 25 | (test (char-upcase #\x3C2) #\x3A3) 26 | (test (char-downcase #\x3C2) #\x3C2) 27 | (test (char-titlecase #\x3C2) #\x3A3) 28 | (test (char-foldcase #\x3C2) #\x3C3) 29 | 30 | (test (char-ci? #\z #\Z) #f) 42 | (test (char-ci>? #\Z #\z) #f) 43 | (test (char-ci>? #\a #\Z) #f) 44 | (test (char-ci>? #\Z #\a) #t) 45 | (test (char-ci>=? #\Z #\z) #t) 46 | (test (char-ci>=? #\z #\Z) #t) 47 | (test (char-ci>=? #\z #\Z) #t) 48 | (test (char-ci>=? #\a #\z) #f) 49 | 50 | (test (char-alphabetic? #\a) #t) 51 | (test (char-alphabetic? #\1) #f) 52 | (test (char-numeric? #\1) #t) 53 | (test (char-numeric? #\a) #f) 54 | (test (char-whitespace? #\space) #t) 55 | (test (char-whitespace? #\x00A0) #t) 56 | (test (char-whitespace? #\a) #f) 57 | (test (char-upper-case? #\a) #f) 58 | (test (char-upper-case? #\A) #t) 59 | (test (char-upper-case? #\x3A3) #t) 60 | (test (char-lower-case? #\a) #t) 61 | (test (char-lower-case? #\A) #f) 62 | (test (char-lower-case? #\x3C3) #t) 63 | (test (char-lower-case? #\x00AA) #t) 64 | (test (char-title-case? #\a) #f) 65 | (test (char-title-case? #\A) #f) 66 | (test (char-title-case? #\I) #f) 67 | (test (char-title-case? #\x01C5) #t) 68 | 69 | (test (char-general-category #\a) 'Ll) 70 | (test (char-general-category #\space) 'Zs) 71 | (test (char-general-category #\x10FFFF) 'Cn) 72 | 73 | (test (string-upcase "Hi") "HI") 74 | (test (string-upcase "HI") "HI") 75 | (test (string-downcase "Hi") "hi") 76 | (test (string-downcase "hi") "hi") 77 | (test (string-foldcase "Hi") "hi") 78 | (test (string-foldcase "HI") "hi") 79 | (test (string-foldcase "hi") "hi") 80 | 81 | (test (string-upcase "Stra\xDF;e") "STRASSE") 82 | (test (string-downcase "Stra\xDF;e") "stra\xDF;e") 83 | (test (string-foldcase "Stra\xDF;e") "strasse") 84 | (test (string-downcase "STRASSE") "strasse") 85 | 86 | (test (string-downcase "\x3A3;") "\x3C3;") 87 | 88 | (test (string-upcase "\x39E;\x391;\x39F;\x3A3;") "\x39E;\x391;\x39F;\x3A3;") 89 | (test (string-downcase "\x39E;\x391;\x39F;\x3A3;") "\x3BE;\x3B1;\x3BF;\x3C2;") 90 | (test (string-downcase "\x39E;\x391;\x39F;\x3A3;\x3A3;") "\x3BE;\x3B1;\x3BF;\x3C3;\x3C2;") 91 | (test (string-downcase "\x39E;\x391;\x39F;\x3A3; \x3A3;") "\x3BE;\x3B1;\x3BF;\x3C2; \x3C3;") 92 | (test (string-foldcase "\x39E;\x391;\x39F;\x3A3;") "\x3BE;\x3B1;\x3BF;\x3C3;") 93 | (test (string-upcase "\x3BE;\x3B1;\x3BF;\x3C3;") "\x39E;\x391;\x39F;\x3A3;") 94 | (test (string-upcase "\x3BE;\x3B1;\x3BF;\x3C2;") "\x39E;\x391;\x39F;\x3A3;") 95 | 96 | (test (string-titlecase "kNock KNoCK") "Knock Knock") 97 | (test (string-titlecase "who's there?") "Who's There?") 98 | (test (string-titlecase "r6rs") "R6rs") ; this example appears to be wrong in R6RS (Sept 2007 version) 99 | (test (string-titlecase "R6RS") "R6rs") ; this one, too 100 | 101 | (test (string-downcase "A\x3A3;:x") "a\x3C3;:x") ; : is a MidLetter 102 | (test (string-downcase "A\x3A3;.x") "a\x3C3;.x") ; . is a MidNumLet 103 | (test (string-downcase "A\x3A3;'x") "a\x3C3;'x") ; ' is a Single_Quote 104 | (test (string-downcase "A\x3C3;_x") "a\x3C3;_x") ; _ is not case-ignorable 105 | 106 | (test (string-ci? "a" "Z") #f) 113 | (test (string-ci>? "A" "z") #f) 114 | (test (string-ci>? "Z" "a") #t) 115 | (test (string-ci>? "z" "A") #t) 116 | (test (string-ci>? "z" "Z") #f) 117 | (test (string-ci>? "Z" "z") #f) 118 | (test (string-ci=? "z" "Z") #t) 119 | (test (string-ci=? "z" "a") #f) 120 | (test (string-ci=? "Stra\xDF;e" "Strasse") #t) 121 | (test (string-ci=? "Stra\xDF;e" "STRASSE") #t) 122 | (test (string-ci=? "\x39E;\x391;\x39F;\x3A3;" "\x3BE;\x3B1;\x3BF;\x3C2;") #t) 123 | (test (string-ci=? "\x39E;\x391;\x39F;\x3A3;" "\x3BE;\x3B1;\x3BF;\x3C3;") #t) 124 | (test (string-ci<=? "a" "Z") #t) 125 | (test (string-ci<=? "A" "z") #t) 126 | (test (string-ci<=? "Z" "a") #f) 127 | (test (string-ci<=? "z" "A") #f) 128 | (test (string-ci<=? "z" "Z") #t) 129 | (test (string-ci<=? "Z" "z") #t) 130 | (test (string-ci>=? "a" "Z") #f) 131 | (test (string-ci>=? "A" "z") #f) 132 | (test (string-ci>=? "Z" "a") #t) 133 | (test (string-ci>=? "z" "A") #t) 134 | (test (string-ci>=? "z" "Z") #t) 135 | (test (string-ci>=? "Z" "z") #t) 136 | 137 | (test (string-normalize-nfd "\xE9;") "\x65;\x301;") 138 | (test (string-normalize-nfc "\xE9;") "\xE9;") 139 | (test (string-normalize-nfd "\x65;\x301;") "\x65;\x301;") 140 | (test (string-normalize-nfc "\x65;\x301;") "\xE9;") 141 | 142 | (test (string-normalize-nfkd "\xE9;") "\x65;\x301;") 143 | (test (string-normalize-nfkc "\xE9;") "\xE9;") 144 | (test (string-normalize-nfkd "\x65;\x301;") "\x65;\x301;") 145 | (test (string-normalize-nfkc "\x65;\x301;") "\xE9;") 146 | 147 | ;; 148 | )) 149 | -------------------------------------------------------------------------------- /r6rs/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps '("r6rs-lib" 6 | "r6rs-doc")) 7 | (define implies '("r6rs-lib" 8 | "r6rs-doc")) 9 | 10 | (define pkg-desc "Legacy R6RS (Scheme) language") 11 | 12 | (define pkg-authors '(mflatt)) 13 | 14 | (define license 15 | '(Apache-2.0 OR MIT)) 16 | --------------------------------------------------------------------------------