plt-r5rs exe and r5rs doc

svn: r8501

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")))

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!

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)
+    (syntax-rules (r5rs:lambda)
-      ((r5rs:letrec ((var1 (r5rs-lambda . _rest)) ...) body ...)
+      ((r5rs:letrec ((var1 (r5rs:lambda . _rest)) ...) body ...)
-       (letrec ((var1 (r5rs-lambda . _rest)) ...) body ...))
+       (letrec ((var1 (r5rs:lambda . _rest)) ...) body ...))
       ((r5rs:letrec ((var1 init1) ...) body ...)
        (r5rs:letrec "generate_temp_names"
 	 (var1 ...)

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)))

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
+The @scheme[buffer] argument determines the buffer mode of the output
-output port. In @scheme['block] mode, the port's buffer is flushed
+port. In @scheme['block] mode, the port's buffer is flushed only when
-only when it is full or a flush is requested explicitly. In
+it is full or a flush is requested explicitly. In @scheme['line] mode,
-@scheme['line] mode, the buffer is flushed whenever a newline or
+the buffer is flushed whenever a newline or carriage-return byte is
-carriage-return byte is written to the port. In @scheme['none] mode,
+written to the port. In @scheme['none] mode, the port's buffer is
-the port's buffer is flushed after every write.  Implicit flushes for
+flushed after every write.  Implicit flushes for @scheme['line] or
-@scheme['line] or @scheme['none] leave bytes in the buffer when they
+@scheme['none] leave bytes in the buffer when they are part of an
-are part of an incomplete encoding sequence.
+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

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)])
+    (parameterize ([current-namespace (make-base-empty-namespace)])
-      (namespace-require 'scheme/base)
+      (namespace-require 'r5rs)
-      (load (format "~a.scm" bm))))
+      (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
+     (make-impl 'plt-r5rs
-                mk-mzscheme-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

collects/tests/mzscheme/benchmarks/common/r5rs-wrap.ss

@@ -1,12 +1,2 @@
 
-(module r5rs-wrap r5rs
+(#%require (only scheme/base error time bitwise-not bitwise-and))
-  (#%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)))))))