From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.devel Subject: Re: syntax-local-binding Date: Sun, 15 Jan 2012 18:22:06 +0100 Message-ID: <87zkdo7uf5.fsf@pobox.com> References: <874nvw99za.fsf@pobox.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1326648141 28242 80.91.229.12 (15 Jan 2012 17:22:21 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 15 Jan 2012 17:22:21 +0000 (UTC) To: guile-devel Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Jan 15 18:22:17 2012 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1RmTmb-0000pr-53 for guile-devel@m.gmane.org; Sun, 15 Jan 2012 18:22:17 +0100 Original-Received: from localhost ([::1]:50762 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RmTma-00081W-L8 for guile-devel@m.gmane.org; Sun, 15 Jan 2012 12:22:16 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:58784) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RmTmX-00080n-HL for guile-devel@gnu.org; Sun, 15 Jan 2012 12:22:14 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RmTmV-0004o1-TU for guile-devel@gnu.org; Sun, 15 Jan 2012 12:22:13 -0500 Original-Received: from a-pb-sasl-sd.pobox.com ([74.115.168.62]:53857 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RmTmV-0004ns-Q7 for guile-devel@gnu.org; Sun, 15 Jan 2012 12:22:11 -0500 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-sd.pobox.com (Postfix) with ESMTP id 33AE7871B for ; Sun, 15 Jan 2012 12:22:11 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to :subject:references:date:in-reply-to:message-id:mime-version :content-type; s=sasl; bh=c8OZBB/oGhpbLyKKd9w4yo+HU2E=; b=eRst6j ufEN6+xbaCwB2LKQtvhG8wAcePlQ6H86tRXF/jzrmnOUvS7buziGKyX55jqZdaJF mDUQYiKvMVmihREc7fSthvliujgRN6mgH8h2q/Ds9tMhf1Ww4BYMl7fk6AFoqDpn h6ngyTazhy7ljhCamnMb7icUq6l/asK2pAeCg= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:subject :references:date:in-reply-to:message-id:mime-version :content-type; q=dns; s=sasl; b=FxZZ7jnuXytSEhmgGB6aR1rWxr3IYMG9 qQj4gBNqQM8qUgR2rQ2PkmEpit1jBy36mr9wQMBYht5Fz7vMpH0ttvJVDxsxVOWE l9XBe3tSZ0deMxohY6q167KIL165gDuuhqQElghNhq6fbpsC+k+yjvAiG5ZVmgCp IF6EDSPNn5k= Original-Received: from a-pb-sasl-sd.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-sd.pobox.com (Postfix) with ESMTP id 2D9918719 for ; Sun, 15 Jan 2012 12:22:11 -0500 (EST) Original-Received: from badger (unknown [90.164.198.39]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by a-pb-sasl-sd.pobox.com (Postfix) with ESMTPSA id 61B908717 for ; Sun, 15 Jan 2012 12:22:10 -0500 (EST) In-Reply-To: <874nvw99za.fsf@pobox.com> (Andy Wingo's message of "Sun, 15 Jan 2012 18:00:41 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.3 (gnu/linux) X-Pobox-Relay-ID: 7522BDA4-3F9D-11E1-94D2-65B1DE995924-02397024!a-pb-sasl-sd.pobox.com X-detected-operating-system: by eggs.gnu.org: Solaris 10 (beta) X-Received-From: 74.115.168.62 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:13518 Archived-At: --=-=-= On Sun 15 Jan 2012 18:00, Andy Wingo writes: > Attached is a patch that implements a new accessor, > syntax-local-binding. Here 'tis! --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-add-syntax-local-binding.patch >From 09ba44abeb47cdf4ec61df6f7386217f0cbe30c7 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 15 Jan 2012 17:51:02 +0100 Subject: [PATCH] add syntax-local-binding * module/ice-9/boot-9.scm (syntax-local-binding): New binding. * module/ice-9/psyntax.scm: Locally define a fluid that holds the "transformer environment". with-transformer-environment calls a procedure with the transformer environment, or raises an error if called outside the extent of a transformer. Bind transformer-environment in expand-macro. (syntax-local-binding): New procedure to return binding information of a lexially bound identifier (a lexical, local macro, or pattern variable). --- module/ice-9/boot-9.scm | 1 + module/ice-9/psyntax.scm | 39 +++++++++++++++++++++++++++++++++++++-- 2 files changed, 38 insertions(+), 2 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index f661d08..9cdd8d1 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -389,6 +389,7 @@ If there is no handler at all, Guile prints an error and then exits." (define generate-temporaries #f) (define bound-identifier=? #f) (define free-identifier=? #f) +(define syntax-local-binding #f) ;; $sc-dispatch is an implementation detail of psyntax. It is used by ;; expanded macros, to dispatch an input against a set of patterns. diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 1bf3c32..dcabafe 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -786,6 +786,14 @@ id)))))) (else (syntax-violation 'id-var-name "invalid id" id))))) + (define transformer-environment + (make-fluid + (lambda (k) + (error "called outside the dynamic extent of a syntax transformer")))) + + (define (with-transformer-environment k) + ((fluid-ref transformer-environment) k)) + ;; free-id=? must be passed fully wrapped ids since (free-id=? x y) ;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not. @@ -1321,8 +1329,10 @@ (syntax-violation #f "encountered raw symbol in macro output" (source-wrap e w (wrap-subst w) mod) x)) (else (decorate-source x s))))) - (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod)) - (new-mark)))) + (with-fluids ((transformer-environment + (lambda (k) (k e r w s rib mod)))) + (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod)) + (new-mark))))) (define expand-body ;; In processing the forms of the body, we create a new, empty wrap. @@ -2435,6 +2445,31 @@ (set! syntax-source (lambda (x) (source-annotation x))) + (set! syntax-local-binding + (lambda (id) + (arg-check nonsymbol-id? id 'syntax-local-value) + (with-transformer-environment + (lambda (e r w s rib mod) + (define (strip-anti-mark w) + (let ((ms (wrap-marks w)) (s (wrap-subst w))) + (if (and (pair? ms) (eq? (car ms) the-anti-mark)) + ;; output is from original text + (make-wrap (cdr ms) (if rib (cons rib (cdr s)) (cdr s))) + ;; output introduced by macro + (error "what!!!")))) + (let ((label (id-var-name (syntax-object-expression id) + (strip-anti-mark (syntax-object-wrap id))))) + (if (not (string? label)) + (error "identifier not lexically bound" id)) + (let ((b (assq-ref r label))) + (if (not b) + (error "displaced lexical" id)) + (case (binding-type b) + ((lexical) (values 'lexical (binding-value b))) + ((macro) (values 'local-macro (binding-value b))) + ((syntax) (values 'pattern-variable (binding-value b))) + (else (error "unpossible!" b))))))))) + (set! generate-temporaries (lambda (ls) (arg-check list? ls 'generate-temporaries) -- 1.7.8.3 --=-=-= -- http://wingolog.org/ --=-=-=--