language-readers receive environment as an arg

* module/language/assembly/spec.scm:
* module/language/brainfuck/spec.scm:
* module/language/bytecode/spec.scm:
* module/language/ecmascript/spec.scm:
* module/language/glil/spec.scm:
* module/language/scheme/spec.scm:
* module/language/tree-il/spec.scm: Language-readers now take two
  arguments: the port and the environment. This should allow for
  compile-environment-specific reader behavior.

* module/system/base/compile.scm (read-and-compile):
* module/system/repl/common.scm (repl-read): Pass the environment to the
  language-reader.

* module/system/repl/repl.scm (meta-reader, prompting-meta-read):
* module/system/repl/command.scm (define-meta-command): Use the second
  argument to repl-reader, so we avoid frobbing current-reader.

module/language/assembly/spec.scm

@@ -1,6 +1,6 @@
 ;;; Guile Virtual Machine Assembly
 
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -27,7 +27,7 @@
 (define-language assembly
   #:title	"Guile Virtual Machine Assembly Language"
   #:version	"2.0"
-  #:reader	read
+  #:reader	(lambda (port env) (read port))
   #:printer	write
   #:parser      read ;; fixme: make a verifier?
   #:compilers   `((bytecode . ,compile-bytecode))

module/language/brainfuck/spec.scm

@@ -37,7 +37,7 @@
 (define-language brainfuck
   #:title	"Guile Brainfuck"
   #:version	"1.0"
-  #:reader	(lambda () (read-brainfuck (current-input-port)))
+  #:reader	(lambda (port env) (read-brainfuck port))
   #:compilers	`((tree-il . ,compile-tree-il)
                   (scheme . ,compile-scheme))
   #:printer	write

module/language/bytecode/spec.scm

@@ -1,6 +1,6 @@
 ;;; Guile Lowlevel Intermediate Language
 
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -32,7 +32,7 @@
 (define-language bytecode
   #:title	"Guile Bytecode Vectors"
   #:version	"0.3"
-  #:reader	read
+  #:reader	(lambda (port env) (read port))
   #:printer	write
   #:compilers   `((objcode . ,compile-objcode))
   #:decompilers `((objcode . ,decompile-objcode))

module/language/ecmascript/spec.scm

@@ -31,7 +31,7 @@
 (define-language ecmascript
   #:title	"Guile ECMAScript"
   #:version	"3.0"
-  #:reader	(lambda () (read-ecmascript/1 (current-input-port)))
+  #:reader	(lambda (port env) (read-ecmascript/1 port))
   #:compilers   `((tree-il . ,compile-tree-il))
   ;; a pretty-printer would be interesting.
   #:printer	write

module/language/glil/spec.scm

@@ -1,6 +1,6 @@
 ;;; Guile Lowlevel Intermediate Language
 
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -34,7 +34,7 @@
 (define-language glil
   #:title	"Guile Lowlevel Intermediate Language (GLIL)"
   #:version	"0.3"
-  #:reader	read
+  #:reader	(lambda (port env) (read port))
   #:printer	write-glil
   #:parser      parse-glil
   #:compilers   `((assembly . ,compile-asm))

module/language/scheme/spec.scm

@@ -38,19 +38,18 @@
 (define-language scheme
   #:title	"Guile Scheme"
   #:version	"0.5"
-  #:reader      (lambda args
+  #:reader      (lambda (port env)
-                  ;; Read using the compilation environment's current reader.
+                  ;; Use the binding of current-reader from the environment.
-                  ;; Don't use the current module's `current-reader' because
+                  ;; FIXME: Handle `read-options' as well?
-                  ;; it might be set, e.g., to the REPL's reader, so we'd
+                  ((or (and=> (and=> (module-variable 
-                  ;; enter an infinite recursion.
+                                      (cond ((pair? env) (car env))
-                  ;; FIXME: Handle `read-options' as well.
+                                            (env)
-                  (let* ((mod  (current-compilation-environment))
+                                            (else (current-module)))
-                         (cr   (and (module? mod)
+                                      'current-reader)
-                                    (module-ref mod 'current-reader)))
+                                     variable-ref)
-                         (read (if (and cr (fluid-ref cr))
+                              fluid-ref)
-                                   (fluid-ref cr)
+                       read)
-                                   read)))
+                   port))
-                    (apply read args)))
 
   #:compilers   `((tree-il . ,compile-tree-il))
   #:decompilers `((tree-il . ,decompile-tree-il))

module/language/tree-il/spec.scm

@@ -34,7 +34,7 @@
 (define-language tree-il
   #:title	"Tree Intermediate Language"
   #:version	"1.0"
-  #:reader	read
+  #:reader	(lambda (port env) (read port))
   #:printer	write-tree-il
   #:parser      parse-tree-il
   #:joiner      join

module/system/base/compile.scm

@@ -235,7 +235,7 @@ function should only be called from stages in the compiler tower."
                          (language-default-environment from))))
         (let lp ((exps '()) (env #f)
                  (cenv (fluid-ref *compilation-environment*)))
-          (let ((x ((language-reader (current-language)) port)))
+          (let ((x ((language-reader (current-language)) port env)))
             (cond
              ((eof-object? x)
               (compile ((language-joiner joint) (reverse exps) env)

module/system/repl/command.scm

@@ -133,9 +133,13 @@
      (define (name repl)
        docstring
        (let* ((expression0
-               (with-fluid* current-reader
+               (repl-reader ""
-                            (language-reader (repl-language repl))
+                            (lambda args
-                 (lambda () (repl-reader ""))))
+                              (let ((port (if (pair? args)
+                                              (car args)
+                                              (current-input-port))))
+                                ((language-reader (repl-language repl))
+                                 port (current-module))))))
               ...)
          (apply (lambda datums b0 b1 ...)
                 (let ((port (open-input-string (read-line repl))))

module/system/repl/common.scm

@@ -61,7 +61,8 @@
           (module-name (current-module))))
 
 (define (repl-read repl)
-  ((language-reader (repl-language repl))))
+  ((language-reader (repl-language repl)) (current-input-port)
+                                          (current-module)))
 
 (define (repl-compile repl form . opts)
   (let ((to (lookup-language (cond ((memq #:e opts) 'scheme)

module/system/repl/repl.scm

@@ -32,29 +32,28 @@
 
 (define meta-command-token (cons 'meta 'command))
 
-(define (meta-reader read)
+(define (meta-reader read env)
   (lambda read-args
-    (with-input-from-port
+    (let ((port (if (pair? read-args) (car read-args) (current-input-port))))
-        (if (pair? read-args) (car read-args) (current-input-port))
+      (with-input-from-port port
-      (lambda ()
+        (lambda ()
-        (let ((ch (next-char #t)))
+          (let ((ch (next-char #t)))
-          (cond ((eof-object? ch)
+            (cond ((eof-object? ch)
-                 ;; apparently sometimes even if this is eof, read will
+                   ;; apparently sometimes even if this is eof, read will
-                 ;; wait on somethingorother. strange.
+                   ;; wait on somethingorother. strange.
-                 ch)
+                   ch)
-                ((eqv? ch #\,)
+                  ((eqv? ch #\,)
-                 (read-char)
+                   (read-char port)
-                 meta-command-token)
+                   meta-command-token)
-                (else (read))))))))
+                  (else (read port env)))))))))
         
 ;; repl-reader is a function defined in boot-9.scm, and is replaced by
 ;; something else if readline has been activated. much of this hoopla is
 ;; to be able to re-use the existing readline machinery.
 (define (prompting-meta-read repl)
-  (let ((prompt (lambda () (repl-prompt repl)))
+  (repl-reader (lambda () (repl-prompt repl))
-        (lread (language-reader (repl-language repl))))
+               (meta-reader (language-reader (repl-language repl))
-    (with-fluid* current-reader (meta-reader lread)
+                            (current-module))))
-      (lambda () (repl-reader prompt)))))
 
 (define (default-catch-handler . args)
   (pmatch args