* [PATCH 1/2] PRELIMINARY: psyntax: Remove uses of syntax-session-id.
2016-11-02 19:14 bug#20272: Support reproducible builds Jan Nieuwenhuizen
@ 2016-11-02 19:14 ` Jan Nieuwenhuizen
2016-11-02 19:14 ` [PATCH 2/2] psyntax: fix gen-label for unset module Jan Nieuwenhuizen
1 sibling, 0 replies; 3+ messages in thread
From: Jan Nieuwenhuizen @ 2016-11-02 19:14 UTC (permalink / raw)
To: guile-devel; +Cc: Mark H Weaver
From: Mark H Weaver <mhw@netris.org>
This is an attempted fix for <https://debbugs.gnu.org/20272>,
but I'm not yet confident in its correctness.
* module/ice-9/boot-9.scm (module-generate-unique-id!): New procedure.
(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.
---
module/ice-9/boot-9.scm | 25 +++++++++++++++++++++----
module/ice-9/psyntax-pp.scm | 15 +++++++++++++--
module/ice-9/psyntax.scm | 13 ++++++++++---
3 files changed, 44 insertions(+), 9 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 7f62097..f1d684d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
-;;;; 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
@@ -374,6 +374,12 @@ 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!
+ (let ((next-id 0))
+ (lambda (m)
+ (let ((i next-id))
+ (set! next-id (+ i 1))
+ i))))
(define (resolve-module . args)
#f)
@@ -1973,7 +1979,8 @@ written into the port is returned."
submodules
submodule-binder
public-interface
- filename)))
+ filename
+ next-unique-id)))
;; make-module &opt size uses binder
@@ -1997,7 +2004,7 @@ written into the port is returned."
(make-hash-table)
'()
(make-weak-key-hash-table 31) #f
- (make-hash-table 7) #f #f #f))
+ (make-hash-table 7) #f #f #f 0))
\f
@@ -2579,6 +2586,11 @@ written into the port is returned."
(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))
;; The root interface is a module that uses the same obarray as the
@@ -2607,6 +2619,11 @@ written into the port is returned."
the-root-module
(error "unexpected module to resolve during module boot" name)))
+(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.
;;
@@ -2936,7 +2953,7 @@ written into the port is returned."
#: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-table 31) #f
- (make-hash-table 0) #f #f #f)))
+ (make-hash-table 0) #f #f #f 0)))
(define (module-autoload! module . args)
"Have @var{module} automatically load the module named @var{name} when one
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index d797665..207d534 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -297,7 +297,12 @@
(values x (car w)))))
(gen-label
(lambda ()
- (string-append "l-" (session-id) (symbol->string (gensym "-")))))
+ (let ((mod (current-module)))
+ (simple-format
+ #f
+ "l-~s~s"
+ (module-generate-unique-id! mod)
+ (module-name mod)))))
(gen-labels
(lambda (ls)
(if (null? ls) '() (cons (gen-label) (gen-labels (cdr ls))))))
@@ -1001,7 +1006,13 @@
(lambda ()
(rebuild-macro-output
(p (source-wrap e (anti-mark w) s mod))
- (gensym (string-append "m-" (session-id) "-")))))))))
+ (let ((mod (current-module)))
+ (string->symbol
+ (simple-format
+ #f
+ "m-~s~s"
+ (module-generate-unique-id! mod)
+ (module-name mod)))))))))))
(expand-body
(lambda (body outer-form r w mod)
(let* ((r (cons '("placeholder" placeholder) r))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 88df4c7..8fa0ff3 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, 2015 Free Software Foundation, Inc.
+;;;; 2012, 2013, 2015, 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
@@ -632,7 +632,10 @@
;; 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 "-"))))
+ (let ((mod (current-module)))
+ (simple-format #f "l-~s~s"
+ (module-generate-unique-id! mod)
+ (module-name mod))))
(define gen-labels
(lambda (ls)
@@ -661,7 +664,11 @@
(cons 'shift (wrap-subst w)))))
(define-syntax-rule (new-mark)
- (gensym (string-append "m-" (session-id) "-")))
+ (let ((mod (current-module)))
+ (string->symbol
+ (simple-format #f "m-~s~s"
+ (module-generate-unique-id! mod)
+ (module-name mod)))))
;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for
;; internal definitions, in which the ribcages are built incrementally
--
2.10.1
^ permalink raw reply related [flat|nested] 3+ messages in thread