plt-r6rs executable and initial r6rs docs

svn: r8859

collects/mzlib/cm.ss

@@ -1,15 +1,15 @@
-(module cm mzscheme
+(module cm scheme/base
   (require syntax/modcode
            syntax/modresolve
 	   (lib "main-collects.ss" "setup")
-	   mzlib/file)
+	   scheme/file)
 
   (provide make-compilation-manager-load/use-compiled-handler
 	   managed-compile-zo
 	   make-caching-managed-compile-zo
 	   trust-existing-zos
 	   manager-compile-notify-handler
-	   (rename trace manager-trace-handler))
+	   (rename-out [trace manager-trace-handler]))
   
   (define manager-compile-notify-handler (make-parameter void))
   (define trace (make-parameter void))
@@ -71,7 +71,7 @@
       (with-handlers ([void (lambda (exn)
 			      (try-delete-file path)
 			      (raise exn))])
-	(let ([out (open-output-file path 'truncate/replace)])
+	(let ([out (open-output-file path #:exists 'truncate/replace)])
 	  (dynamic-wind
 	      void
 	      (lambda ()
@@ -96,7 +96,7 @@
 	 (newline op)))))
 
   (define (touch path)
-    (close-output-port (open-output-file path 'append)))
+    (close-output-port (open-output-file path #:exists 'append)))
 
   (define (compilation-failure mode path zo-name date-path reason)
     (with-handlers ((exn:fail:filesystem? void))
@@ -108,7 +108,7 @@
 	 (display reason p))))
     (trace-printf "failure"))
 
-  (define (compile-zo mode path)
+  (define (compile-zo mode path read-src-syntax)
     ((manager-compile-notify-handler) path)
     (trace-printf "compiling: ~a" path)
     (parameterize ([indent (string-append "  " (indent))])
@@ -145,9 +145,9 @@
                                                            (cons (path->bytes p)
                                                                  external-deps)))))
                                                d)))])
-                           (get-module-code path mode))]
+                           (get-module-code path mode #:source-reader read-src-syntax))]
                    [code-dir (get-code-dir mode path)])
-              (if (not (directory-exists? code-dir))
+              (when (not (directory-exists? code-dir))
                 (make-directory* code-dir))
 	      (with-compile-output
 	       zo-name
@@ -214,8 +214,8 @@
               (file-or-directory-modify-seconds name)))
 	  (apply first-date l))]))
   
-  (define (compile-root mode path up-to-date)
+  (define (compile-root mode path up-to-date read-src-syntax)
-    (let ([path (simplify-path (expand-path path))])
+    (let ([path (simplify-path (cleanse-path path))])
       (let ((stamp (and up-to-date
 			(hash-table-get up-to-date path #f))))
 	(cond
@@ -235,7 +235,7 @@
                 (cond
                   ((> path-time path-zo-time) 
 		   (trace-printf "newer src...")
-		   (compile-zo mode path))
+		   (compile-zo mode path read-src-syntax))
                   (else
                    (let ((deps (with-handlers ((exn:fail:filesystem? (lambda (ex) (list (version)))))
                                  (call-with-input-file (path-add-suffix (get-compilation-path mode path) #".dep")
@@ -244,13 +244,13 @@
                        ((or (not (pair? deps))
                             (not (equal? (version) (car deps))))
 			(trace-printf "newer version...")
-                        (compile-zo mode path))
+                        (compile-zo mode path read-src-syntax))
                        ((ormap (lambda (d)
 				 ;; str => str is a module file name (check transitive dates)
 				 ;; (cons 'ext str) => str is an non-module file (check date)
 				 (let ([t (cond
-					   [(bytes? d) (compile-root mode (bytes->path d) up-to-date)]
+					   [(bytes? d) (compile-root mode (bytes->path d) up-to-date read-src-syntax)]
-					   [(path? d) (compile-root mode d up-to-date)]
+					   [(path? d) (compile-root mode d up-to-date read-src-syntax)]
 					   [(and (pair? d) 
 						 (eq? (car d) 'ext)
 						 (or (bytes? (cdr d))
@@ -270,19 +270,20 @@
                                           (cons 'ext (main-collects-relative->path (cdr p)))
                                           (main-collects-relative->path p)))
                                     (cdr deps)))
-                        (compile-zo mode path))))))
+                        (compile-zo mode path read-src-syntax))))))
                 (let ((stamp (get-compiled-time mode path #t)))
                   (hash-table-put! up-to-date path stamp)
                   stamp)))))))))
   
-  (define (managed-compile-zo zo)
+  (define (managed-compile-zo zo [read-src-syntax read-syntax])
-    ((make-caching-managed-compile-zo) zo))
+    ((make-caching-managed-compile-zo read-src-syntax) zo))
   
-  (define (make-caching-managed-compile-zo)
+  (define (make-caching-managed-compile-zo [read-src-syntax read-syntax])
     (let ([cache (make-hash-table 'equal)])
       (lambda (zo)
 	(parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler/table cache)])
-	  (compile-root (car (use-compiled-file-paths)) (path->complete-path zo) cache)))))
+	  (compile-root (car (use-compiled-file-paths)) (path->complete-path zo) cache read-src-syntax)
+          (void)))))
 
   (define (make-compilation-manager-load/use-compiled-handler)
     (make-compilation-manager-load/use-compiled-handler/table (make-hash-table 'equal)))
@@ -330,7 +331,7 @@
                      (default-handler path mod-name)]
                     [else 
                      (trace-printf "processing: ~a" path)
-                     (compile-root (car modes) path cache)
+                     (compile-root (car modes) path cache read-syntax)
 		     (trace-printf "done: ~a" path)
                      (default-handler path mod-name)]))])
 	compilation-manager-load-handler))))

collects/r5rs/r5rs.scrbl

@@ -82,7 +82,7 @@ By default, @exec{plt-r5rs} departs from @|r5rs| conformance in one
 crucial way: the initial bindings of primitives correspond to module
 imports into the top-level environment, instead of variable bindings.
 This difference is visible if the name of a primitive is redefined at
-the top level. Use the @as-index{@DFlag{slow}} command-line
+the top level. Use the @as-index{@DFlag{no-prim}} command-line
 flag---before a file to load, if any---to obtain the standard behavior
 for primitive bindings (at the cost of performance).
 
@@ -110,7 +110,7 @@ corresponds to @|r5rs|. Use @scheme[(namespace-require/copy 'r5rs)]
 with an empty namespace to maximize conformance with @|r5rs|; Using
 @scheme[(namespace-require 'r5rs)], in contrast, creates primitive
 bindings as imports, which is the same as using
-@seclink["plt-r5rs"]{@exec{plt-r5rs}} without the @DFlag{slow} flag.
+@seclink["plt-r5rs"]{@exec{plt-r5rs}} without the @DFlag{no-prim} flag.
 More simply, use @scheme[(scheme-report-environment 5)].  See also
 @schememodname[r5rs/init], which sets reader and printer parameters to
 increase conformance.

collects/r5rs/run.ss

@@ -6,7 +6,7 @@
 (define-values (main args)
   (command-line
    #:once-each
-   [("--slow") "disable assumption that primitives are never redefined"
+   [("--no-prim") "(slow) disable assumption that primitives are never redefined"
     (slow #t)]
    #:handlers
    (case-lambda

collects/r6rs/info.ss

@@ -1 +1,7 @@
 #lang setup/infotab
+
+(define scribblings '(("scribblings/r6rs.scrbl" (multi-page))))
+(define doc-categories '((languages -1)))
+
+(define mzscheme-launcher-names '("PLT R6RS"))
+(define mzscheme-launcher-libraries '("run.ss"))

collects/r6rs/run.ss

@@ -0,0 +1,181 @@
+#lang scheme/base
+(require scheme/cmdline
+         compiler/cm
+         (prefix-in r6rs: "lang/reader.ss")
+         syntax/modcode
+         setup/dirs
+         scheme/port
+         scheme/file
+         "private/readtable.ss")
+
+(define install-mode (make-parameter #f))
+(define compile-mode (make-parameter #f))
+(define install-all-users (make-parameter #f))
+(define install-force (make-parameter #f))
+
+(define-values (main args)
+  (command-line
+   #:once-any
+   [("--install") "install libraries from <file>, or stdin if no <file> provided"
+    (install-mode #t)]
+   [("--compile") "compile <file> and all dependencies"
+    (compile-mode #t)]
+   #:once-each
+   [("--all-users") "install into main installation"
+    (install-all-users #t)]
+   [("--force") "overwrite existing libraries"
+    (install-force #t)]
+   #:handlers
+   (case-lambda
+    [(x) (values #f null)]
+    [(x file . args) (values file args)])
+   '("file" "arg")))
+
+(current-command-line-arguments (apply vector-immutable args))
+
+(define (r6rs-read-syntax . args)
+  (datum->syntax #f (apply r6rs:read-syntax args)))
+
+(define (extract-libraries orig)
+  (let loop ([last-pos 0])
+    (let ([peeker (let-values ([(line col pos) (port-next-location orig)])
+                    (let ([p (peeking-input-port orig)])
+                      (port-count-lines! p)
+                      (relocate-input-port p line col pos)))])
+      (port-count-lines! peeker)
+      (let ([lib-stx (with-r6rs-reader-parameters
+                      (lambda ()
+                        (read-syntax (object-name orig) peeker)))])
+        (if (eof-object? lib-stx)
+            null
+            (let ([lib (syntax->datum lib-stx)])
+              (unless (and (list? lib)
+                           ((length lib) . >= . 2)
+                           (eq? 'library (car lib)))
+                (raise-syntax-error
+                 'library
+                 "not an R6RS library form"
+                 lib-stx))
+              (let ([name (cadr lib)])
+                (unless (valid-name? name)
+                  (error (format
+                          "~a: invalid library name: ~e"
+                          (find-system-path 'run-file)
+                          name)))
+                (let ([path (name->path name)])
+                  (unless (install-force)
+                    (when (file-exists? path)
+                      (error (format "~a: file already exists: ~a for library: ~e"
+                                     (find-system-path 'run-file)
+                                     path
+                                     name))))
+                  (let ([code (open-output-bytes)])
+                    (let ([pos (file-position peeker)])
+                      (copy-port (make-limited-input-port orig (- pos last-pos)) code)
+                      (cons (cons path (get-output-bytes code #t))
+                            (loop pos))))))))))))
+
+(define (install-libraries orig)
+  (port-count-lines! orig)
+  (let ([libs (extract-libraries orig)])
+    (for-each (lambda (lib)
+                (let ([path (car lib)]
+                      [code (cdr lib)])
+                  (printf " [installing ~a]\n" path)
+                  (let-values ([(base name dir?) (split-path path)])
+                    (make-directory* base))
+                  (call-with-output-file* 
+                   path
+                   #:exists (if (install-force) 'truncate/replace 'error)
+                   (lambda (out)
+                     (display "#!r6rs\n" out)
+                     (display code out)
+                     (display "\n" out)))))
+              libs)
+    (for-each (lambda (lib)
+                (compile-file (car lib)))
+              libs)))
+            
+(define (valid-name? name)
+  (and (list? name)
+       (pair? name)
+       (symbol? (car name))
+       (let loop ([name name])
+         (cond
+          [(null? (cdr name))
+           (or (symbol? (car name))
+               (and (list? (car name))
+                    (andmap exact-nonnegative-integer? (car name))))]
+          [else (and (symbol? (car name))
+                     (loop (cdr name)))]))))
+
+(define (name->path name)
+  (let* ([name (if (or (= (length name) 1)
+                       (and (= (length name) 2)
+                            (not (symbol? (cadr name)))))
+                   (list* (car name) 'main (cdr name))
+                   name)])
+    (apply build-path
+           (if (install-all-users)
+               (find-collects-dir)
+               (find-user-collects-dir))
+           (let loop ([name name])
+             (cond
+              [(and (pair? (cdr name))
+                    (null? (cddr name))
+                    (not (symbol? (cadr name))))
+               ;; versioned:
+               (list
+                (format "~a~a.ss"
+                        (car name)
+                        (apply
+                         string-append
+                         (map (lambda (v)
+                                (format "-~a" v))
+                              (cadr name)))))]
+              [(null? (cdr name))
+               ;; unversioned:
+               (list (format "~a.ss" (car name)))]
+              [else
+               (cons (symbol->string (car name))
+                     (loop (cdr name)))])))))
+
+;; ----------------------------------------
+
+(define (compile-file src)
+  (parameterize ([manager-compile-notify-handler
+                  (lambda (p)
+                    (printf " [Compiling ~a]\n" p))])
+    (managed-compile-zo src r6rs-read-syntax)))
+
+;; ----------------------------------------
+
+(cond
+ [(install-mode)
+  (if main
+      (call-with-input-file* main install-libraries)
+      (install-libraries (current-input-port)))]
+ [(compile-mode)
+  (unless main
+    (error (format "~a: need a file to compile" (find-system-path 'run-file))))
+  (compile-file main)]
+ [else
+  (unless main
+    (error (format "~a: need a file to run" (find-system-path 'run-file))))
+  (let* ([main (path->complete-path main)]
+         [zo (let-values ([(base name dir?) (split-path main)])
+               (build-path base 
+                           "compiled"
+                           (path-add-suffix name #".zo")))])
+    (if ((file-or-directory-modify-seconds zo #f (lambda () -inf.0))
+         . > . 
+         (file-or-directory-modify-seconds main #f (lambda () -inf.0)))
+        ;; .zo will be used; no need to set reader:
+        (dynamic-require main #f)
+        ;; need to read with R6RS reader
+        (let ([code (get-module-code main #:source-reader r6rs-read-syntax)]
+              [rpath (module-path-index-resolve
+                      (module-path-index-join main #f))])
+          (parameterize ([current-module-declare-name rpath])
+            (eval code))
+          (dynamic-require rpath #f))))])

collects/r6rs/scribblings/r6rs.scrbl

@@ -0,0 +1,196 @@
+#lang scribble/doc
+@(require scribble/manual
+          scribble/bnf
+          (for-label setup/dirs
+                     rnrs/programs-6))
+
+@(define guide-src '(lib "scribblings/guide/guide.scrbl"))
+
+@(define r6rs @elem{R@superscript{6}RS})
+
+@title{@bold{R6RS}: Standard Language}
+
+The ``The Revised@superscript{6} Report on the Algorithmic Language
+Scheme'' @cite["Sperber07"] defines a dialect of Scheme. We use
+@defterm{@|r6rs|} to refer to both the standard and the language
+defined by the standard.
+
+@|r6rs| defines both @defterm{libraries} and @defterm{top-level
+programs}. Both correspond to PLT Scheme @defterm{modules} (see
+@secref[#:doc guide-src "modules"]). That is, although @|r6rs| defines
+top-level programs as entry points, you can just as easily treat a
+library as an entry point when using PLT Scheme. The only difference
+is that an @|r6rs| top-level program cannot export any bindings to
+other modules.
+
+@table-of-contents[]
+
+@; ----------------------------------------
+
+@section{Running Top-Level Programs}
+
+To run a top-level program, either:
+
+@itemize{
+
+ @item{Use the @exec{plt-r6rs} executable, supplying the file that
+       contains the program on the command line:
+
+       @commandline{plt-r6rs @nonterm{program-file}}
+
+       Additional command-line arguments are propagated as
+       command-line arguments to the program (accessed via 
+       @scheme[command-line]).
+
+       To compile the file to bytecode (to speed future runs of the
+       program), use @exec{plt-r6rs} with the @DFlag{compile} flag:
+
+       @commandline{plt-r6rs --compile @nonterm{program-file}}
+  
+       The bytecode file is written in a @filepath{compiled}
+       sub-directory next to @nonterm{program-file}.
+
+       For example, if @filepath{hi.scm} contains
+
+       @schemeblock[
+       (import (rnrs))
+       (display "hello\n")
+       ]
+
+       then
+
+       @commandline{plt-r6rs hi.scm}
+
+       prints ``hello.''}
+
+ @item{Prefix the program with @schememetafont{#!r6rs}, which counts
+       as a comment from the @|r6rs| perspective, but is a synonym for
+       @scheme[#,(hash-lang) r6rs] from the PLT Scheme perspective.
+       Such files can be run like any other PLT Scheme module, such as
+       using @exec{mzscheme}:
+
+       @commandline{mzscheme @nonterm{program-file}}
+
+       or using DrScheme with the @onscreen{Module} language. The
+       file can also be compiled to bytecode using @exec{mzc}:
+
+       @commandline{mzc @nonterm{program-file}}
+
+       For example, if @filepath{hi.ss} contains
+
+       @schemeblock[
+       #,(schememetafont "#!r6rs")
+       (import (rnrs))
+       (display "hello\n")
+       ]
+
+       then
+
+       @commandline{mzscheme hi.ss}
+
+       prints ``hello.'' Similarly, opening @filepath{hi.ss} in
+       DrScheme and clicking @onscreen{Run} prints ``hello'' within
+       the DrScheme interactions window.}
+
+}
+
+@; ----------------------------------------
+
+@section{Installing Libraries}
+       
+To reference an @|r6rs| library from a top-level program or another
+library, it must be installed as a collection-based library in PLT
+Scheme.
+
+One way to produce an @|r6rs| installed library is to create in
+a @techlink[#:doc guide-src]{collection} a file that starts with
+@schememetafont{#!r6rs} and that contains a @scheme[library] form. For
+example, the following file might be created in a @filepath{hello.ss}
+file within a @filepath{examples} collection directory:
+
+       @schemeblock[
+       #,(schememetafont "#!r6rs")
+       (library (examples hello)
+         (export greet)
+         (import (rnrs))
+         
+         (define (greet)
+           (display "hello\n")))
+       ]
+
+Alternately, the @exec{plt-r6rs} executable with the @DFlag{install}
+flag accepts a sequence of @scheme[library] declarations and installs
+them into separate files in a collection directory, based on the
+declared name of each library:
+
+ @commandline{plt-r6rs --install @nonterm{libraries-file}}
+
+By default, libraries are installed into the user-specific collection
+directory (see @scheme[find-user-collects-dir]). The @DFlag{all-users}
+flag causes the libraries to be installed into the main installation,
+instead (see @scheme[find-collects-dir]):
+
+ @commandline{plt-r6rs --install --all-users @nonterm{libraries-file}}
+
+See @secref["libpaths"] for information on how @|r6rs| library names
+are turned into collection-based module paths, which determines where
+the files are written. Libraries installed by @exec{plt-r6rs
+@DFlag{install}} are automatically compiled to bytecode form.
+
+@; ----------------------------------------
+
+@section[#:tag "libpaths"]{Libraries and Collections}
+
+An @|r6rs| library name is sequence of symbols, optionally followed by
+a version as a sequence of exact, non-negative integers. Such a name
+is converted to a PLT Scheme module pathname (see @secref[#:doc
+guide-src "module-paths"]) by concatenating the symbols with a
+@litchar{/} separator, and then appending the version integers each
+with a preceeding @litchar{-}. As a special case, when an @|r6rs| path
+contains a single symbol followed by a version, a @schemeidfont{main}
+symbol is effectively inserted after the initial symbol.
+
+Examples:
+
+@schemeblock[
+(rnrs io simple (6))  #, @elem{corresponds to}  rnrs/io/simple-6
+(rnrs)                #, @elem{corresponds to}  rnrs
+(rnrs (6))            #, @elem{corresponds to}  rnrs/main-6
+]
+
+When an @|r6rs| library or top-level program refers to another
+library, it can supply version constraints rather than naming a
+specific version. The version constraint is resolved at compile time
+by searching the set of installed files.
+
+@; ----------------------------------------
+
+@section{Scheme Interoperability}
+
+Using the conversion rules in @secref["libpaths"], and @r6rs library
+can refer to modules that are implemented in other dialects supported
+by PLT Scheme, and other PLT Scheme modules can refer to libraries
+that are implemented in @|r6rs|.
+
+Beware that a @defterm{pair} in @|r6rs| corresponds to a
+@defterm{mutable pair} in @schememodname[scheme/base]. Otherwise,
+@|r6rs| libraries and @schememodname[scheme/base] share the same
+datatype for numbers, characters, strings, bytevectors (a.k.a. byte
+strings), vectors, hash tables, and so on. Input and output
+ports from @schememodname[scheme/base] can be used directly as binary
+ports with @|r6rs| libraries, and all @|r6rs| ports can be used as
+ports in @schememodname[scheme/base] programs, but only textual ports
+created via @|r6rs| libraries can be used by other @|r6rs| operations
+that expect textual ports.
+
+@; ----------------------------------------------------------------------
+
+@(bibliography
+
+ (bib-entry #:key "Sperber07"
+            #:author "Michael Sperber, R. Kent Dybvig, Matthew Flatt, and Anton van Straaten (editors)"
+            #:title @elem{The Revised@superscript{6} Report on the Algorithmic Language Scheme}
+            #:date "2007"
+            #:url "http://www.r6rs.org/")
+
+)

collects/scribble/base-render.ss

@@ -121,7 +121,7 @@
 
     (define/private (convert-key prefix k)
       (case (car k)
-        [(part tech)
+        [(part tech cite)
          (let ([rhs (cadr k)])
            (if (or (string? rhs) (pair? rhs))
                (list (car k) (cons prefix (if (pair? rhs)

collects/scribblings/guide/module-basics.scrbl

@@ -1,7 +1,8 @@
 #lang scribble/doc
 @(require scribble/manual
           scribble/eval
-          "guide-utils.ss")
+          "guide-utils.ss"
+          (for-label setup/dirs))
 
 @title[#:tag "module-basics"]{Module Basics}
 
@@ -49,9 +50,10 @@ references on all platforms, much like relative URLs.)
 
 Library modules that are distributed with PLT Scheme are usually
 referenced through an unquoted, suffixless path. The path is relative
-(roughly) to the library installation directory. The module below
+to the library installation directory, which contains directories for
-refers to the @filepath{date.ss} library that is part of the
+individual library @deftech{collections}. The module below refers to
-@filepath{scheme} collection.
+the @filepath{date.ss} library that is part of the @filepath{scheme}
+@tech{collection}.
 
 @schememod[
 scheme
@@ -62,5 +64,22 @@ scheme
         (date->string (seconds->date (current-seconds))))
 ]
 
+In addition to the main @tech{collection} directory, which contains
+all collections that are part of the installation, collections can
+also be installed in a user-specific location. Finally, additional
+collection directories can be specified n configuration files or
+through the @envvar{PLTCOLLECTS} search path. Try running the
+following program to find out where your collections are:
+
+@schememod[
+scheme
+
+(require setup/dirs)
+
+(find-collects-dir) (code:comment #, @t{main collection directory})
+(find-user-collects-dir) (code:comment #, @t{user-specific collection directory})
+(get-collects-search-dirs) (code:comment #, @t{complete search path})
+]
+
 We discuss more forms of module reference later in
 @secref["module-paths"].

collects/scribblings/mzc/make.scrbl

@@ -195,13 +195,20 @@ modules may produce compiled files with inconsistent timestamps and/or
 @filepath{.dep} files with incorrect information.}
 
 
-@defproc[(managed-compile-zo [file path-string?]) void?]{
+@defproc[(managed-compile-zo [file path-string?]
+                             [read-src-syntax (any/c input-port? . -> . syntax?) read-syntax]) 
+         void?]{
 
 Compiles the given module source file to a @filepath{.zo}, installing
 a compilation-manager handler while the file is compiled (so that
 required modules are also compiled), and creating a @filepath{.dep} file
 to record the timestamps of immediate files used to compile the source
-(i.e., files @scheme[require]d in the source).}
+(i.e., files @scheme[require]d in the source).
+
+If @scheme[file] is compiled from source, then
+@scheme[read-src-syntax] is used in the same way as
+@scheme[read-syntax] to read the source module. The normal
+@scheme[read-syntax] is used for any required files, however.}
 
 
 @defboolparam[trust-existing-zos trust?]{
@@ -212,12 +219,13 @@ compilation-manager @scheme[load/use-compiled] handler to ``touch''
 out-of-date @filepath{.zo} files instead of re-compiling from source.}
 
 
-@defproc[(make-caching-managed-compile-zo)
+@defproc[(make-caching-managed-compile-zo
+          [read-src-syntax (any/c input-port? . -> . syntax?)])
          (path-string? . -> . void?)]{
 
-Returns a procedure that behaves like @scheme[managed-compile-zo], but
+Returns a procedure that behaves like @scheme[managed-compile-zo]
-a cache of timestamp information is preserved across calls to the
+(providing the same @scheme[read-src-syntax] each time), but a cache
-procedure.}
+of timestamp information is preserved across calls to the procedure.}
 
 
 @defparam[manager-compile-notify-handler notify (path? . -> . any)]{

collects/syntax/modcode.ss

@@ -37,7 +37,7 @@
                        (file-or-directory-modify-seconds a))])
              (or (and (not bm) am) (and am bm (>= am bm))))))
 
-  (define (read-one orig-path path src?)
+  (define (read-one orig-path path src? read-src-syntax)
     (let ([p ((moddep-current-open-input-file) path)])
       (when src? (port-count-lines! p))
       (dynamic-wind
@@ -53,7 +53,7 @@
                                         (if (path? base)
                                             base
                                             (current-directory)))])
-                        (read-syntax path p))))])
+                        (read-src-syntax path p))))])
             (when (eof-object? v)
               (error 'read-one
                      "empty file; expected a module declaration in: ~a" path))
@@ -77,7 +77,8 @@
   (define (get-module-code path
                            [sub-path "compiled"] [compiler compile] [extension-handler #f] 
                            #:choose [choose (lambda (src zo so) #f)]
-                           #:notify [notify void])
+                           #:notify [notify void]
+                           #:source-reader [read-src-syntax read-syntax])
     (unless (path-string? path)
       (raise-type-error 'get-module-code "path or string (sans nul)" path))
     (let*-values ([(path) (resolve path)]
@@ -106,7 +107,7 @@
                (and (not prefer)
                     (date>=? zo path-d)))
            (notify zo)
-           (read-one path zo #f)]
+           (read-one path zo #f read-syntax)]
           ;; Maybe there's an .so? Use it only if we don't prefer source.
           [(or (eq? prefer 'so)
                (and (not prefer)
@@ -124,7 +125,7 @@
           [(or (eq? prefer 'src)
                path-d)
            (notify path)
-           (with-dir (lambda () (compiler (read-one path path #t))))]
+           (with-dir (lambda () (compiler (read-one path path #t read-src-syntax))))]
           ;; Report a not-there error
           [else (raise (make-exn:get-module-code
                         (format "get-module-code: no such file: ~e" path)

collects/syntax/scribblings/modcode.scrbl

@@ -15,7 +15,10 @@
                             . -> . 
                             (or/c (symbols 'src 'zo 'so) false/c))
                            (lambda (src zo so) #f)]
-                          [#:notify notify-proc (any/c . -> . any) void])
+                          [#:notify notify-proc (any/c . -> . any) void]
+                          [#:src-reader read-syntax-proc 
+                                        (any/c input-port? . -> . syntax?) 
+                                        read-syntax])
          any]{
 
 Returns a compiled expression for the declaration of the module
@@ -58,7 +61,10 @@ or an exception is raised (to report that an extension file cannot be
 used) when @scheme[ext-proc] is @scheme[#f].
 
 If @scheme[notify-proc] is supplied, it is called for the file
-(source, @filepath{.zo} or extension) that is chosen.}
+(source, @filepath{.zo} or extension) that is chosen.
+
+If @scheme[read-syntax-proc] is provided, it is used to read the
+module from a source file (but not from a bytecode file).}
 
 @defparam[moddep-current-open-input-file proc (path-string? . -> . input-port?)]{