diff --git a/module/language/assembly/spec.scm b/module/language/assembly/spec.scm index 286c80511..9e34c4def 100644 --- a/module/language/assembly/spec.scm +++ b/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)) diff --git a/module/language/brainfuck/spec.scm b/module/language/brainfuck/spec.scm index a4ba60f82..9c4d0a880 100644 --- a/module/language/brainfuck/spec.scm +++ b/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 diff --git a/module/language/bytecode/spec.scm b/module/language/bytecode/spec.scm index 184565b04..b38b0911f 100644 --- a/module/language/bytecode/spec.scm +++ b/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)) diff --git a/module/language/ecmascript/spec.scm b/module/language/ecmascript/spec.scm index 7a1ea465c..dd4dc3c0f 100644 --- a/module/language/ecmascript/spec.scm +++ b/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 diff --git a/module/language/glil/spec.scm b/module/language/glil/spec.scm index d5291a211..7733d7bbe 100644 --- a/module/language/glil/spec.scm +++ b/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)) diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm index f88537f4d..c05236126 100644 --- a/module/language/scheme/spec.scm +++ b/module/language/scheme/spec.scm @@ -38,19 +38,18 @@ (define-language scheme #:title "Guile Scheme" #:version "0.5" - #:reader (lambda args - ;; Read using the compilation environment's current reader. - ;; Don't use the current module's `current-reader' because - ;; it might be set, e.g., to the REPL's reader, so we'd - ;; enter an infinite recursion. - ;; FIXME: Handle `read-options' as well. - (let* ((mod (current-compilation-environment)) - (cr (and (module? mod) - (module-ref mod 'current-reader))) - (read (if (and cr (fluid-ref cr)) - (fluid-ref cr) - read))) - (apply read args))) + #:reader (lambda (port env) + ;; Use the binding of current-reader from the environment. + ;; FIXME: Handle `read-options' as well? + ((or (and=> (and=> (module-variable + (cond ((pair? env) (car env)) + (env) + (else (current-module))) + 'current-reader) + variable-ref) + fluid-ref) + read) + port)) #:compilers `((tree-il . ,compile-tree-il)) #:decompilers `((tree-il . ,decompile-tree-il)) diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm index 2d24f7bf6..c47134ed8 100644 --- a/module/language/tree-il/spec.scm +++ b/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 diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index d1cb3bea7..11c23af3d 100644 --- a/module/system/base/compile.scm +++ b/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) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index d3d166076..66e2fb401 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -133,9 +133,13 @@ (define (name repl) docstring (let* ((expression0 - (with-fluid* current-reader - (language-reader (repl-language repl)) - (lambda () (repl-reader "")))) + (repl-reader "" + (lambda args + (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)))) diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index eac9610e7..8ea1c0bf6 100644 --- a/module/system/repl/common.scm +++ b/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) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index bdbf1ded8..a3496f3b8 100644 --- a/module/system/repl/repl.scm +++ b/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 - (if (pair? read-args) (car read-args) (current-input-port)) - (lambda () - (let ((ch (next-char #t))) - (cond ((eof-object? ch) - ;; apparently sometimes even if this is eof, read will - ;; wait on somethingorother. strange. - ch) - ((eqv? ch #\,) - (read-char) - meta-command-token) - (else (read)))))))) + (let ((port (if (pair? read-args) (car read-args) (current-input-port)))) + (with-input-from-port port + (lambda () + (let ((ch (next-char #t))) + (cond ((eof-object? ch) + ;; apparently sometimes even if this is eof, read will + ;; wait on somethingorother. strange. + ch) + ((eqv? ch #\,) + (read-char port) + meta-command-token) + (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))) - (lread (language-reader (repl-language repl)))) - (with-fluid* current-reader (meta-reader lread) - (lambda () (repl-reader prompt))))) + (repl-reader (lambda () (repl-prompt repl)) + (meta-reader (language-reader (repl-language repl)) + (current-module)))) (define (default-catch-handler . args) (pmatch args