Implement new-make-define-structure-type without the obsolete argument.

Temporarily preserve make-define-structure-type which ignores the arg.

diff --git a/src/edwin/clscon.scm b/src/edwin/clscon.scm
index 0494d93758186ab985adb4c993c0db223fcc98f8..a6f2bce99107f8b4001dc6a6af0cd1ab1557ae25 100644 (file)
--- a/src/edwin/clscon.scm
+++ b/src/edwin/clscon.scm
@@ -51,13 +51,12 @@ USA.
                                       (and superclass
                                            (class-methods superclass))))))
               (named-structure/set-tag-description! class
-                (make-define-structure-type
+                (new-make-define-structure-type
                  'VECTOR
                  name
                  (list->vector (map car transforms))
                  (list->vector (map cdr transforms))
                  (make-vector (length transforms) (lambda () #f))
-                 (standard-print-method name)
                  class
                  object-size))
               class))))

diff --git a/src/runtime/defstr.scm b/src/runtime/defstr.scm
index cde702564204303166823ee09c410560024ac302..dbe67a64b1d4fa6f096b67dc7d0238f5b2a7eb82 100644 (file)
--- a/src/runtime/defstr.scm
+++ b/src/runtime/defstr.scm
@@ -811,15 +811,12 @@ differences:
                                    `',name))
                              field-names
                              inits)))
-              `(,(absolute 'make-define-structure-type context)
+              `(,(absolute 'new-make-define-structure-type context)
                 ',(structure/physical-type structure)
                 ',name
                 '#(,@field-names)
                 '#(,@(map slot/index slots))
                 (vector ,@inits)
-                ;; This field was the print-procedure, no longer used.
-                ;; It should be removed after 9.3 is released.
-                #f
                 ,(if (and tag-expression
                           (not (eq? tag-expression type-name)))
                      (close tag-expression context)

diff --git a/src/runtime/random.scm b/src/runtime/random.scm
index 71d1651058c202a675778ab671b16c7acbb38afd..3ed4509c28c8bcdea0374c1e9ab6e63d200c9527 100644 (file)
--- a/src/runtime/random.scm
+++ b/src/runtime/random.scm
@@ -520,11 +520,10 @@ USA.
     (lambda ()
       (random-source-randomize! default-random-source)))
   (named-structure/set-tag-description! random-state-tag
-    (make-define-structure-type 'vector
-                               'random-state
-                               '#(key)
-                               '#(1)
-                               (make-vector 1 (lambda () #f))
-                               #f
-                               random-state-tag
-                               2)))
\ No newline at end of file
+    (new-make-define-structure-type 'vector
+                                   'random-state
+                                   '#(key)
+                                   '#(1)
+                                   (make-vector 1 (lambda () #f))
+                                   random-state-tag
+                                   2)))
\ No newline at end of file

diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index e2e7bc8cb5c7f8660790d5493a4b3aa351503707..01df9a4c2bb318bfb34f601159f80e7e46e3fcf6 100644 (file)
--- a/src/runtime/record.scm
+++ b/src/runtime/record.scm
@@ -564,7 +564,8 @@ USA.
 ;;;; Runtime support for DEFINE-STRUCTURE
 
 (define rtd:structure-type)
-(define make-define-structure-type)
+;; RELNOTE: rename without "new-"
+(define new-make-define-structure-type)
 (define structure-type?)
 (define structure-type/physical-type)
 (define structure-type/name)
@@ -579,9 +580,8 @@ USA.
    (set! rtd:structure-type
         (make-record-type "structure-type"
                           '(physical-type name field-names field-indexes
-                                          default-inits unparser-method tag
-                                          length)))
-   (set! make-define-structure-type
+                                          default-inits tag length)))
+   (set! new-make-define-structure-type
         (record-constructor rtd:structure-type))
    (set! structure-type?
         (record-predicate rtd:structure-type))
@@ -601,6 +601,13 @@ USA.
         (record-accessor rtd:structure-type 'length))
    unspecific))
 
+;; RELNOTE: delete
+(define (make-define-structure-type physical-type name field-names field-indexes
+                                   default-inits unparser-method tag length)
+  (declare (ignore unparser-method))
+  (new-make-define-structure-type physical-type name field-names field-indexes
+                                 default-inits tag length))
+
 (define-integrable (structure-type/field-index type field-name)
   (vector-ref (structure-type/field-indexes type)
              (structure-type/field-name-index type field-name)))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 5b29ff5e782141e437eeb89bee4bbf63d6f78696..0b7f6fa647c97f20fa58096c946e14111f1686b8 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3824,6 +3824,7 @@ USA.
          named-list?
          named-structure?
          named-vector?
+         new-make-define-structure-type ;RELNOTE: rename without "new-"
          record-accessor
          record-applicator
          record-constructor

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 3fb29d404e59691df765cbf89369b8b1b43b4925..4a95f832280eee706ee96c2cbd17fc9dc365fdff 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -145,23 +145,21 @@ USA.
   (add-event-receiver! event:after-restore reset-threads!)
   (add-event-receiver! event:before-exit stop-thread-timer)
   (named-structure/set-tag-description! thread-mutex-tag
-    (make-define-structure-type 'vector
-                               "thread-mutex"
-                               '#(waiting-threads owner)
-                               '#(1 2)
-                               (vector 2 (lambda () #f))
-                               #f
-                               thread-mutex-tag
-                               3))
+    (new-make-define-structure-type 'vector
+                                   "thread-mutex"
+                                   '#(waiting-threads owner)
+                                   '#(1 2)
+                                   (vector 2 (lambda () #f))
+                                   thread-mutex-tag
+                                   3))
   (named-structure/set-tag-description! link-tag
-    (make-define-structure-type 'vector
-                               "link"
-                               '#(prev next item)
-                               '#(1 2 3)
-                               (vector 3 (lambda () #f))
-                               #f
-                               link-tag
-                               4)))
+    (new-make-define-structure-type 'vector
+                                   "link"
+                                   '#(prev next item)
+                                   '#(1 2 3)
+                                   (vector 3 (lambda () #f))
+                                   link-tag
+                                   4)))
 
 (define-print-method link?
   (standard-print-method 'link))