From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: ludo@gnu.org (Ludovic =?iso-8859-1?Q?Court=E8s?=) Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Honor and confine expansion-time side-effects to `current-reader' Date: Mon, 17 Aug 2009 22:55:14 +0200 Message-ID: <87r5vaf9e5.fsf@gnu.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1250542631 29177 80.91.229.12 (17 Aug 2009 20:57:11 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 17 Aug 2009 20:57:11 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Mon Aug 17 22:57:04 2009 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1Md9GE-0007FW-AI for guile-devel@m.gmane.org; Mon, 17 Aug 2009 22:56:58 +0200 Original-Received: from localhost ([127.0.0.1]:47822 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Md9GD-0006hI-QC for guile-devel@m.gmane.org; Mon, 17 Aug 2009 16:56:57 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Md9FH-00068J-Lv for guile-devel@gnu.org; Mon, 17 Aug 2009 16:55:59 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1Md9FC-00065D-Nf for guile-devel@gnu.org; Mon, 17 Aug 2009 16:55:59 -0400 Original-Received: from [199.232.76.173] (port=49686 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Md9FC-000656-Fc for guile-devel@gnu.org; Mon, 17 Aug 2009 16:55:54 -0400 Original-Received: from lo.gmane.org ([80.91.229.12]:47687) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1Md9FB-0007tC-Hg for guile-devel@gnu.org; Mon, 17 Aug 2009 16:55:54 -0400 Original-Received: from list by lo.gmane.org with local (Exim 4.50) id 1Md9F2-0006cs-5V for guile-devel@gnu.org; Mon, 17 Aug 2009 22:55:44 +0200 Original-Received: from reverse-83.fdn.fr ([80.67.176.83]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Mon, 17 Aug 2009 22:55:44 +0200 Original-Received: from ludo by reverse-83.fdn.fr with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Mon, 17 Aug 2009 22:55:44 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 220 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: reverse-83.fdn.fr X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 30 Thermidor an 217 de la =?iso-8859-1?Q?R=E9volutio?= =?iso-8859-1?Q?n?= X-PGP-Key-ID: 0xEA52ECF4 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 821D 815D 902A 7EAB 5CEE D120 7FBA 3D4F EB1F 5364 X-OS: x86_64-unknown-linux-gnu User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.1 (gnu/linux) Cancel-Lock: sha1:pAyeh3lWpMAFNhabPt31P6K7tMo= X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.6 (newer, 3) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:9144 Archived-At: --=-=-= 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'. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0002-Honor-and-confine-expansion-time-side-effects-to-cu.patch Content-Description: the terrible patch >From d4e1ea92049ff8e2cd20184a0d3bd717ffa4b2ae Mon Sep 17 00:00:00 2001 From: =?utf-8?q?Ludovic=20Court=C3=A8s?= 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)) 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)) @@ -66,3 +70,32 @@ (beautify-user-module! m) (compile '(define round round) #:env m) (eq? round (module-ref m 'round))))) + + +(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 --=-=-=--