diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss index f3b9318d1e..78ec2aae6b 100644 --- a/collects/drscheme/private/language-configuration.ss +++ b/collects/drscheme/private/language-configuration.ss @@ -1322,7 +1322,7 @@ (string-constant expander-one-line-summary) add-expand-to-front-end)) (add-language - (make-simple '(lib "r5rs.ss" "r5rs") + (make-simple '(lib "lang.ss" "r5rs") (list (string-constant professional-languages) (string-constant r5rs-lang-name)) (list -1000 -1000) diff --git a/collects/lang/doc.txt b/collects/lang/doc.txt index 3d11f28ca9..1aa619a2a5 100644 --- a/collects/lang/doc.txt +++ b/collects/lang/doc.txt @@ -4,7 +4,7 @@ languages for other modules (i.e., as the initial import): * _r5rs.ss_ - provides R5RS Scheme, which is defined in the "r5rs" collection. This file is here only for backward compatibility, use - (lib "r5rs.ss" "r5rs") instead. + (lib "lang.ss" "r5rs") instead. * _plt-pretty-big-text.ss_ - provides MzScheme plus the following MzLib libraries: etc.ss, file.ss, list.ss, diff --git a/collects/lang/r5rs.ss b/collects/lang/r5rs.ss index cc186eb7d4..2795669708 100644 --- a/collects/lang/r5rs.ss +++ b/collects/lang/r5rs.ss @@ -1,6 +1,6 @@ ;; This module provides R5RS Scheme, which is defined in "r5rs/r5rs.ss". ;; This file is here only as a stub for backward compatibility; use -;; (lib "r5rs.ss" "r5rs") +;; (lib "lang.ss" "r5rs") ;; instead. -(module r5rs (lib "r5rs.ss" "r5rs") - (#%provide (all-from (lib "r5rs.ss" "r5rs")))) +(module r5rs (lib "lang.ss" "r5rs") + (#%provide (all-from (lib "lang.ss" "r5rs")))) diff --git a/collects/r5rs/doc.txt b/collects/r5rs/doc.txt index 0de1cb7fe2..6c95d6d766 100644 --- a/collects/r5rs/doc.txt +++ b/collects/r5rs/doc.txt @@ -1,27 +1,29 @@ _R5RS_ -The "r5rs.ss" module in the "r5rs" collection implements the language -defined by the "Revised^5 Report on the Algorithmic Language Scheme". -In addition, this module provides _#%provide_ (instead of `provide'), -_#%require_ (instead of `#%require'), `#%app', `%datum', etc. The -`letrec' of this language is defined exactly as in R5RS, and not as in -MzScheme. +The "r5rs" collection implements the language defined by the +"Revised^5 Report on the Algorithmic Language Scheme" in the "lang.ss" +module. In addition, this module provides _#%provide_ (instead of +`provide'), _#%require_ (instead of `#%require'), `#%app', `%datum', +etc. The `letrec' of this language is defined exactly as in R5RS, and +not as in MzScheme. -The module _r5rs.ss_ module is a language module. You can use it in -one of several ways: +You can use this collection in several ways: -* Use the "Standard (R5RS)" language in DrScheme; +* Use the "Standard (R5RS)" language in DrScheme. + +* Write code in a module using the R5RS module (lib "lang.ss" "r5rs"), + as a base language: + + (module foo (lib "lang.ss" "r5rs") + ...) + + in this case, you can `provide' bindings and `require' other modules + by using _#%require_ and _#%provide_. * Start MzScheme using bindings from the R5RS language with mzscheme -M r5rs - (but note that MzScheme bindings will still be visible); - -* Write code in a module that uses the R5RS language: - - (module foo (lib "r5rs.ss" "r5rs") - ...) - - in this case, you can `provide' bindings and `require' other modules - by using _#%require_ and _#%provide_. + This will start MzScheme with only the R5RS bindings (with #%require + etc), and a reader that will reject use of square brackets and curly + braces. diff --git a/collects/r5rs/lang.ss b/collects/r5rs/lang.ss new file mode 100644 index 0000000000..a607209331 --- /dev/null +++ b/collects/r5rs/lang.ss @@ -0,0 +1,98 @@ + +(module lang mzscheme + + ;; values + (provide car cdr caar cadr cdar cddr + caaar caadr cadar caddr cdaar cdadr cddar cdddr + caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr + cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr + map = < > <= >= max min + - * / + abs gcd lcm exp log sin cos tan not eq? + call-with-current-continuation make-string + symbol->string string->symbol make-rectangular + exact->inexact inexact->exact number->string string->number + rationalize output-port? current-input-port current-output-port current-error-port + open-input-file open-output-file close-input-port close-output-port + with-output-to-file transcript-on transcript-off flush-output + string-length string-ci<=? string-ci>=? string-append + string->list list->string string-fill! + vector-length vector->list list->vector vector-fill! + char-alphabetic? char-numeric? char-whitespace? + char-upper-case? char-lower-case? char->integer integer->char char-downcase + call-with-output-file call-with-input-file with-input-from-file + apply for-each symbol? pair? cons set-car! set-cdr! null? list? list length append reverse + list-tail list-ref memq memv member assq assv assoc procedure? + number? complex? real? rational? integer? exact? inexact? zero? + positive? negative? odd? even? + quotient remainder modulo floor ceiling truncate round + numerator denominator asin acos atan sqrt + expt make-polar real-part imag-part angle magnitude input-port? + read read-char peek-char eof-object? + char-ready? write display newline write-char load + string? string string-ref string-set! string=? substring string-copy + string-ci=? string? string<=? string>=? string-ci? + vector? make-vector vector vector-ref vector-set! + char? char=? char? char<=? char>=? + char-ci=? char-ci? char-ci<=? char-ci>=? + char-upcase boolean? eqv? equal? force + call-with-values values eval port? scheme-report-environment null-environment + interaction-environment dynamic-wind) + + ;; Copied from R5rS: + (define undefined (letrec ([u u]) u)) + (define-syntax r5rs:letrec + (syntax-rules () + ((r5rs:letrec ((var1 init1) ...) body ...) + (r5rs:letrec "generate_temp_names" + (var1 ...) + () + ((var1 init1) ...) + body ...)) + ((r5rs:letrec "generate_temp_names" + () + (temp1 ...) + ((var1 init1) ...) + body ...) + (let ((var1 undefined) ...) + (let ((temp1 init1) ...) + (set! var1 temp1) + ... + (let () + body ...)))) + ((r5rs:letrec "generate_temp_names" + (x y ...) + (temp ...) + ((var1 init1) ...) + body ...) + (r5rs:letrec "generate_temp_names" + (y ...) + (newtemp temp ...) + ((var1 init1) ...) + body ...)))) + + ;; syntax + (provide quasiquote unquote unquote-splicing + if let and or cond case define delay do + (rename r5rs:letrec letrec) + let* begin lambda quote set! + define-syntax let-syntax letrec-syntax + + ;; We have to include the following MzScheme-isms to do anything, + ;; but they're not legal R5RS names, anyway. + #%app #%datum #%top + (rename synrule-in-stx-module-begin #%module-begin) + (rename require #%require) + (rename provide #%provide)) + + + (define-syntax synrule-in-stx-module-begin + (lambda (stx) + (datum->syntax-object + (quote-syntax here) + (list* (quote-syntax #%plain-module-begin) + (list 'require-for-syntax + (datum->syntax-object + stx + '(only mzscheme syntax-rules))) + (cdr (syntax-e stx))) + stx)))) diff --git a/collects/r5rs/r5rs.ss b/collects/r5rs/r5rs.ss index 3ef7de3914..cd9f152c3b 100644 --- a/collects/r5rs/r5rs.ss +++ b/collects/r5rs/r5rs.ss @@ -1,98 +1,10 @@ - (module r5rs mzscheme - - ;; values - (provide car cdr caar cadr cdar cddr - caaar caadr cadar caddr cdaar cdadr cddar cdddr - caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr - cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr - map = < > <= >= max min + - * / - abs gcd lcm exp log sin cos tan not eq? - call-with-current-continuation make-string - symbol->string string->symbol make-rectangular - exact->inexact inexact->exact number->string string->number - rationalize output-port? current-input-port current-output-port current-error-port - open-input-file open-output-file close-input-port close-output-port - with-output-to-file transcript-on transcript-off flush-output - string-length string-ci<=? string-ci>=? string-append - string->list list->string string-fill! - vector-length vector->list list->vector vector-fill! - char-alphabetic? char-numeric? char-whitespace? - char-upper-case? char-lower-case? char->integer integer->char char-downcase - call-with-output-file call-with-input-file with-input-from-file - apply for-each symbol? pair? cons set-car! set-cdr! null? list? list length append reverse - list-tail list-ref memq memv member assq assv assoc procedure? - number? complex? real? rational? integer? exact? inexact? zero? - positive? negative? odd? even? - quotient remainder modulo floor ceiling truncate round - numerator denominator asin acos atan sqrt - expt make-polar real-part imag-part angle magnitude input-port? - read read-char peek-char eof-object? - char-ready? write display newline write-char load - string? string string-ref string-set! string=? substring string-copy - string-ci=? string? string<=? string>=? string-ci? - vector? make-vector vector vector-ref vector-set! - char? char=? char? char<=? char>=? - char-ci=? char-ci? char-ci<=? char-ci>=? - char-upcase boolean? eqv? equal? force - call-with-values values eval port? scheme-report-environment null-environment - interaction-environment dynamic-wind) - - ;; Copied from R5rS: - (define undefined (letrec ([u u]) u)) - (define-syntax r5rs:letrec + (define-syntax provide-r5rs (syntax-rules () - ((r5rs:letrec ((var1 init1) ...) body ...) - (r5rs:letrec "generate_temp_names" - (var1 ...) - () - ((var1 init1) ...) - body ...)) - ((r5rs:letrec "generate_temp_names" - () - (temp1 ...) - ((var1 init1) ...) - body ...) - (let ((var1 undefined) ...) - (let ((temp1 init1) ...) - (set! var1 temp1) - ... - (let () - body ...)))) - ((r5rs:letrec "generate_temp_names" - (x y ...) - (temp ...) - ((var1 init1) ...) - body ...) - (r5rs:letrec "generate_temp_names" - (y ...) - (newtemp temp ...) - ((var1 init1) ...) - body ...)))) - - ;; syntax - (provide quasiquote unquote unquote-splicing - if let and or cond case define delay do - (rename r5rs:letrec letrec) - let* begin lambda quote set! - define-syntax let-syntax letrec-syntax - - ;; We have to include the following MzScheme-isms to do anything, - ;; but they're not legal R5RS names, anyway. - #%app #%datum #%top - (rename synrule-in-stx-module-begin #%module-begin) - (rename require #%require) - (rename provide #%provide)) - - - (define-syntax synrule-in-stx-module-begin - (lambda (stx) - (datum->syntax-object - (quote-syntax here) - (list* (quote-syntax #%plain-module-begin) - (list 'require-for-syntax - (datum->syntax-object - stx - '(only mzscheme syntax-rules))) - (cdr (syntax-e stx))) - stx)))) + [(_) (begin (require (lib "lang.ss" "r5rs")) + (provide (all-from (lib "lang.ss" "r5rs"))))])) + (provide-r5rs) + (read-case-sensitive #f) + (read-square-bracket-as-paren #f) + (read-curly-brace-as-paren #f) + (current-namespace (scheme-report-environment 5))) diff --git a/collects/web-server/servlet-builder.ss b/collects/web-server/servlet-builder.ss index ba58109370..51bb8f198e 100644 --- a/collects/web-server/servlet-builder.ss +++ b/collects/web-server/servlet-builder.ss @@ -123,7 +123,7 @@ (hash-table-put! table (string->symbol (car name-req)) (cadr name-req))) (list (list (string-constant r5rs-lang-name) - `(lib "r5rs.ss" "r5rs")) + `(lib "lang.ss" "r5rs")) (list (string-constant beginning-student) `(lib "htdp-beginner.ss" "lang")) (list (string-constant beginning-student/abbrev)