From 2bc5b127f7b90b11371a0415bdea76550b00022f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 28 Jun 2007 22:51:53 +0000
Subject: [PATCH] remove r6rs collection (now in graveyard)

svn: r6758
---
 collects/r6rs/doc.txt            |  55 ------
 collects/r6rs/info.ss            |   3 -
 collects/r6rs/library-module.ss  | 311 -----------------------------
 collects/r6rs/library-repl.ss    |  31 ---
 collects/r6rs/library.ss         |  40 ----
 collects/r6rs/private/helpers.ss | 328 -------------------------------
 collects/r6rs/private/uri.ss     |  68 -------
 collects/r6rs/r6rs.ss            |  73 -------
 collects/r6rs/reader.ss          | 281 --------------------------
 9 files changed, 1190 deletions(-)
 delete mode 100644 collects/r6rs/doc.txt
 delete mode 100644 collects/r6rs/info.ss
 delete mode 100644 collects/r6rs/library-module.ss
 delete mode 100644 collects/r6rs/library-repl.ss
 delete mode 100644 collects/r6rs/library.ss
 delete mode 100644 collects/r6rs/private/helpers.ss
 delete mode 100644 collects/r6rs/private/uri.ss
 delete mode 100644 collects/r6rs/r6rs.ss
 delete mode 100644 collects/r6rs/reader.ss

diff --git a/collects/r6rs/doc.txt b/collects/r6rs/doc.txt
deleted file mode 100644
index 107480c7e2..0000000000
--- a/collects/r6rs/doc.txt
+++ /dev/null
@@ -1,55 +0,0 @@
-
-The _r6rs_ collection contains support for things that might become
-part of the R6RS standard.
-
-
-To write an R6RS library:
- 
- #reader(lib "library.ss" "r6rs")
- (library "name" ....)
-
-where "name" matches the containing file name without the file path or
-suffix. Note that the #reader line adjusts reader syntax in addition
-to converting `library' to `module'.
-
-
-To evaluate R6RS `library' and `import' forms at the REPL (or with
-`load', etc):
-
- > (require (lib "library-repl.ss" "r6rs"))
-
-or start MzScheme as
-
- % mzscheme -L library-repl.ss r6rs
-
-
-In either mode, to import a collection-based module to to reference
-other libraries installed in the collection tree, use
-
- "scheme://<collection>/...<collection>/<file>"
-
-instead of
-
- (lib "<file>" "<collection>" ... "<collection>")
-
-A "scheme://" URI must have at least one <collection> and a <file> to
-be translated to a `lib' reference. If the indicated collection does
-not exist, a path is invented based on the "mzlib" collection; this
-supports absolute URIs that name `library's entered in the REPL.
-
-
-Limitations:
-
- - doesn't enforce that a for-run import isn't also
-   a for-expand import in a different import-spec
-
- - reader adjusts only string, character, and quoted-symbol
-   syntax (as in SRFI-75), for now
-
-
-To appear:
-
- - a tool to take a sequence of `library' declarations and
-   copy them into the collection tree (adjusting the
-   declared library name as necessary, and adding the #reader
-   line)
diff --git a/collects/r6rs/info.ss b/collects/r6rs/info.ss
deleted file mode 100644
index efbb202c3b..0000000000
--- a/collects/r6rs/info.ss
+++ /dev/null
@@ -1,3 +0,0 @@
-
-(module info (lib "infotab.ss" "setup")
-  (define name "R6RS"))
diff --git a/collects/r6rs/library-module.ss b/collects/r6rs/library-module.ss
deleted file mode 100644
index c7fdbdd17e..0000000000
--- a/collects/r6rs/library-module.ss
+++ /dev/null
@@ -1,311 +0,0 @@
-
-(module library-module mzscheme
-  (require-for-syntax "private/helpers.ss"
-		      (lib "kerncase.ss" "syntax")
-		      (lib "context.ss" "syntax")
-		      (lib "boundmap.ss" "syntax")
-		      (lib "stxparam.ss")
-		      (lib "list.ss"))
-  (require (lib "stxparam.ss"))
-
-  (provide (rename library-module-begin #%module-begin)
-	   import)
-
-  (define-syntax define-impdef-placeholder
-    (syntax-rules ()
-      [(_ id) (begin
-		(define-syntax (id stx)
-		  (raise-syntax-error
-		   #f
-		   "only allowed at the beginning of a `library' form"
-		   stx))
-		(provide id))]))
-
-  (define-impdef-placeholder export)
-  (define-impdef-placeholder indirect-export)
-
-  (define-syntax (import stx)
-    (unless (eq? (syntax-local-context) 'top-level)
-      (raise-syntax-error
-       #f
-       "only allowed at the beginning of a `library' form or outside a library at the top level"
-       stx))
-    (syntax-case stx ()
-      [(_ i ...)
-       #`(begin #,@(map translate-import (syntax->list #'(i ...))))]))
-
-  (define-for-syntax (split-bodies bodies)
-    (let loop ([bodies bodies]
-	       [imports null]
-	       [exports null])
-      (if (null? bodies)
-	  (values (reverse imports)
-		  (reverse exports)
-		  null)
-	  (syntax-case (car bodies) (import export)
-	    [(import in ...)
-	     (loop (cdr bodies)
-		   (append (syntax->list #'(in ...)) imports)
-		   exports)]
-	    [(import . rest)
-	     (raise-syntax-error #f "bad syntax" (car bodies))]
-	    [(export out ...)
-	     (loop (cdr bodies)
-		   imports
-		   (append (syntax->list #'(out ...)) exports))]
-	    [(export . rest)
-	     (raise-syntax-error #f "bad syntax" (car bodies))]
-	    [else (values (reverse imports)
-			  (reverse exports)
-			  bodies)]))))
-
-  (define-for-syntax (make-unboxer id in-src-module-id)
-    (with-syntax ([id id])
-      (make-set!-transformer
-       (lambda (stx)
-	 (syntax-case stx (set!)
-	   [(set! _ v) #'(set-box! id v)]
-	   [(_ arg ...) #'((unbox id) arg ...)]
-	   [_ #'(unbox id)])))))
-
-  (define-for-syntax (box-rhs stx)
-    (syntax-case stx ()
-      [(_ rhs) #'(box rhs)]))
-
-  (define-for-syntax (make-protected-unboxer id  in-src-module-id)
-    (with-syntax ([id id])
-      (make-set!-transformer
-       (lambda (stx)
-	 (unless (syntax-parameter-value in-src-module-id)
-	   (raise-syntax-error
-	    #f
-	    "reference to non-exported identifier allowed only within its source library"
-	    stx))
-	 (syntax-case stx (set!)
-	   [(set! _ v) #'(set! id v)]
-	   [(_ arg ...) #'(id arg ...)]
-	   [_ #'id])))))
-
-  (define-for-syntax (no-box-rhs stx)
-    (syntax-case stx ()
-      [(_ rhs) #'rhs]))
-
-  (define-for-syntax (check-exported-macro f ok?)
-    (let ([wrap (lambda (f)
-		  (lambda (stx)
-		    (unless (ok?)
-		      (raise-syntax-error
-		       #f
-		       "reference to non-exported identifier allowed only within its source library"
-		       stx))
-		    (f stx)))])
-      (cond
-       [(and (procedure? f) (procedure-arity-includes? f 1))
-	(wrap f)]
-       [(set!-transformer? f)
-	(make-set!-transformer (wrap (set!-transformer-procedure f)))]
-       [else f])))
-
-  (define-syntax (library-module-begin stx)
-    (syntax-case stx ()
-      [(_ (__ name lang body ...))
-       (let ([stx (syntax-case stx () [(_ o) #'o])])
-	 (unless (and (string? (syntax-e #'name))
-		      (uri? (syntax-e #'name)))
-	   (raise-syntax-error 
-	    #f
-	    "library name must be a URI"
-	    stx
-	    #'name))
-	 (unless (and (string? (syntax-e #'lang))
-		      (string=? "scheme://r6rs" (syntax-e #'lang)))
-	   (raise-syntax-error 
-	    #f
-	    "language position must be \"scheme://r6rs\""
-	    stx
-	    #'lang))
-	 (let ([bodies (syntax->list #'(body ...))])
-	   (let-values ([(imports exports bodies)
-			 (split-bodies bodies)])
-	     (let ([provides (map translate-export exports)])
-	       #`(#%plain-module-begin
-		  (require #,(datum->syntax-object stx '(all-except (lib "r6rs.ss" "r6rs")
-								    #%module-begin)))
-		  (require-for-syntax #,(datum->syntax-object stx '(lib "r6rs.ss" "r6rs")))
-		  (require #,(datum->syntax-object stx '(lib "library-module.ss" "r6rs")))
-		  #,@(map translate-import imports)
-		  #,@provides
-		  (define-syntax-parameter in-src-module #f)
-		  (begin-library-body
-		   in-src-module
-		   #,(apply append (map (lambda (prov)
-					  (map (lambda (p)
-						 (syntax-case p ()
-						   [(_ loc ext) #'loc]
-						   [_else p]))
-					       (cdr (syntax->list prov))))
-					provides))
-		   ()
-		   #,bodies
-		   ()
-		   ()))))))]
-      [(_ x)
-       (raise-syntax-error
-	#f
-	"bad syntax"
-	#'x)]))
-
-  (define-for-syntax stops (list*
-			    #'import
-			    #'export
-			    #'indirect-export
-			    (kernel-form-identifier-list #'here)))
-
-  (define-syntax (begin-library-body stx)
-    (syntax-case stx ()
-      [(_ in-src-module export-info ((macro-id ind-id ...) ...) 
-	  () ; no body forms left
-	  ((def-macro-id check-id) ...)
-	  ((id gen-id boxdef-id) ...))
-       ;; We've processed the whole body, and now we need to
-       ;;  create unboxers for the defined names:
-       (let ([macro-ids (syntax->list #'(macro-id ...))]
-	     [ind-idss (map syntax->list (syntax->list #'((ind-id ...) ...)))])
-	 ;; Check that each inidirect-export id was defined
-	 (let ([t (make-bound-identifier-mapping)])
-	   (for-each (lambda (id)
-		       (bound-identifier-mapping-put! t id #t))
-		     (syntax->list #'(def-macro-id ...)))
-	   (for-each (lambda (macro-id)
-		       (unless (bound-identifier-mapping-get t macro-id (lambda () #f))
-			 (raise-syntax-error
-			  #f
-			  "id to trigger indirect exports not defined as syntax in the library"
-			  macro-id)))
-		     macro-ids)
-	   (for-each (lambda (id)
-		       (bound-identifier-mapping-put! t id #t))
-		     (syntax->list #'(id ...)))
-	   (for-each (lambda (id)
-		       (unless (bound-identifier-mapping-get t id (lambda () #f))
-			 (raise-syntax-error
-			  #f
-			  "indirect export not defined in the library"
-			  id)))
-		     (apply append ind-idss)))
-	 ;; Add each explicitly exported id to a table
-	 (let ([t (make-bound-identifier-mapping)])
-	   (for-each (lambda (id)
-		       (bound-identifier-mapping-put! t id #t))
-		     (syntax->list #'export-info))
-	   ;; Find fixpoint, adding indirect ids when the macro id is
-	   ;;  exported:
-	   (let loop ([macro-ids macro-ids]
-		      [ind-idss ind-idss]
-		      [next-macro-ids null]
-		      [next-ind-idss null]
-		      [added? #f])
-	     (cond
-	      [(null? macro-ids)
-	       (when added?
-		 (loop next-macro-ids next-ind-idss null null #f))]
-	      [(bound-identifier-mapping-get t (car macro-ids) (lambda () #f))
-	       (for-each (lambda (ind-id)
-			   (bound-identifier-mapping-put! t ind-id #t))
-			 (car ind-idss))
-	       (loop (cdr macro-ids) (cdr ind-idss) next-macro-ids next-ind-idss #t)]
-	      [else
-	       (loop (cdr macro-ids) (cdr ind-idss) 
-		     (cons (car macro-ids) next-macro-ids)
-		     (cons (car ind-idss) next-ind-idss)
-		     added?)]))
-	   ;; For each defined id, select an unboxer:
-	   (with-syntax ([((make-an-unboxer . box-a-def) ...)
-			  (map (lambda (id)
-				 (if (bound-identifier-mapping-get t id (lambda () #f))
-				     #'(make-unboxer . box-rhs)
-				     #'(make-protected-unboxer . no-box-rhs)))
-			       (syntax->list #'(id ...)))])
-	     ;; For each unexported macro id, add compile-time set!:
-	     (with-syntax ([(check-id ...)
-			    (map cdr (filter (lambda (p)
-					       (not (bound-identifier-mapping-get t (car p) (lambda () #f))))
-					     (map cons 
-						  (syntax->list #'(def-macro-id ...))
-						  (syntax->list #'(check-id ...)))))])
-	       #'(begin
-		   (begin-for-syntax (set! check-id #f) ...)
-		   (define-syntaxes (boxdef-id) box-a-def) ...
-		   (define-syntaxes (id ...)
-		     (values (make-an-unboxer (quote-syntax gen-id) (quote-syntax in-src-module)) ...)))))))]
-      [(_ in-src-module export-info indirects (body0 body ...) define-macro-ids defined-ids)
-       ;; Process one body form, body0
-       (let ([comdef (local-expand #'body0
-				   'module
-				   stops)])
-	 (syntax-case comdef (begin define-syntaxes define-values indirect-export)
-	   [(begin comdef ...)
-	    #`(begin-library-body in-src-module
-				  export-info 
-				  indirects
-				  (comdef ... body ...)
-				  define-macro-ids
-				  defined-ids)]
-	   [(define-syntaxes (id ...) rhs)
-	    (with-syntax ([(check-id ...) (generate-temporaries #'(id ...))])
-	      #`(begin (define-for-syntax check-id #t) ...
-		       (define-syntaxes (id ...)
-			 (let-values ([(id ...) rhs])
-			   (values (check-exported-macro id (lambda () check-id)) ...)))
-		       (begin-library-body in-src-module
-					   export-info 
-					   indirects
-					   (body ...)
-					   ((id check-id) ... . define-macro-ids)
-					   defined-ids)))]
-	   [(define-values (id ...) rhs)
-	    (with-syntax ([(gen-id ...) (generate-temporaries #'(id ...))]
-			  [(boxdef-id ...) (generate-temporaries #'(id ...))])
-	      #`(begin 
-		  (define-values (gen-id ...) 
-		    (syntax-parameterize ([in-src-module #t])
-		      (let-values ([(id ...) rhs])
-			(values (boxdef-id id) ...))))
-		  (begin-library-body in-src-module
-				      export-info 
-				      indirects
-				      (body ...)
-				      define-macro-ids
-				      ((id gen-id boxdef-id) ... . defined-ids))))]
-	   [(indirect-export (macro-id id ...) ...)
-	    (begin
-	      (for-each (lambda (x)
-			  (unless (identifier? x)
-			    (raise-syntax-error
-			     #f
-			     "expected an identifier"
-			     comdef
-			     x)))
-			(syntax->list #'(macro-id ... id ... ...)))
-	      #`(begin-library-body in-src-module
-				    export-info 
-				    ((macro-id id ...) ... . indirects)
-				    (body ...)
-				    define-macro-ids
-				    defined-ids))]
-	   [(indirect-export . _)
-	    (raise-syntax-error
-	     #f
-	     "bad syntax"
-	     comdef)]
-	   [expr
-	    ;; syntax-parameterize forces an expression (not defn):
-	    #`(begin
-		(syntax-parameterize ([in-src-module #t]) 
-		  expr)
-		(begin-library-body in-src-module
-				    export-info 
-				    indirects
-				    (body ...)
-				    define-macro-ids
-				    defined-ids))]))])))
diff --git a/collects/r6rs/library-repl.ss b/collects/r6rs/library-repl.ss
deleted file mode 100644
index c2f9814aaf..0000000000
--- a/collects/r6rs/library-repl.ss
+++ /dev/null
@@ -1,31 +0,0 @@
-
-(module library-repl mzscheme
-  (require (all-except "library-module.ss" #%module-begin)
-	   (prefix r6rs: "reader.ss"))
-  (require-for-syntax "private/uri.ss")
-  (provide import export indirect-export library)
-
-  (current-readtable r6rs:r6rs-readtable)
-
-  (define-syntax (library stx)
-    (syntax-case stx ()
-      [(_ name . rest)
-       (unless (string? (syntax-e #'name))
-	 (raise-syntax-error
-	  #f
-	  "expected a string for the library name"
-	  stx
-	  #'name))
-       (let ([modname (uri->symbol (syntax-e #'name))])
-	 #`(begin
-	     (module #,modname (lib "library-module.ss" "r6rs")
-	       #,(datum->syntax-object
-		  #f
-		  (list '#%module-begin stx)))
-	     ;; Notify module-name resolver that we defined something that
-	     ;;  might otherwise be loaded.
-	     ((current-module-name-resolver) #f '#,modname #f)))])))
-
-
-
-
diff --git a/collects/r6rs/library.ss b/collects/r6rs/library.ss
deleted file mode 100644
index 8a0d3b2a89..0000000000
--- a/collects/r6rs/library.ss
+++ /dev/null
@@ -1,40 +0,0 @@
-
-(module library mzscheme
-  (provide (rename lib-read read)
-	   (rename lib-read-syntax read-syntax))
-
-  (require (prefix r6rs: "reader.ss"))
-
-  (define lib-read
-    (case-lambda
-     [() (lib-read (current-input-port))]
-     [(input) (lib-read-syntax (object-name (current-input-port)) (current-input-port))]))
-		  
-  (define lib-read-syntax
-    (case-lambda
-     [() (lib-read-syntax (object-name (current-input-port)) (current-input-port))]
-     [(src-v) (lib-read-syntax src-v (current-input-port))]
-     [(src-v input) (let ([r1 (r6rs:read-syntax src-v input)]
-			  [r2 (r6rs:read-syntax src-v input)])
-		      (let ([name-stx (and (syntax? r1)
-					   (eof-object? r2)
-					   (pair? (syntax-e r1))
-					   (eq? 'library (syntax-e (car (syntax-e r1))))
-					   (or (and
-						(pair? (cdr (syntax-e r1)))
-						(cadr (syntax-e r1)))
-					       (and
-						(syntax? (cdr (syntax-e r1)))
-						(pair? (syntax-e (cdr (syntax-e r1))))
-						(car (syntax-e (cdr (syntax-e r1)))))))])
-			(unless (and name-stx (string? (syntax-e name-stx)))
-			  (error 'r6rs-load-handler
-				 "expected a single `library' form with a string name, found something else"))
-			(datum->syntax-object
-			 #f
-			 `(module ,(string->symbol (syntax-e name-stx)) (lib "library-module.ss" "r6rs")
-			    (#%module-begin ,r1)))))])))
-
-			    
-			
-
diff --git a/collects/r6rs/private/helpers.ss b/collects/r6rs/private/helpers.ss
deleted file mode 100644
index dd6f2c98e0..0000000000
--- a/collects/r6rs/private/helpers.ss
+++ /dev/null
@@ -1,328 +0,0 @@
-
-(module helpers mzscheme
-  (require (lib "list.ss")
-	   "uri.ss")
-  (require-for-template mzscheme)
-
-  (provide translate-import
-	   translate-export
-	   uri?)
-
-  (define (uri? s)
-    ;; Need a proper test here!
-    #t)
-
-  (define ((check-identifier stx) id)
-    (unless (identifier? id)
-      (raise-syntax-error
-       #f
-       "expected an identifier"
-       stx
-       id)))
-
-  (define (check-present orig-i what nested !not exceptions names)
-    (for-each (lambda (en)
-		(unless (!not (ormap (lambda (i) (bound-identifier=? (car en) i))
-				    names))
-		  (raise-syntax-error
-		   #f
-		   (format "~a in nested ~a" what nested)
-		   orig-i
-		   (car en))))
-	      exceptions))
-
-  (define (add-prefix prefix id)
-    (if prefix
-	(datum->syntax-object id
-			      (string->symbol
-			       (format "~a~a" (syntax-e prefix) (syntax-e id)))
-			      id)
-	id))
-
-  (define (locate-rename id renames)
-    (cond
-     [(null? renames) #f]
-     [(bound-identifier=? id (caar renames)) (cdar renames)]
-     [else (locate-rename id (cdr renames))]))
-
-  (define (apply-rename new-names old-names name-pairs rcons)
-    (map (lambda (i)
-	   (or (ormap (lambda (new old)
-			(and (bound-identifier=? (car i) new)
-			     (rcons old (cdr i))))
-		      new-names old-names)
-	       i))
-	 name-pairs))
-
-  (define (remove-all-prefixes orig-i name-pairs form prefix)
-    (let ([s (symbol->string (syntax-e prefix))])
-      (map (lambda (i)
-	     (let ([old (symbol->string (syntax-e (car i)))])
-	       (unless (and ((string-length old) . >= . (string-length s))
-			    (string=? s (substring old 0 (string-length s))))
-		 (raise-syntax-error
-		  #f
-		  (format "~a does not have prefix ~s added by nested `prefix' form"
-			  form
-			  s)
-		  orig-i
-		  (car i)))
-	       (cons (datum->syntax-object (car i)
-					   (string->symbol (substring old (string-length s)))
-					   (car i))
-		     (cdr i))))
-	   name-pairs)))		  
-
-  (define (check-unique-names orig-i what names)
-    (let ([dup (check-duplicate-identifier names)])
-      (when dup
-	(raise-syntax-error
-	 #f
-	 (format "duplicate ~a identifier" what)
-	 orig-i
-	 dup))))
-
-  (define (localize i stx)
-    (datum->syntax-object i (syntax-e stx)))
-
-  (define (translate-import i)
-    (define orig-i #`(import #,i))
-    (syntax-case* i (for run expand) (lambda (a b) (eq? (syntax-e a) (syntax-e b)))
-      [(for sub run expand)
-       (finish-translate-import orig-i #'sub #t #t)]
-      [(for sub expand run)
-       (finish-translate-import orig-i #'sub #t #t)]
-      [(for sub run)
-       (finish-translate-import orig-i #'sub #t #f)]
-      [(for sub expand)
-       (finish-translate-import orig-i #'sub #f #t)]
-      [(for . _)
-       (raise-syntax-error
-	#f
-	"bad `for' form"
-	orig-i
-	i)]
-      [_else
-       (finish-translate-import orig-i i #t #f)]))
-
-  (define (finish-translate-import orig-i i run? expand?)
-    (define (mk-require l)
-      (cond
-       [(and run? expand?)
-	#`(begin (require #,@l) (require-for-syntax #,@l))]
-       [run?
-	#`(require #,@l)]
-       [expand?
-	#`(require-for-syntax #,@l)]))
-    (translate-impexp
-     i orig-i
-     (lambda (i exceptions onlys renames extra-prefix)
-       ;; Found a base URI?
-       (unless (and (string? (syntax-e i))
-		    (uri? (syntax-e i)))
-	 (raise-syntax-error
-	  #f
-	  "expected a URI string or an `only', `except', `add-prefix', or `rename' form"
-	  orig-i
-	  i))
-       (let ([name (datum->syntax-object i (uri->module-path (syntax-e i)) i)])
-	 (cond
-	  [onlys
-	   ;; Onlys are implemented with `rename':
-	   (mk-require (map (lambda (name-pair)
-			      #`(rename #,name #,(cdr name-pair) #,(car name-pair)))
-			    onlys))]
-	  [(or exceptions (pair? renames))
-	   ;; First import non-renamed, then renamed:
-	   (mk-require (cons
-			(localize i #`(#,(if extra-prefix #'prefix-all-except #'all-except)
-				       #,@(if extra-prefix (list extra-prefix) null)
-				       #,name
-				       #,@(append (map car (or exceptions null))
-						  (map car renames))))
-			(map (lambda (i)
-			       #`(rename #,name #,(cdr i) #,(car i)))
-			     renames)))]
-	  [extra-prefix
-	   (mk-require (list (localize i #`(prefix #,extra-prefix #,name))))]
-	  [else
-	   (mk-require (list name))])))))
-
-  (define (translate-export i)
-    (define orig-i #`(export #,i))
-    #`(provide
-       #,@(syntax-case* i (rename) (lambda (a b) (eq? (syntax-e a) (syntax-e b)))
-	    [(rename ie ...)
-	     (begin
-	       (for-each (lambda (ie)
-			   (syntax-case ie ()
-			     [(int ext)
-			      (for-each (lambda (i)
-					  (unless (identifier? i)
-					    (raise-syntax-error
-					     #f
-					     "expected an identifier for rename"
-					     orig-i
-					     i)))
-					(list #'int #'ext))]))
-			 (syntax->list #'(ie ...)))
-	       #`((rename . ie) ...))]
-	    [(rename . x)
-	     (raise-syntax-error
-	      #f
-	      "bad rename clause"
-	      i
-	      orig-i)]
-	    [_
-	     (identifier? i)
-	     (list i)]
-	    [_else
-	     (raise-syntax-error
-	      #f
-	      "expected an identifier or `rename' form"
-	      orig-i
-	      i)])))
-
-  (define (translate-impexp i orig-i k)
-    (let loop ([i i]
-	       [exceptions #f]    ; #f if onlys
-	       [onlys #f]         ; #f if exceptions
-	       [renames null]     ; null if onlys
-	       [extra-prefix #f]) ; #f if onlys, already folded into exceptions & renames
-      (syntax-case* i (only except rename add-prefix) (lambda (a b) (eq? (syntax-e a) (syntax-e b)))
-	[(only sub name ...)
-	 (let ([names (syntax->list #'(name ...))])
-	   (for-each (check-identifier i) names)
-	   (check-unique-names orig-i "`only'" names)
-	   (check-present orig-i "rename not" "`only' list" values renames names)
-	   (cond
-	    [exceptions
-	     (check-present orig-i "except not" "`only' list" values exceptions names)
-	     (loop #'sub
-		   #f
-		   (remove* exceptions (map (lambda (i) 
-					      (cons i (or (locate-rename i renames)
-							  (add-prefix extra-prefix i))))
-					    names)
-			    (lambda (a b) (bound-identifier=? (car a) (car b))))
-		   null
-		   #f)]
-	    [onlys
-	     (check-present orig-i "only not" "`only' list" values onlys names)
-	     (loop #'sub #f onlys null #f)]
-	    [else
-	     (loop #'sub
-		   #f
-		   (map (lambda (i)
-			  (cons i (or (locate-rename i renames)
-				      (add-prefix extra-prefix i))))
-			names)
-		   null
-		   #f)]))]
-	[(only . _)
-	 (raise-syntax-error
-	  #f
-	  "bad syntax"
-	  i)]
-	[(except sub name ...)
-	 (let ([names (syntax->list #'(name ...))])
-	   (for-each (check-identifier i) names)
-	   (check-unique-names orig-i "`except'" names)
-	   (check-present orig-i "rename" "`except' list" not renames names)
-	   (let ([remove-exceptions
-		  (lambda ()
-		    (remove* exceptions renames (lambda (a b) (bound-identifier=? (car a) (car b)))))])
-	     (cond
-	      [(pair? exceptions)
-	       (check-present orig-i "except" "`except' list" not exceptions names)
-	       ;; union the exceptions
-	       (loop #'sub
-		     (append
-		      (remove* exceptions (map (lambda (i) 
-						 (cons i (or (locate-rename i renames)
-							     (add-prefix extra-prefix i))))
-					       names)
-			       (lambda (a b) (bound-identifier=? (car a) (car b))))
-		      exceptions)
-		     #f
-		     (remove-exceptions)
-		     extra-prefix)]
-	      [(pair? onlys)
-	       (check-present orig-i "only" "`except' list" not onlys names)
-	       (loop #'sub #f onlys null #f)]
-	      [else
-	       (loop #'sub
-		     (map (lambda (i)
-			    (cons i (add-prefix extra-prefix i)))
-			  names) 
-		     #f
-		     (remove-exceptions)
-		     extra-prefix)])))]
-	[(except . _)
-	 (raise-syntax-error
-	  #f
-	  "bad syntax"
-	  i)]
-	[(rename sub (new old) ...)
-	 (let* ([new-names (syntax->list #'(new ...))]
-		[old-names (syntax->list #'(old ...))]
-		[name-pairs (map (lambda (old new)
-				   (cons old (add-prefix extra-prefix new)))
-				 old-names new-names)])
-	   (for-each (check-identifier i) (apply append (map list new-names old-names)))
-	   (check-unique-names orig-i "`rename' target" new-names)
-	   (check-unique-names orig-i "`rename' source" old-names)
-	   (let ([combine-renames
-		  (lambda ()
-		    (let ([renames (apply-rename new-names old-names renames cons)])
-		      (append
-		       renames
-		       (remove* renames name-pairs 
-				(lambda (a b)
-				  (bound-identifier=? (car a) (car b)))))))])
-	     (cond
-	      [exceptions
-	       (loop #'sub
-		     (apply-rename new-names old-names exceptions cons)
-		     #f
-		     (combine-renames)
-		     extra-prefix)]
-	      [onlys
-	       (loop #'sub
-		     #f
-		     (apply-rename new-names old-names onlys cons)
-		     null
-		     #f)]
-	      [else
-	       (loop #'sub
-		     #f
-		     #f
-		     (combine-renames)
-		     extra-prefix)])))]
-	[(rename . _)
-	 (raise-syntax-error
-	  #f
-	  "bad syntax"
-	  i)]
-	[(add-prefix sub prefix)
-	 (cond
-	  [onlys
-	   (loop #'sub
-		 #f
-		 (remove-all-prefixes orig-i onlys "only" #'prefix)
-		 null
-		 #f)]
-	  [else
-	   (loop #'sub
-		 (and exceptions
-		      (remove-all-prefixes orig-i exceptions "except" #'prefix))
-		 #f
-		 (remove-all-prefixes orig-i renames "rename" #'prefix)
-		 (add-prefix extra-prefix #'prefix))])]
-	[(add-prefix . _)
-	 (raise-syntax-error
-	  #f
-	  "bad syntax"
-	  i)]
-	[_else
-	 (k i exceptions onlys renames extra-prefix)]))))
diff --git a/collects/r6rs/private/uri.ss b/collects/r6rs/private/uri.ss
deleted file mode 100644
index 8a5543727d..0000000000
--- a/collects/r6rs/private/uri.ss
+++ /dev/null
@@ -1,68 +0,0 @@
-
-(module uri mzscheme
-  (require (lib "string.ss")
-	   (lib "list.ss"))
-  (provide uri->symbol
-	   uri->module-path)
-
-  (define rx:scheme-uri #rx"^[sS][cC][hH][eE][mM][eE]://([^/]+/+[^/]+.*)$")
-
-  (define (uri->scheme-path s)
-    (let ([m (regexp-match rx:scheme-uri s)])
-      (and m
-	   (let ([l (filter (lambda (s)
-			      (not (string=? s "")))
-			    (regexp-split #rx"/" (cadr m)))])
-	     (let loop ([l l][accum null])
-	       (cond
-		[(null? (cdr l))
-		 (let ([s (car l)])
-		   (cons (if (regexp-match #rx"[.]" s)
-			     s
-			     (string-append s ".scm"))
-			 (reverse accum)))]
-		[else (loop (cdr l) (cons (car l) accum))]))))))
-	   
-
-  (define (uri->symbol s)
-    (let ([p (uri->scheme-path s)])
-      (cond
-       [p (string->symbol
-	   (string-append
-	    ","
-	    (let ([collpath
-		   ;; Try to get real collection; if it doesn't exist,
-		   ;;  make one up relative to mzlib.
-		   (with-handlers ([exn:fail:filesystem?
-				    (lambda (exn)
-				      (simplify-path
-				       (apply build-path (collection-path "mzlib")
-					      'up
-					      (cdr p))))])
-		     (apply collection-path (cdr p)))])
-	      (path->string (build-path collpath
-					(path-replace-suffix (car p) #""))))))]
-       [else (string->symbol
-	      (string-append "," 
-			     (path->string
-			      (apply build-path 
-				     (simplify-path
-				      (expand-path
-				       ;; Don't use (current-load-relative-directory)
-				       (current-directory)))
-				     (filter 
-				      (lambda (x)
-					(not (string=? x "")))
-				      (regexp-split #rx"/" s))))))])))
-  
-  (define (uri->module-path s)
-    (let ([p (uri->scheme-path s)])
-      (cond
-       [p 
-	;; If the collection exists, build a `lib' path. Otherwise, assume
-	;;  that we're in REPL mode, and make up a symbol using uri->symbol
-	(if (with-handlers ([exn:fail:filesystem? (lambda (x) #f)])
-	      (apply collection-path (cdr p)))
-	    `(lib ,@p)
-	    (uri->symbol s))]
-       [else s]))))
diff --git a/collects/r6rs/r6rs.ss b/collects/r6rs/r6rs.ss
deleted file mode 100644
index ebf602afd8..0000000000
--- a/collects/r6rs/r6rs.ss
+++ /dev/null
@@ -1,73 +0,0 @@
-
-(module r6rs mzscheme
-  (require (prefix r5rs: (lib "r5rs.ss" "lang")))
-
-  ;; R5RS 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>=? string-ci<? string-ci>?
-	   vector? make-vector vector vector-ref vector-set! 
-	   char? char=? char<? char>? char<=? char>=? 
-	   char-ci=? 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)
-
-  ;; Extra values for R6RS:
-  (provide bound-identifier=?
-	   (rename syntax->list syntax-object->list))
-
-  ;; R5RS syntax (plus revised #%module-begin)
-  (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 r6rs-module-begin #%module-begin)
-	   (rename require #%require)
-	   (rename provide #%provide))
-
-  ;; Extra syntax for R6RS:
-  (provide syntax-rules syntax-case syntax)
-
-  (define-syntax r6rs-module-begin
-    (lambda (stx)
-      (datum->syntax-object
-       (quote-syntax here)
-       (list* (quote-syntax #%plain-module-begin)
-	      (list 'require-for-syntax 
-		    (datum->syntax-object
-		     stx
-		     '(lib "r6rs.ss" "r6rs")))
-	      (cdr (syntax-e stx)))
-       stx))))
diff --git a/collects/r6rs/reader.ss b/collects/r6rs/reader.ss
deleted file mode 100644
index 2aec7ec92c..0000000000
--- a/collects/r6rs/reader.ss
+++ /dev/null
@@ -1,281 +0,0 @@
-
-(module reader mzscheme
-  (provide r6rs-readtable
-	   (rename r6rs-read read)
-	   (rename r6rs-read-syntax read-syntax))
-
-  ;; for raise-read-[eof-]error:
-  (require (lib "readerr.ss" "syntax"))
-
-  (define hex-digits (string->list "0123456789abcdefABCDEF"))
-  (define standard-delimiters (string->list ";',`()[]{}"))
-
-  ;; hex-value : char -> int
-  (define (hex-value ch)
-    (cond
-     [(char-numeric? ch)
-      (- (char->integer ch) 48)]
-     [(memv ch '(#\a #\b #\c #\d #\e #\f))
-      (- (char->integer ch) 87)]
-     [else
-      (- (char->integer ch) 55)]))
-
-  ;; read-delimited-string : char input-port .... -> string
-  ;;  Reads a string or symbol, given the closing character
-  (define (read-delimited-string closer-ch port
-				 what src line col pos)
-    ;; raise-bad-eof
-    ;;  Reports an unexpected EOF in a string/symbol
-    (define (raise-bad-eof len)
-      (raise-read-eof-error 
-       (format "unexpected end-of-file in ~a" what) 
-       src line col pos len))
-
-    ;; to-hex : char int -> int
-    ;;  Checks input and gets it's value as a hex digit
-    (define (to-hex ch len)
-      (unless (memv ch hex-digits)
-	(if (eof-object? ch)
-	    (raise-bad-eof len)
-	    (raise-read-error 
-	     (format "expected a hex digit for ~a, found: ~e" what ch)
-	     src line col pos len)))
-      (hex-value ch))
-
-    ;; loop to read string/symbol characters; track the length for error reporting
-    (let loop ([chars null][len 1])
-      (let ([ch (read-char port)])
-	(cond
-	 ;; eof
-	 [(eof-object? ch) (raise-bad-eof len)]
-	 ;; closing quote or bar
-	 [(char=? ch closer-ch) (list->string (reverse chars))]
-	 ;; escape
-	 [(char=? ch #\\)
-	  (let ([ch (read-char port)])
-	    (cond
-	     ;; eof after escape
-	     [(eof-object? ch) (raise-bad-eof (add1 len))]
-	     ;; newline escape
-	     [(char=? #\newline ch)
-	      ;; Eat whitespace until we find a newline...
-	      (let w-loop ([len (+ len 1)])
-		(let ([ch (peek-char port)])
-		  (cond
-		   [(eof-object? ch) (raise-bad-eof len)]
-		   [(and (char-whitespace? ch)
-			 (not (char=? #\newline ch))) 
-		    (read-char port)
-		    (w-loop (+ len 1))]
-		   [else
-		    (loop chars len)])))]
-	     ;; space escape
-	     [(char=? #\space ch)
-	      (loop (cons #\space chars) (+ len 2))]
-	     ;; 2-digit hex escape
-	     [(char=? #\x ch)
-	      (let* ([ch1 (to-hex (read-char port) (+ len 2))]
-		     [ch2 (to-hex (read-char port) (+ len 3))])
-		(loop (cons (integer->char (+ (* ch1 16) ch2)) 
-			    chars)
-		      (+ len 3)))]
-	     ;; 4-digit hex escape
-	     [(char=? #\u ch)
-	      (let* ([ch1 (to-hex (read-char port) (+ len 2))]
-		     [ch2 (to-hex (read-char port) (+ len 3))]
-		     [ch3 (to-hex (read-char port) (+ len 4))]
-		     [ch4 (to-hex (read-char port) (+ len 5))])
-		(let ([v (+ (* ch1 4096) (* ch2 256) (* ch3 16) ch4)])
-		  (when (<= #xD8FF v #xDFFF)
-		    (raise-read-error 
-		     (format "out-of-range character for ~a: \\u~a~a~a~a" 
-			     what ch1 ch2 ch3 ch4)
-		     src line col pos (+ len 5)))
-		  (loop (cons (integer->char v) chars) 
-			(+ len 5))))]
-	     ;; 8-digit hex escape
-	     [(char=? #\U ch)
-	      (let* ([ch1 (to-hex (read-char port) (+ len 2))]
-		     [ch2 (to-hex (read-char port) (+ len 3))]
-		     [ch3 (to-hex (read-char port) (+ len 4))]
-		     [ch4 (to-hex (read-char port) (+ len 5))]
-		     [ch5 (to-hex (read-char port) (+ len 6))]
-		     [ch6 (to-hex (read-char port) (+ len 7))]
-		     [ch7 (to-hex (read-char port) (+ len 8))]
-		     [ch8 (to-hex (read-char port) (+ len 9))])
-		(let ([v (+ (* ch1 268435456) (* ch2 16777216) (* ch3 1048576) (* ch4 65536)
-			    (* ch5 4096) (* ch6 256) (* ch7 16) ch8)])
-		  (when (or (> v #x10FFFF)
-			    (<= #xD8FF v #xDFFF))
-		    (raise-read-error 
-		     (format "out-of-range character for ~a: \\U~a~a~a~a~a~a~a~a" 
-			     what ch1 ch2 ch3 ch4 ch5 ch6 ch7 ch8)
-		     src line col pos (+ len 9)))
-		  (loop (cons (integer->char v) chars)
-			(+ len 9))))]
-	     ;; other escapes
-	     [else (let ([v (case ch
-			      [(#\a) 7]
-			      [(#\b) 8]
-			      [(#\t) 9]
-			      [(#\n) 10]
-			      [(#\v) 11]
-			      [(#\f) 12]
-			      [(#\r) 13]
-			      [(#\") 34]
-			      [(#\\) 92]
-			      [(#\|) 124]
-			      ;; not a valid escape!
-			      [else
-			       (raise-read-error 
-				(format "illegal escape for ~a: \\~a" what ch)
-				src line col pos (+ len 2))])])
-		     (loop (cons (integer->char v) chars) (+ len 2)))]))]
-	 ;; other character
-	 [else (loop (cons ch chars) (+ len 1))]))))
-
-  ;; read-quoted-symbol
-  ;;  Reader macro for |
-  (define (read-quoted-symbol ch port src line col pos)
-    (string->symbol (read-delimited-string #\| port
-					    "symbol" src line col pos)))
-  
-  ;; read-quoted-string
-  ;;  Reader macro for "
-  (define (read-quoted-string ch port src line col pos)
-    (read-delimited-string #\" port 
-			    "string" src line col pos))
-
-  ;; read-character
-  ;;  Reader macro for characters
-  (define (read-character ch port src line col pos)
-
-    ;; make-char-const : list-of-char len -> char
-    ;;  Checks whether the character sequence names a char,
-    ;;  and either reports and error or returns the character
-    (define (make-char-const chars len)
-      (let ([chars (reverse chars)])
-	(if (null? (cdr chars))
-	    ;; simple case: single character
-	    (car chars)
-	    ;; multi-character name:
-	    (let ([name (list->string chars)])
-	      ;; raise-bad-char
-	      ;;  When it's not a valid character
-	      (define (raise-bad-char detail)
-		(raise-read-error 
-		 (format "bad character constant~a: #\\~a" detail name)
-		 src line col pos len))
-
-	      ;; hex-char : int -> char
-	      ;;  Checks whether chars has n hex digits, and
-	      ;;  produces the character if so
-	      (define (hex-char n)
-		(unless (= (+ n 1) (length chars))
-		  (raise-bad-char (format " (expected ~a hex digits after #\\~a) "
-					  n
-					  (car chars))))
-		(for-each (lambda (c) 
-			    (unless (memv c hex-digits)
-			      (raise-bad-char (format " (expected hex digit, found ~a) " c))))
-			  (cdr chars))
-		(let loop ([n 0][chars (cdr chars)])
-		  (if (null? chars)
-		      (begin
-			(when (or (> n #x10FFFF)
-				  (<= #xD8FF n #xDFFF))
-			  (raise-read-error 
-			   (format "out-of-range character: #\\~a" name)
-			   src line col pos (+ len 9)))
-			(integer->char n))
-		      (loop (+ (* n 16) (hex-value (car chars)))
-			    (cdr chars)))))
-
-	      ;; Check for standard names or hex, and report an error if not
-	      (case (string->symbol name)
-		[(nul) (integer->char 0)]
-		[(alarm) (integer->char 7)]
-		[(backspace) (integer->char 8)]
-		[(tab) (integer->char 9)]
-		[(newline linefeed) (integer->char 10)]
-		[(vtab) (integer->char 11)]
-		[(page) (integer->char 12)]
-		[(return) (integer->char 13)]
-		[(esc) (integer->char 27)]
-		[(space) (integer->char 32)]
-		[(delete) (integer->char 127)]
-		[else
-		 ;; Hex?
-		 (case (car chars)
-		   [(#\x)
-		    (hex-char 2)]
-		   [(#\u)
-		    (hex-char 4)]
-		   [(#\U)
-		    (hex-char 8)]
-		   [else
-		    (raise-bad-char "")])])))))
-    
-    ;; read the leading character:
-    (let ([ch (read-char port)])
-      (when (eof-object? ch)
-	(raise-read-eof-error "unexpected end-of-file after #\\"
-			      src line col pos 2))
-      ;; loop until delimiter:
-      (let loop ([len 3][chars (list ch)])
-	(let ([ch (peek-char port)])
-	  (if (eof-object? ch)
-	      ;; eof is a delimiter
-	      (make-char-const chars len)
-	      ;; otherwise, consult the current readtable to find delimiters
-	      ;; in case someone extends r6rs-readtable:
-	      (let-values ([(kind proc dispatch-proc) 
-			    (readtable-mapping (current-readtable) ch)])
-		(cond
-		 [(eq? kind 'terminating-macro) 
-		  ;; a terminating macro is a delimiter by definition
-		  (make-char-const chars len)]
-		 [(or (char-whitespace? ch)
-		      (member ch standard-delimiters))
-		  ;; something mapped to one of the standard delimiters is
-		  ;; a delimiter
-		  (make-char-const chars len)]
-		 [else 
-		  ;; otherwise, it's not a delimiter
-		  (read-char port)
-		  (loop (add1 len) (cons ch chars))])))))))
-
-  (define (reject-backslash ch port src line col pos)
-    (raise-read-error 
-     "illegal character in input: \\"
-     src line col pos 1))
-
-  ;; r6rs-readtable
-  ;;  Extends MzScheme's default reader to handle quoted symbols,
-  ;;   strings, and characters:
-  (define r6rs-readtable
-    (make-readtable #f
-		    ;; New syntax:
-		    #\| 'terminating-macro read-quoted-symbol
-		    #\" 'terminating-macro read-quoted-string
-		    #\\ 'dispatch-macro read-character
-		    ;; Disable \ symbol escape:
-		    #\\ 'terminating-macro reject-backslash))
-		    
-
-  ;; r6rs-read
-  ;;  Like the normal read, but uses r6rs-readtable
-  (define r6rs-read
-    (case-lambda
-     [() (r6rs-read (current-input-port))]
-     [(input) (parameterize ([current-readtable r6rs-readtable])
-		(read input))]))
-
-  ;; r6rs-read-syntax
-  ;;  Like the normal read-syntax, but uses r6rs-readtable
-  (define r6rs-read-syntax
-    (case-lambda
-     [() (r6rs-read-syntax (object-name (current-input-port)) (current-input-port))]
-     [(src-v) (r6rs-read-syntax src-v (current-input-port))]
-     [(src-v input) (parameterize ([current-readtable r6rs-readtable])
-		      (read-syntax src-v input))])))