From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Jan Nieuwenhuizen Newsgroups: gmane.lisp.guile.devel Subject: [PATCH 2/2] psyntax: fix gen-label for unset module. Date: Wed, 2 Nov 2016 20:14:50 +0100 Message-ID: <20161102191450.24080-3-janneke@gnu.org> References: <20161102191450.24080-1-janneke@gnu.org> NNTP-Posting-Host: blaine.gmane.org X-Trace: blaine.gmane.org 1478114153 5855 195.159.176.226 (2 Nov 2016 19:15:53 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 2 Nov 2016 19:15:53 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Nov 02 20:15:49 2016 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1c210U-00079w-G1 for guile-devel@m.gmane.org; Wed, 02 Nov 2016 20:15:30 +0100 Original-Received: from localhost ([::1]:57238 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1c210X-0004I8-9g for guile-devel@m.gmane.org; Wed, 02 Nov 2016 15:15:33 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:55354) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1c2101-0004DU-Dp for guile-devel@gnu.org; Wed, 02 Nov 2016 15:15:06 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1c20zz-0006xL-4k for guile-devel@gnu.org; Wed, 02 Nov 2016 15:15:01 -0400 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:38272) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1c20zy-0006xD-VG; Wed, 02 Nov 2016 15:14:58 -0400 Original-Received: from peder.onsbrabantnet.nl ([88.159.206.46]:39258 helo=localhost.localdomain) by fencepost.gnu.org with esmtpa (Exim 4.82) (envelope-from ) id 1c20zy-0008O0-Er; Wed, 02 Nov 2016 15:14:58 -0400 X-Mailer: git-send-email 2.10.1 In-Reply-To: <20161102191450.24080-1-janneke@gnu.org> X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.21 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" Xref: news.gmane.org gmane.lisp.guile.devel:18737 Archived-At: * module/ice-9/boot-9.scm (generate-unique-id!): New function. (module-generate-unique-id!): Use it. * module/ice-9/psyntax.scm (gen-label): Use it to cater for unset module. * module/ice-9/psyntax-pp.scm: Regenerate. --- module/ice-9/boot-9.scm | 3 ++- module/ice-9/psyntax-pp.scm | 2 +- module/ice-9/psyntax.scm | 6 ++++-- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index f1d684d..e18818e 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -374,12 +374,13 @@ a-cont (define (module-ref module sym) (let ((v (module-variable module sym))) (if v (variable-ref v) (error "badness!" (pk module) (pk sym))))) -(define module-generate-unique-id! +(define generate-unique-id! (let ((next-id 0)) (lambda (m) (let ((i next-id)) (set! next-id (+ i 1)) i)))) +(define module-generate-unique-id! generate-unique-id!) (define (resolve-module . args) #f) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 207d534..c47df7f 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -301,7 +301,7 @@ (simple-format #f "l-~s~s" - (module-generate-unique-id! mod) + (if mod (module-generate-unique-id! mod) (generate-unique-id! #f)) (module-name mod))))) (gen-labels (lambda (ls) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 8fa0ff3..7e5c863 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -634,8 +634,10 @@ (define (gen-label) (let ((mod (current-module))) (simple-format #f "l-~s~s" - (module-generate-unique-id! mod) - (module-name mod)))) + (if mod + (module-generate-unique-id! mod) + (generate-unique-id! #f)) + (module-name mod)))) (define gen-labels (lambda (ls) -- 2.10.1