* [PATCH] Honor and confine expansion-time side-effects to `current-reader'
@ 2009-08-17 20:55 Ludovic Courtès
2009-09-20 22:44 ` Ludovic Courtès
0 siblings, 1 reply; 2+ messages in thread
From: Ludovic Courtès @ 2009-08-17 20:55 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 1185 bytes --]
Hi!
The attached patch allows expansion-time modifications of
`current-reader' to be taken into account. For example:
(define-macro (install-reader!)
(fluid-set! current-reader
(let ((first? #t))
(lambda args
(if first?
(begin
(set! first? #f)
''ok)
(read (open-input-string ""))))))
#f)
(install-reader!)
this-should-be-ignored
=> ok
This trick works with both the compiler and the interpreter. I intended
to use it in Skribilo.
Furthermore, the `current-reader' fluid used at compilation-time by
default is different from the one in the compiler. This is needed
because the REPL uses `current-reader' to install a wrapper around the
current language reader; when that language is Scheme, we enter an
infinite recursion if Scheme's reader honors `current-reader'.
The patch exposes the current compilation environment as a fluid, so
that language readers can look for the compile-time `current-reader'.
This is admittedly not very elegant, but I can't think of a better way.
Thanks,
Ludo'.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: the terrible patch --]
[-- Type: text/x-patch, Size: 6639 bytes --]
From d4e1ea92049ff8e2cd20184a0d3bd717ffa4b2ae Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 17 Aug 2009 22:28:54 +0200
Subject: [PATCH 2/2] Honor and confine expansion-time side-effects to `current-reader'.
* module/language/scheme/spec.scm (scheme)[#:reader]: Honor the
compilation environment's `current-reader'.
* module/system/base/compile.scm (*compilation-environment*): New
fluid.
(current-compilation-environment): New procedure.
(make-compilation-module): Provide a fresh `current-reader' fluid.
(read-and-compile): Set `*compilation-environment*' appropriately.
(compile): Likewise.
* test-suite/tests/compiler.test (read-and-compile): New.
("current-reader"): New test prefix.
---
module/language/scheme/spec.scm | 16 +++++++++++++++-
module/system/base/compile.scm | 23 ++++++++++++++++++++---
test-suite/tests/compiler.test | 35 ++++++++++++++++++++++++++++++++++-
3 files changed, 69 insertions(+), 5 deletions(-)
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
index df61858..f88537f 100644
--- a/module/language/scheme/spec.scm
+++ b/module/language/scheme/spec.scm
@@ -19,6 +19,7 @@
;;; Code:
(define-module (language scheme spec)
+ #:use-module (system base compile)
#:use-module (system base language)
#:use-module (language scheme compile-tree-il)
#:use-module (language scheme decompile-tree-il)
@@ -37,7 +38,20 @@
(define-language scheme
#:title "Guile Scheme"
#:version "0.5"
- #:reader read
+ #: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)))
+
#:compilers `((tree-il . ,compile-tree-il))
#:decompilers `((tree-il . ,decompile-tree-il))
#:evaluator (lambda (x module) (primitive-eval x))
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index f3557cb..8b0d88f 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -28,6 +28,7 @@
#:use-module (ice-9 receive)
#:export (syntax-error
*current-language*
+ current-compilation-environment
compiled-file-name compile-file compile-and-load
compile
decompile)
@@ -63,6 +64,12 @@
(define (current-language)
(fluid-ref *current-language*))
+(define *compilation-environment* (make-fluid))
+(define (current-compilation-environment)
+ "Return the current compilation environment (a module) or #f. This
+function should only be called from stages in the compiler tower."
+ (fluid-ref *compilation-environment*))
+
(define (call-once thunk)
(let ((entered #f))
(dynamic-wind
@@ -196,6 +203,12 @@
(let ((m (make-module)))
(beautify-user-module! m)
+
+ ;; Provide a separate `current-reader' fluid so that the Scheme language
+ ;; reader doesn't get to see the REPL's settings for `current-reader',
+ ;; which would lead to an infinite loop.
+ (module-define! m 'current-reader (make-fluid))
+
m))
(define (language-default-environment lang)
@@ -213,9 +226,12 @@
(let ((from (ensure-language from))
(to (ensure-language to)))
(let ((joint (find-language-joint from to)))
- (with-fluids ((*current-language* from))
+ (with-fluids ((*current-language* from)
+ (*compilation-environment*
+ (or env
+ (language-default-environment from))))
(let lp ((exps '()) (env #f)
- (cenv (or env (language-default-environment from))))
+ (cenv (fluid-ref *compilation-environment*)))
(let ((x ((language-reader (current-language)) port)))
(cond
((eof-object? x)
@@ -245,7 +261,8 @@
(receive (exp env cenv)
(let ((env (or env (language-default-environment from))))
- (compile-fold (compile-passes from to opts) x env opts))
+ (with-fluids ((*compilation-environment* env))
+ (compile-fold (compile-passes from to opts) x env opts)))
exp))
\f
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index 2eb0e78..ed6f033 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -18,7 +18,11 @@
(define-module (test-suite tests compiler)
:use-module (test-suite lib)
:use-module (test-suite guile-test)
- :use-module (system base compile))
+ :use-module (system base compile)
+ :use-module ((system vm vm) #:select (the-vm vm-load)))
+
+(define read-and-compile
+ (@@ (system base compile) read-and-compile))
\f
@@ -66,3 +70,32 @@
(beautify-user-module! m)
(compile '(define round round) #:env m)
(eq? round (module-ref m 'round)))))
+
+\f
+(with-test-prefix "current-reader"
+
+ (pass-if "default compile-time current-reader differs"
+ (not (eq? (compile 'current-reader)
+ current-reader)))
+
+ (pass-if "compile-time changes are honored and isolated"
+ ;; Make sure changing `current-reader' as the side-effect of a defmacro
+ ;; actually works.
+ (let ((r (fluid-ref current-reader))
+ (input (open-input-string
+ "(define-macro (install-reader!)
+ ;;(format #t \"current-reader = ~A~%\" current-reader)
+ (fluid-set! current-reader
+ (let ((first? #t))
+ (lambda args
+ (if first?
+ (begin
+ (set! first? #f)
+ ''ok)
+ (read (open-input-string \"\"))))))
+ #f)
+ (install-reader!)
+ this-should-be-ignored")))
+ (and (eq? (vm-load (the-vm) (read-and-compile input))
+ 'ok)
+ (eq? r (fluid-ref current-reader))))))
--
1.6.1.3
^ permalink raw reply related [flat|nested] 2+ messages in thread
end of thread, other threads:[~2009-09-20 22:44 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2009-08-17 20:55 [PATCH] Honor and confine expansion-time side-effects to `current-reader' Ludovic Courtès
2009-09-20 22:44 ` Ludovic Courtès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).