From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: ludo@gnu.org (Ludovic =?UTF-8?Q?Court=C3=A8s?=) Newsgroups: gmane.lisp.guile.bugs Subject: bug#20272: Support reproducible builds Date: Thu, 22 Dec 2016 00:53:20 +0100 Message-ID: <871sx0vnyn.fsf@gnu.org> References: <87bmxxnjd7.fsf@gnu.org> <87shqtwxcb.fsf@gnu.org> <87twa6iikd.fsf@gnu.org> <87vaumgk80.fsf@gnu.org> <87mvfygjs1.fsf@gnu.org> <87eg12fbog.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1482364519 25934 195.159.176.226 (21 Dec 2016 23:55:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 21 Dec 2016 23:55:19 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.1 (gnu/linux) Cc: 20272@debbugs.gnu.org, Andy Wingo To: Jan Nieuwenhuizen Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Thu Dec 22 00:55:14 2016 Return-path: Envelope-to: guile-bugs@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 1cJqj0-0005u2-Pr for guile-bugs@m.gmane.org; Thu, 22 Dec 2016 00:55:11 +0100 Original-Received: from localhost ([::1]:59657 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cJqj5-0002Xt-CP for guile-bugs@m.gmane.org; Wed, 21 Dec 2016 18:55:15 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:49562) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cJqiv-0002Ul-Jw for bug-guile@gnu.org; Wed, 21 Dec 2016 18:55:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cJqis-0000xi-CU for bug-guile@gnu.org; Wed, 21 Dec 2016 18:55:05 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:35317) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cJqis-0000xb-80 for bug-guile@gnu.org; Wed, 21 Dec 2016 18:55:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cJqis-0004BF-1H for bug-guile@gnu.org; Wed, 21 Dec 2016 18:55:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: ludo@gnu.org (Ludovic =?UTF-8?Q?Court=C3=A8s?=) Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Wed, 21 Dec 2016 23:55:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 20272 X-GNU-PR-Package: guile X-GNU-PR-Keywords: patch Original-Received: via spool by 20272-submit@debbugs.gnu.org id=B20272.148236448616041 (code B ref 20272); Wed, 21 Dec 2016 23:55:01 +0000 Original-Received: (at 20272) by debbugs.gnu.org; 21 Dec 2016 23:54:46 +0000 Original-Received: from localhost ([127.0.0.1]:50716 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cJqib-0004Af-Id for submit@debbugs.gnu.org; Wed, 21 Dec 2016 18:54:46 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:58506) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cJqiZ-0004AQ-RO for 20272@debbugs.gnu.org; Wed, 21 Dec 2016 18:54:44 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cJqiR-0000on-Kq for 20272@debbugs.gnu.org; Wed, 21 Dec 2016 18:54:38 -0500 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:56341) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cJqhI-0000Dr-ND; Wed, 21 Dec 2016 18:53:24 -0500 Original-Received: from reverse-83.fdn.fr ([80.67.176.83]:35652 helo=pluto) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1cJqhG-0006vh-La; Wed, 21 Dec 2016 18:53:24 -0500 In-Reply-To: <87eg12fbog.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Wed, 21 Dec 2016 00:00:47 +0100") X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.org gmane.lisp.guile.bugs:8483 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable With the attached patch I can build =E2=80=98stable-2.0=E2=80=99 with --rou= nds=3D2 and there are no discrepancies. I=E2=80=99ll apply it next week if there are no objections. Next I=E2=80=99ll adjust it for =E2=80=98master=E2=80=99. Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-psyntax-Generate-identifiers-in-a-deterministic-fash.patch Content-Transfer-Encoding: quoted-printable Content-Description: the patch >From 33ac270ad8d6f2fbb7fcb07294d1149aa82caf9e Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 12 Feb 2016 11:19:38 -0500 Subject: [PATCH] psyntax: Generate identifiers in a deterministic fashion. MIME-Version: 1.0 Content-Type: text/plain; charset=3DUTF-8 Content-Transfer-Encoding: 8bit Fixes . * module/ice-9/boot-9.scm (module-generate-unique-id!) (module-gensym): New procedures. (module): Add 'next-unique-id' field. (the-root-module): Inherit 'next-unique-id' value from early stub. (make-module, make-autoload-interface): Adjust calls to module-constructor. * module/ice-9/psyntax.scm (gen-label, new-mark): Generate unique identifiers from the module name and the per-module unique-id. (build-lexical-var, generate-temporaries): Use 'module-gensym' instead of 'gensym'. * module/ice-9/psyntax-pp.scm: Regenerate. * module/language/tree-il/fix-letrec.scm (fix-letrec!): Use 'module-gensym' instead of 'gensym'. * module/system/base/syntax.scm (define-record): Likewise. (transform-record): Likewise. Co-authored-by: Ludovic Court=C3=A8s --- module/ice-9/boot-9.scm | 42 +++++++++++++++-- module/ice-9/psyntax-pp.scm | 83 +++++++++++++++++++++---------= ---- module/ice-9/psyntax.scm | 15 +++--- module/language/tree-il/fix-letrec.scm | 6 ++- module/system/base/syntax.scm | 8 ++-- 5 files changed, 106 insertions(+), 48 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 426d831..7f35325 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1,6 +1,6 @@ ;;; -*- mode: scheme; coding: utf-8; -*- =20 -;;;; Copyright (C) 1995-2014 Free Software Foundation, Inc. +;;;; Copyright (C) 1995-2014, 2016 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 @@ -384,6 +384,13 @@ If there is no handler at all, Guile prints an error a= nd then exits." (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! + (let ((next-id 0)) + (lambda (m) + (let ((i next-id)) + (set! next-id (+ i 1)) + i)))) +(define module-gensym gensym) (define (resolve-module . args) #f) =20 @@ -2021,7 +2028,8 @@ VALUE." submodules submodule-binder public-interface - filename))) + filename + next-unique-id))) =20 =20 ;; make-module &opt size uses binder @@ -2049,7 +2057,7 @@ VALUE." (make-hash-table %default-import-size) '() (make-weak-key-hash-table 31) #f - (make-hash-table 7) #f #f #f)) + (make-hash-table 7) #f #f #f 0)) =20 =20 @@ -2656,6 +2664,11 @@ VALUE." (let ((m (make-module 0))) (set-module-obarray! m (%get-pre-modules-obarray)) (set-module-name! m '(guile)) + + ;; Inherit next-unique-id from preliminary stub of + ;; %module-get-next-unique-id! defined above. + (set-module-next-unique-id! m (module-generate-unique-id! #f)) + m)) =20 ;; The root interface is a module that uses the same obarray as the @@ -2684,6 +2697,11 @@ VALUE." the-root-module (error "unexpected module to resolve during module boot" name))) =20 +(define (module-generate-unique-id! m) + (let ((i (module-next-unique-id m))) + (set-module-next-unique-id! m (+ i 1)) + i)) + ;; Cheat. These bindings are needed by modules.c, but we don't want ;; to move their real definition here because that would be unnatural. ;; @@ -2714,6 +2732,21 @@ VALUE." (nested-define-module! (resolve-module '() #f) name mod) (accessor mod)))))) =20 +(define* (module-gensym #:optional (id " mg") (m (current-module))) + "Return a fresh symbol in the context of module M, based on ID (a +string or symbol). As long as M is a valid module, this procedure is +deterministic." + (define (->string number) + (number->string number 16)) + + (if m + (string->symbol + (string-append id "-" + (->string (hash (module-name m) most-positive-fixnum= )) + "-" + (->string (module-generate-unique-id! m)))) + (gensym id))) + (define (make-modules-in module name) (or (nested-ref-module module name) (let ((m (make-module 31))) @@ -3013,7 +3046,7 @@ VALUE." #:warning "Failed to autoload ~a in ~a:\n" sym name)))) (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f (make-hash-table 0) '() (make-weak-value-hash-tabl= e 31) #f - (make-hash-table 0) #f #f #f))) + (make-hash-table 0) #f #f #f 0))) =20 (define (module-autoload! module . args) "Have @var{module} automatically load the module named @var{name} when o= ne @@ -4305,7 +4338,6 @@ when none is available, reading FILE-NAME with READER= ." syntax-locally-bound-identifiers syntax-session-id))) =20 - =20 ;;; Place the user in the guile-user module. diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 1ec5107..3df661d 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -310,9 +310,7 @@ (syntax-object-expression x) (join-marks (car w) (car (syntax-object-wrap x)))) (values x (car w))))) - (gen-label - (lambda () - (string-append "l-" (session-id) (symbol->string (gensym "-"))))) + (gen-label (lambda () (symbol->string (module-gensym "l")))) (gen-labels (lambda (ls) (if (null? ls) '() (cons (gen-label) (gen-labels (cdr ls)))))) @@ -960,7 +958,7 @@ ((transformer-environment (lambda (k) (k e r w s rib mod)))) (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod)) - (gensym (string-append "m-" (session-id) "-"))))))) + (module-gensym "m")))))) (expand-body (lambda (body outer-form r w mod) (let* ((r (cons '("placeholder" placeholder) r)) @@ -1472,7 +1470,8 @@ s mod get-formals - (map (lambda (tmp-2 tmp-1 tmp) (co= ns tmp (cons tmp-1 tmp-2))) + (map (lambda (tmp-bde397a-a85 tmp-= bde397a-a84 tmp-bde397a-a83) + (cons tmp-bde397a-a83 (cons= tmp-bde397a-a84 tmp-bde397a-a85))) e2* e1* args*))) @@ -1504,7 +1503,7 @@ (gen-var (lambda (id) (let ((id (if (syntax-object? id) (syntax-object-expression id) id)= )) - (gensym (string-append (symbol->string id) "-"))))) + (module-gensym (symbol->string id))))) (lambda-var-list (lambda (vars) (let lvl ((vars vars) (ls '()) (w '(()))) @@ -1766,7 +1765,8 @@ (apply (lambda (args e1 e2) (build-it '() - (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons tmp-= 1 tmp-2))) + (map (lambda (tmp-bde397a-c50 tmp-bde397a-c4f tmp-b= de397a-c4e) + (cons tmp-bde397a-c4e (cons tmp-bde397a-c4f = tmp-bde397a-c50))) e2 e1 args))) @@ -1778,7 +1778,8 @@ (apply (lambda (docstring args e1 e2) (build-it (list (cons 'documentation (syntax->datum docst= ring))) - (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons = tmp-1 tmp-2))) + (map (lambda (tmp-bde397a-c66 tmp-bde397a-c65 t= mp-bde397a-c64) + (cons tmp-bde397a-c64 (cons tmp-bde397a-= c65 tmp-bde397a-c66))) e2 e1 args))) @@ -1801,7 +1802,8 @@ (apply (lambda (args e1 e2) (build-it '() - (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons tmp-= 1 tmp-2))) + (map (lambda (tmp-bde397a-c86 tmp-bde397a-c85 tmp-b= de397a-c84) + (cons tmp-bde397a-c84 (cons tmp-bde397a-c85 = tmp-bde397a-c86))) e2 e1 args))) @@ -1813,7 +1815,8 @@ (apply (lambda (docstring args e1 e2) (build-it (list (cons 'documentation (syntax->datum docst= ring))) - (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons = tmp-1 tmp-2))) + (map (lambda (tmp-bde397a-c9c tmp-bde397a-c9b t= mp-bde397a-c9a) + (cons tmp-bde397a-c9a (cons tmp-bde397a-= c9b tmp-bde397a-c9c))) e2 e1 args))) @@ -2329,7 +2332,7 @@ (if (not (list? x)) (syntax-violation 'generate-temporaries "invalid argument" x))) (let ((mod (cons 'hygiene (module-name (current-module))))) - (map (lambda (x) (wrap (gensym "t-") '((top)) mod)) ls)))) + (map (lambda (x) (wrap (module-gensym "t") '((top)) mod)) ls)))) (set! free-identifier=3D? (lambda (x y) (let ((x x)) @@ -2699,7 +2702,8 @@ #f k '() - (map (lambda (tmp-2 tmp-1 tmp) (list (cons tmp tm= p-1) tmp-2)) + (map (lambda (tmp-bde397a-10fd tmp-bde397a-10fc t= mp-bde397a-10fb) + (list (cons tmp-bde397a-10fb tmp-bde397a-1= 0fc) tmp-bde397a-10fd)) template pattern keyword))) @@ -2715,7 +2719,8 @@ #f k (list docstring) - (map (lambda (tmp-2 tmp-1 tmp) (list (cons tm= p tmp-1) tmp-2)) + (map (lambda (tmp-bde397a-2 tmp-bde397a-1 tmp= -bde397a) + (list (cons tmp-bde397a tmp-bde397a-1)= tmp-bde397a-2)) template pattern keyword))) @@ -2730,7 +2735,8 @@ dots k '() - (map (lambda (tmp-2 tmp-1 tmp) (list (con= s tmp tmp-1) tmp-2)) + (map (lambda (tmp-bde397a-112f tmp-bde397= a-112e tmp-bde397a-112d) + (list (cons tmp-bde397a-112d tmp-b= de397a-112e) tmp-bde397a-112f)) template pattern keyword))) @@ -2746,7 +2752,8 @@ dots k (list docstring) - (map (lambda (tmp-2 tmp-1 tmp) (list = (cons tmp tmp-1) tmp-2)) + (map (lambda (tmp-bde397a-114e tmp-bd= e397a-114d tmp-bde397a-114c) + (list (cons tmp-bde397a-114c t= mp-bde397a-114d) tmp-bde397a-114e)) template pattern keyword))) @@ -2865,7 +2872,9 @@ (apply (lambda (p) (if (=3D lev 0) (quasilist* - (map (lambda (tm= p) (list "value" tmp)) p) + (map (lambda (tm= p-bde397a-11b3) + (list "va= lue" tmp-bde397a-11b3)) + p) (quasi q lev)) (quasicons (quasicons @@ -2883,7 +2892,9 @@ (apply (lambda (p) (if (=3D lev 0) (quasiappend - (map (lambda= (tmp) (list "value" tmp)) p) + (map (lambda= (tmp-bde397a-11b8) + (list= "value" tmp-bde397a-11b8)) + p) (quasi q lev= )) (quasicons (quasicons @@ -2916,7 +2927,9 @@ (if tmp (apply (lambda (p) (if (=3D lev 0) - (quasilist* (map (lambda (tmp) = (list "value" tmp)) p) (vquasi q lev)) + (quasilist* + (map (lambda (tmp-bde397a-11c= e) (list "value" tmp-bde397a-11ce)) p) + (vquasi q lev)) (quasicons (quasicons '("quote" #(syntax-object u= nquote ((top)) (hygiene guile))) @@ -2932,7 +2945,7 @@ (apply (lambda (p) (if (=3D lev 0) (quasiappend - (map (lambda (tmp) (list = "value" tmp)) p) + (map (lambda (tmp-bde397a= -11d3) (list "value" tmp-bde397a-11d3)) p) (vquasi q lev)) (quasicons (quasicons @@ -3020,7 +3033,7 @@ (let ((tmp-1 ls)) (let ((tmp ($sc-dispatch tmp-1 'each-any))) (if tmp - (apply (lambda (t) (cons "vector" t)) = tmp) + (apply (lambda (t-bde397a-121c) (cons = "vector" t-bde397a-121c)) tmp) (syntax-violation #f "source expression failed to match a= ny pattern" @@ -3028,7 +3041,8 @@ (let ((tmp y)) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") each= -any)))) (if tmp-1 - (apply (lambda (y) (k (map (lambda (tmp) (list "q= uote" tmp)) y))) + (apply (lambda (y) + (k (map (lambda (tmp-bde397a) (list "quo= te" tmp-bde397a)) y))) tmp-1) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") .= each-any)))) (if tmp-1 @@ -3037,7 +3051,8 @@ (if tmp-1 (apply (lambda (y z) (f z (lambda (ls) (k= (append y ls))))) tmp-1) (let ((else tmp)) - (let ((tmp x)) (let ((t tmp)) (list "li= st->vector" t))))))))))))))))) + (let ((tmp x)) + (let ((t-bde397a tmp)) (list "list->v= ector" t-bde397a))))))))))))))))) (emit (lambda (x) (let ((tmp x)) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") any)))) @@ -3050,7 +3065,8 @@ (let ((tmp-1 (map emit x))) (let ((tmp ($sc-dispatch tmp-1 'each-a= ny))) (if tmp - (apply (lambda (t) (cons '#(syntax= -object list ((top)) (hygiene guile)) t)) + (apply (lambda (t-bde397a) + (cons '#(syntax-object li= st ((top)) (hygiene guile)) t-bde397a)) tmp) (syntax-violation #f @@ -3066,8 +3082,10 @@ (let ((tmp-1 (list (emit (car x*= )) (f (cdr x*))))) (let ((tmp ($sc-dispatch tmp-1= '(any any)))) (if tmp - (apply (lambda (t-1 t) - (list '#(syntax-o= bject cons ((top)) (hygiene guile)) t-1 t)) + (apply (lambda (t-bde397a-= 125a t-bde397a) + (list '#(syntax-o= bject cons ((top)) (hygiene guile)) + t-bde397a-1= 25a + t-bde397a)) tmp) (syntax-violation #f @@ -3080,8 +3098,9 @@ (let ((tmp-1 (map emit x))) (let ((tmp ($sc-dispatch tmp-1= 'each-any))) (if tmp - (apply (lambda (t) - (cons '#(syntax-o= bject append ((top)) (hygiene guile)) t)) + (apply (lambda (t-bde397a) + (cons '#(syntax-o= bject append ((top)) (hygiene guile)) + t-bde397a)) tmp) (syntax-violation #f @@ -3094,8 +3113,9 @@ (let ((tmp-1 (map emit x))) (let ((tmp ($sc-dispatch t= mp-1 'each-any))) (if tmp - (apply (lambda (t) - (cons '#(synt= ax-object vector ((top)) (hygiene guile)) t)) + (apply (lambda (t-bde3= 97a) + (cons '#(synt= ax-object vector ((top)) (hygiene guile)) + t-bde39= 7a)) tmp) (syntax-violation #f @@ -3106,8 +3126,9 @@ (if tmp-1 (apply (lambda (x) (let ((tmp (emit x))) - (let ((t tmp)) - (list '#(syntax-obje= ct list->vector ((top)) (hygiene guile)) t)))) + (let ((t-bde397a-127e = tmp)) + (list '#(syntax-obje= ct list->vector ((top)) (hygiene guile)) + t-bde397a-127e= )))) tmp-1) (let ((tmp-1 ($sc-dispatch tmp '(= #(atom "value") any)))) (if tmp-1 diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 79b353d..c09a551 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -1,7 +1,7 @@ ;;;; -*-scheme-*- ;;;; ;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011, -;;;; 2012, 2013 Free Software Foundation, Inc. +;;;; 2012, 2013, 2016 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 @@ -460,9 +460,10 @@ (make-letrec src in-order? ids vars val-exps body-exp))))) =20 =20 - ;; FIXME: use a faster gensym (define-syntax-rule (build-lexical-var src id) - (gensym (string-append (symbol->string id) "-"))) + ;; Use a per-module counter instead of the global counter of + ;; 'gensym' so that the generated identifier is reproducible. + (module-gensym (symbol->string id))) =20 (define-structure (syntax-object expression wrap module)) =20 @@ -642,7 +643,7 @@ ;; labels must be comparable with "eq?", have read-write invariance, ;; and distinct from symbols. (define (gen-label) - (string-append "l-" (session-id) (symbol->string (gensym "-")))) + (symbol->string (module-gensym "l"))) =20 (define gen-labels (lambda (ls) @@ -671,7 +672,7 @@ (cons 'shift (wrap-subst w))))) =20 (define-syntax-rule (new-mark) - (gensym (string-append "m-" (session-id) "-"))) + (module-gensym "m")) =20 ;; make-empty-ribcage and extend-ribcage maintain list-based ribcages = for ;; internal definitions, in which the ribcages are built incrementally @@ -2591,7 +2592,9 @@ (lambda (ls) (arg-check list? ls 'generate-temporaries) (let ((mod (cons 'hygiene (module-name (current-module))))) - (map (lambda (x) (wrap (gensym "t-") top-wrap mod)) ls)))) + (map (lambda (x) + (wrap (module-gensym "t") top-wrap mod)) + ls)))) =20 (set! free-identifier=3D? (lambda (x y) diff --git a/module/language/tree-il/fix-letrec.scm b/module/language/tree-= il/fix-letrec.scm index 60c87e3..23d37a8 100644 --- a/module/language/tree-il/fix-letrec.scm +++ b/module/language/tree-il/fix-letrec.scm @@ -1,6 +1,6 @@ ;;; transformation of letrec into simpler forms =20 -;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2011, 2012, 2016 Free Software Foundation, In= c. =20 ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -267,7 +267,9 @@ ;; bindings, in a `let' to indicate that order doesn't ;; matter, and bind to their variables. (list - (let ((tmps (map (lambda (x) (gensym)) c))) + (let ((tmps (map (lambda (x) + (module-gensym "fixlr")) + c))) (make-let #f (map cadr c) tmps (map caddr c) (make-sequence diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm index 249961d..d280869 100644 --- a/module/system/base/syntax.scm +++ b/module/system/base/syntax.scm @@ -1,6 +1,6 @@ ;;; Guile VM specific syntaxes and utilities =20 -;; Copyright (C) 2001, 2009 Free Software Foundation, Inc +;; Copyright (C) 2001, 2009, 2016 Free Software Foundation, Inc =20 ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -72,7 +72,7 @@ '() (cons (car slots) (lp (cdr slots)))))) (opts (list-tail slots (length reqs))) - (tail (gensym))) + (tail (module-gensym "defrec"))) `(define (,(symbol-append 'make- stem) ,@reqs . ,tail) (let ,(map (lambda (o) `(,(car o) (cond ((null? ,tail) ,(cadr o)) @@ -243,8 +243,8 @@ ;; code looks good. =20 (define-macro (transform-record type-and-common record . clauses) - (let ((r (gensym)) - (rtd (gensym)) + (let ((r (module-gensym "rec")) + (rtd (module-gensym "rtd")) (type-stem (trim-brackets (car type-and-common)))) (define (make-stem s) (symbol-append type-stem '- s)) --=20 2.10.2 --=-=-=--