Merge gensym into symbol and add mutex for its counter.

diff --git a/src/runtime/ed-ffi.scm b/src/runtime/ed-ffi.scm
index 81a2a3b50f4314c75953d897a7dd919799a31bee..3f38ceed0ce47426449b3492f70919270c4412a6 100644 (file)
--- a/src/runtime/ed-ffi.scm
+++ b/src/runtime/ed-ffi.scm
@@ -79,7 +79,6 @@ USA.
     ("gdbm"    (runtime gdbm))
     ("gencache"        (runtime tagged-dispatch))
     ("genio"   (runtime generic-i/o-port))
-    ("gensym"  (runtime gensym))
     ("gentag"  (runtime tagged-dispatch))
     ("global"  (runtime miscellaneous-global))
     ("graphics"        (runtime graphics))

diff --git a/src/runtime/gensym.scm b/src/runtime/gensym.scm
deleted file mode 100644 (file)
index 3c6b424..0000000
--- a/src/runtime/gensym.scm
+++ /dev/null
@@ -1,59 +0,0 @@
-#| -*-Scheme-*-
-
-Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-    2017 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-|#
-
-;;;; Symbol Generation
-;;; package: (runtime gensym)
-
-(declare (usual-integrations))
-
-(define (generate-uninterned-symbol #!optional argument)
-  (let ((prefix
-        (cond ((or (default-object? argument) (not argument))
-               name-prefix)
-              ((string? argument)
-               argument)
-              ((symbol? argument)
-               (symbol->string argument))
-              ((exact-nonnegative-integer? argument)
-               (set! name-counter argument)
-               name-prefix)
-              (else
-               (error:wrong-type-argument argument "symbol or integer"
-                                          'GENERATE-UNINTERNED-SYMBOL)))))
-    (string->uninterned-symbol
-     (string-append prefix
-                   (number->string
-                    (let ((result name-counter))
-                      (set! name-counter (1+ name-counter))
-                      result))))))
-
-(define name-counter)
-(define name-prefix)
-
-(define (initialize-package!)
-  (set! name-counter 0)
-  (set! name-prefix "G")
-  unspecific)
\ No newline at end of file

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index ac06ee3aa4d77f6e6585e9838207a49bd5ac824b..8b9e56e5996fec6429398d53e6b23236d9032697 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -465,7 +465,6 @@ USA.
    (RUNTIME CHARACTER-SET)
    (RUNTIME LAMBDA-ABSTRACTION)
    (RUNTIME USTRING)
-   (RUNTIME GENSYM)
    (RUNTIME STREAM)
    (RUNTIME 2D-PROPERTY)
    (RUNTIME HASH-TABLE)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index e2ae82dc7ab5a4fb5d7fc18b2c6ba554b3010438..6d2b8e73a55addcddf264110c09f1b0946b7c426 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -755,6 +755,7 @@ USA.
          intern
          intern-soft
          interned-symbol?
+         generate-uninterned-symbol
          string->symbol
          string->uninterned-symbol
          symbol
@@ -2342,13 +2343,6 @@ USA.
   (export (runtime subprocess)
          make-generic-i/o-port))
 
-(define-package (runtime gensym)
-  (files "gensym")
-  (parent (runtime))
-  (export ()
-         generate-uninterned-symbol)
-  (initialization (initialize-package!)))
-
 (define-package (runtime global-database)
   (files "gdatab")
   (parent (runtime))

diff --git a/src/runtime/symbol.scm b/src/runtime/symbol.scm
index 4bc8787ef7d98f89ba92ef13eb80e7d930166c47..989a34584abd7765471969378a190c54b97af231 100644 (file)
--- a/src/runtime/symbol.scm
+++ b/src/runtime/symbol.scm
@@ -87,6 +87,37 @@ USA.
 (define (symbol>? x y)
   (string<? (symbol-name y) (symbol-name x)))
 \f
+(define generate-uninterned-symbol
+  (let ((mutex (make-thread-mutex))
+       (counter 0)
+       (default-prefix "G"))
+    (named-lambda (generate-uninterned-symbol #!optional argument)
+      (let ((finish
+            (lambda (prefix)
+              (string->uninterned-symbol
+               (string-append prefix
+                              (number->string
+                               (with-thread-mutex-lock mutex
+                                 (lambda ()
+                                   (let ((n counter))
+                                     (set! counter (+ counter 1))
+                                     n)))))))))
+       (cond ((or (default-object? argument) (not argument))
+              (finish default-prefix))
+             ((string? argument)
+              (finish argument))
+             ((symbol? argument)
+              (finish (symbol->string argument)))
+             ((exact-nonnegative-integer? argument)
+              (with-thread-mutex-lock mutex
+                (lambda ()
+                  (set! counter argument)
+                  unspecific))
+              (finish default-prefix))
+             (else
+              (error "Invalid argument to generate-uninterned-symbol:"
+                     argument)))))))
+\f
 (define-integrable (->bytes maybe-string)
   (object-new-type (ucode-type bytevector) maybe-string))