diff --git a/collects/r5rs/info.ss b/collects/r5rs/info.ss index c080a5d0a8..ca3b4db9ae 100644 --- a/collects/r5rs/info.ss +++ b/collects/r5rs/info.ss @@ -1,3 +1,9 @@ (module info setup/infotab - (define name "R5RS")) + (define name "R5RS") + + (define scribblings '(("r5rs.scrbl" (multi-page)))) + (define doc-categories '((language -1))) + + (define mzscheme-launcher-names '("PLT R5RS")) + (define mzscheme-launcher-libraries '("run.ss"))) diff --git a/collects/r5rs/init.ss b/collects/r5rs/init.ss index f67054f97b..ce14054238 100644 --- a/collects/r5rs/init.ss +++ b/collects/r5rs/init.ss @@ -2,12 +2,10 @@ (module init scheme/base (read-case-sensitive #f) - (read-curly-brace-as-paren #f) (read-accept-infix-dot #f) (read-curly-brace-as-paren #f) (read-square-bracket-as-paren #f) - (print-vector-length #f) (print-mpair-curly-braces #f) ;; Printing pairs with curly braces is a bad idea, because ;; syntax errors then use curly braces! diff --git a/collects/r5rs/main.ss b/collects/r5rs/main.ss index fe82598c12..f2580bcef3 100644 --- a/collects/r5rs/main.ss +++ b/collects/r5rs/main.ss @@ -230,9 +230,9 @@ ;; and with optimization for precedure letrecs (define undefined (letrec ([u u]) u)) (define-syntax r5rs:letrec - (syntax-rules (r5rs-lambda) - ((r5rs:letrec ((var1 (r5rs-lambda . _rest)) ...) body ...) - (letrec ((var1 (r5rs-lambda . _rest)) ...) body ...)) + (syntax-rules (r5rs:lambda) + ((r5rs:letrec ((var1 (r5rs:lambda . _rest)) ...) body ...) + (letrec ((var1 (r5rs:lambda . _rest)) ...) body ...)) ((r5rs:letrec ((var1 init1) ...) body ...) (r5rs:letrec "generate_temp_names" (var1 ...) diff --git a/collects/r5rs/run.ss b/collects/r5rs/run.ss new file mode 100644 index 0000000000..755a1c70d6 --- /dev/null +++ b/collects/r5rs/run.ss @@ -0,0 +1,37 @@ +#lang scheme/base +(require scheme/cmdline) + +(define slow (make-parameter #f)) + +(define-values (main args) + (command-line + #:once-each + [("--slow") "disable assumption that primitives are never redefined" + (slow #t)] + #:handlers + (case-lambda + [(x) (values #f null)] + [(x file . args) (values file args)]) + '("file" "arg"))) + +(if (slow) + (namespace-require/copy 'r5rs/init) + (namespace-require 'r5rs/init)) + +(current-command-line-arguments (apply vector-immutable args)) +(if main + ;; File load mode: + (load main) + ;; REPL mode: + (begin + (display (banner)) + (printf "R5RS legacy support loaded\n") + ;; Load .pltr5rsrc + (let-values ([(base name dir?) (split-path (find-system-path 'init-file))]) + (let ([f (build-path base (bytes->path-element + (regexp-replace #rx#"mzscheme" + (path-element->bytes name) + #"pltr5rs")))]) + (when (file-exists? f) + (load f)))) + (read-eval-print-loop))) diff --git a/collects/scribblings/reference/port-lib.scrbl b/collects/scribblings/reference/port-lib.scrbl index 82e1e6e259..6d9b2f2d2e 100644 --- a/collects/scribblings/reference/port-lib.scrbl +++ b/collects/scribblings/reference/port-lib.scrbl @@ -192,7 +192,7 @@ incomplete encoding sequence.)} [close? any/c #t] [name any/c (object-name out)] [buffer (one-of/c 'block 'line 'none) - (if (file-stream-port out) + (if (file-stream-port? out) (file-stream-buffer-mode out) 'block)]) output-port?]{ @@ -210,14 +210,14 @@ If @scheme[close?] is true, then closing the result output port also closes @scheme[out]. The @scheme[name] argument is used as the name of the result output port. -The @scheme[buffer-sym] argument determines the buffer mode of the -output port. In @scheme['block] mode, the port's buffer is flushed -only when it is full or a flush is requested explicitly. In -@scheme['line] mode, the buffer is flushed whenever a newline or -carriage-return byte is written to the port. In @scheme['none] mode, -the port's buffer is flushed after every write. Implicit flushes for -@scheme['line] or @scheme['none] leave bytes in the buffer when they -are part of an incomplete encoding sequence. +The @scheme[buffer] argument determines the buffer mode of the output +port. In @scheme['block] mode, the port's buffer is flushed only when +it is full or a flush is requested explicitly. In @scheme['line] mode, +the buffer is flushed whenever a newline or carriage-return byte is +written to the port. In @scheme['none] mode, the port's buffer is +flushed after every write. Implicit flushes for @scheme['line] or +@scheme['none] leave bytes in the buffer when they are part of an +incomplete encoding sequence. The resulting output port does not support atomic writes. An explicit flush or special-write to the output port can hang if the most diff --git a/collects/tests/mzscheme/benchmarks/common/auto.ss b/collects/tests/mzscheme/benchmarks/common/auto.ss index 18ad55046b..a288fd0def 100755 --- a/collects/tests/mzscheme/benchmarks/common/auto.ss +++ b/collects/tests/mzscheme/benchmarks/common/auto.ss @@ -11,7 +11,8 @@ exec mzscheme -qu "$0" ${1+"$@"} (lib "compile.ss") (lib "inflate.ss") (lib "date.ss") - (lib "file.ss" "dynext")) + (lib "file.ss" "dynext") + syntax/toplevel) ;; Implementaton-specific control functions ------------------------------ @@ -39,17 +40,24 @@ exec mzscheme -qu "$0" ${1+"$@"} (define (clean-up-nothing bm) (void)) - (define (mk-mzscheme-r5rs bm) + (define (mk-plt-r5rs bm) (with-output-to-file (format "~a.scm" bm) #:exists 'replace (lambda () - (printf "(module ~a \"r5rs-wrap.ss\")\n" bm))) + (printf "(load \"r5rs-wrap.ss\")\n(load \"~a.sch\")\n" bm))) ;; To get compilation time: - (parameterize ([current-namespace (make-base-namespace)]) - (namespace-require 'scheme/base) - (load (format "~a.scm" bm)))) + (parameterize ([current-namespace (make-base-empty-namespace)]) + (namespace-require 'r5rs) + (with-input-from-file (format "~a.sch" bm) + (lambda () + (let loop () + (let ([e (read-syntax)]) + (unless (eof-object? e) + (eval-compile-time-part-of-top-level/compile + (namespace-syntax-introduce e)) + (loop)))))))) - (define (clean-up-r5rs bm) + (define (clean-up-plt-r5rs bm) (let ([f (format "~s.scm" bm)]) (when (file-exists? f) (delete-file f)))) @@ -193,12 +201,12 @@ exec mzscheme -qu "$0" ${1+"$@"} extract-mzscheme-times clean-up-nothing mutable-pair-progs) - (make-impl 'mz-r5rs - mk-mzscheme-r5rs + (make-impl 'plt-r5rs + mk-plt-r5rs (lambda (bm) - (system (format "mzscheme -u ~a.scm" bm))) + (system (format "plt-r5rs ~a.scm" bm))) extract-mzscheme-times - clean-up-r5rs + clean-up-plt-r5rs null) (make-impl 'mzc mk-mzc diff --git a/collects/tests/mzscheme/benchmarks/common/r5rs-wrap.ss b/collects/tests/mzscheme/benchmarks/common/r5rs-wrap.ss index 49cd440e07..a5e679aff4 100644 --- a/collects/tests/mzscheme/benchmarks/common/r5rs-wrap.ss +++ b/collects/tests/mzscheme/benchmarks/common/r5rs-wrap.ss @@ -1,12 +1,2 @@ -(module r5rs-wrap r5rs - (#%require scheme/include - (only scheme/base error time bitwise-not bitwise-and) - (only scheme/base provide rename-out) - (for-syntax scheme/base)) - (provide (rename-out [module-begin #%module-begin])) - (define-syntax module-begin - (lambda (stx) - (let ([name (syntax-property stx 'enclosing-module-name)]) - #`(#%module-begin - (include #,(format "~a.sch" name))))))) +(#%require (only scheme/base error time bitwise-not bitwise-and))