guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH 1/2] PRELIMINARY: psyntax: Remove uses of syntax-session-id.


From: Jan Nieuwenhuizen
Subject: [PATCH 1/2] PRELIMINARY: psyntax: Remove uses of syntax-session-id.
Date: Wed, 2 Nov 2016 20:14:49 +0100

From: Mark H Weaver <address@hidden>

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))
 
 
 
@@ -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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]