suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

plt-r5rs exe and r5rs doc

Browse Source 
svn: r8501
This commit is contained in:
Matthew Flatt 2008-02-02 04:14:04 +00:00
parent a1be19c040
commit d1c61e5ef1
7 changed files with 76 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/r5rs/info.ss
View File

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

2
collects/r5rs/init.ss
View File

@ -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!

6
collects/r5rs/main.ss
View File

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

37
collects/r5rs/run.ss Normal file
View File

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

18
collects/scribblings/reference/port-lib.scrbl
View File

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

30
collects/tests/mzscheme/benchmarks/common/auto.ss
View File

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

12
collects/tests/mzscheme/benchmarks/common/r5rs-wrap.ss
View File

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