From a52fe09b584a99ff39997c47c5aa7f4c0ca428db Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 12 Feb 2016 11:19:38 -0500 Subject: [PATCH 1/2] 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 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