bug#20272: Support reproducible builds

[Ludovic Courtès]

address@hidden (Ludovic Courtès) skribis:

> address@hidden (Ludovic Courtès) skribis:
>
>> Jan Nieuwenhuizen <address@hidden> skribis:
>>
>>> I have been building quite some versions of Guile the past week.  There
>>> re a couple of .go files that keep giving me problems wrt
>>> nondeterminism:
>>>
>>>     web/server/http.go
>>>
>>> (define *timer* (gettimeofday)) seemed suspect, but seems harmless.
>>>
>>>     rnrs/arithmetic/fixnums.go
>>>
>>> make-implementation-restriction-violation seemed suspect, but commenting
>>> it out does not seem to help.
>>>
>>> After commenting out all of http.scm and fixnums.scm, yesterday I had 3
>>> Guix builds on two machines (GuixSD and one Ubuntu+Guix) that were
>>> bit-identical, but one build showed differences in
>>>
>>>     system/repl/commands.go
>>>
>>> Apparently most of the time this file builds deterministicly, but some
>>> times it does not!?  Ideas?
>>
>> Did you look at these differences with diffoscope?  That would be
>> useful.
>
> I built it with ‘guix build --rounds=2 -K’ and got 17 differing .go
> files.  I looked at srfi/srfi-9/gnu.go with ediff + hexl-mode in Emacs
> and found a dozen of “t-XYZ” and “tmp-XYZ” identifiers with a different
> value for XYZ (an integer).

To demonstrate non-reproducibility (with the attached patch, which is a
rebased version of Mark’s), just build the same module twice: once with
its dependency evaluated, and then with its dependency compiled.  The
results differ:

--8<---------------cut here---------------start------------->8---
address@hidden ~/src/guile$ rm -f module/srfi/srfi-9/gnu.go 
module/srfi/srfi-9.go
address@hidden ~/src/guile$ make -C module srfi/srfi-9/gnu.go
make: Entering directory '/home/ludo/src/guile/module'
  GUILEC srfi/srfi-9/gnu.go
wrote `srfi/srfi-9/gnu.go'
make: Leaving directory '/home/ludo/src/guile/module'
address@hidden ~/src/guile$ mv module/srfi/srfi-9/gnu.go{,.v1}
address@hidden ~/src/guile$ make -C module srfi/srfi-9.go
make: Entering directory '/home/ludo/src/guile/module'
  GUILEC srfi/srfi-9.go
wrote `srfi/srfi-9.go'
make: Leaving directory '/home/ludo/src/guile/module'
address@hidden ~/src/guile$ make -C module srfi/srfi-9/gnu.go
make: Entering directory '/home/ludo/src/guile/module'
  GUILEC srfi/srfi-9/gnu.go
wrote `srfi/srfi-9/gnu.go'
make: Leaving directory '/home/ludo/src/guile/module'
address@hidden ~/src/guile$ mv module/srfi/srfi-9/gnu.go{,.v2}
address@hidden ~/src/guile$ diff -u module/srfi/srfi-9/gnu.go.{v1,v2}
Ciferecaj dosieroj module/srfi/srfi-9/gnu.go.v1 kaj 
module/srfi/srfi-9/gnu.go.v2 estas malsamaj
--8<---------------cut here---------------end--------------->8---

In gnu.go.v2 the integers appended to generated symbols are lower
because fewer symbols had to be generated.

Ludo’.

>From 4301d4b53d7243012bbf6ee4d7558910dd712330 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Fri, 12 Feb 2016 11:19:38 -0500
Subject: [PATCH] psyntax: Remove uses of syntax-session-id.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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/psyntax-pp.scm: Regenerate.

Signed-off-by: Ludovic Courtès <address@hidden>
---
 module/ice-9/boot-9.scm     | 25 +++++++++++++++++++++----
 module/ice-9/psyntax-pp.scm | 15 +++++++++++++--
 module/ice-9/psyntax.scm    | 11 +++++++++--
 3 files changed, 43 insertions(+), 8 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 426d831..8ef7e5f 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
@@ -384,6 +384,12 @@ If there is no handler at all, Guile prints an error and 
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 (resolve-module . args)
   #f)
 
@@ -2021,7 +2027,8 @@ VALUE."
      submodules
      submodule-binder
      public-interface
-     filename)))
+     filename
+     next-unique-id)))
 
 
 ;; make-module &opt size uses binder
@@ -2049,7 +2056,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))
 
 

@@ -2656,6 +2663,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))
 
 ;; The root interface is a module that uses the same obarray as the
@@ -2684,6 +2696,11 @@ VALUE."
       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.
 ;;
@@ -3013,7 +3030,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-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 1ec5107..c81b69e 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -312,7 +312,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))))))
@@ -960,7 +965,13 @@
            ((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) "-")))))))
+             (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 79b353d..7d12469 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -642,7 +642,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)
@@ -671,7 +674,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.2