From c5ce1d3ac0ccf76e0ceadf4980f2cd72379b31d8 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 12 Feb 2016 11:19:38 -0500 Subject: [PATCH] PRELIMINARY: psyntax: Remove uses of syntax-session-id. This is an attempted fix for , 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 872594b..1b1f185 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 @@ -381,6 +381,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) @@ -2018,7 +2024,8 @@ VALUE." submodules submodule-binder public-interface - filename))) + filename + next-unique-id))) ;; make-module &opt size uses binder @@ -2046,7 +2053,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)) @@ -2653,6 +2660,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 @@ -2681,6 +2693,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. ;; @@ -3010,7 +3027,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..b9110f7 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 @@ -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.6.3