Eliminate old version of make-record-type.
authorChris Hanson <org/chris-hanson/cph>
Fri, 16 Nov 2018 05:31:22 +0000 (21:31 -0800)
committerChris Hanson <org/chris-hanson/cph>
Fri, 16 Nov 2018 05:31:22 +0000 (21:31 -0800)
src/runtime/bundle.scm
src/runtime/library-standard.scm
src/runtime/mit-macros.scm
src/runtime/record.scm
src/runtime/runtime.pkg

index 25dab6e826c0bab2e50fd48ff2d44f3aec5b5f9e..44d6e669ef74efd578f98cbca3e187bf1fd7a03d 100644 (file)
@@ -37,7 +37,7 @@ USA.
 (declare (usual-integrations))
 \f
 (define (make-bundle-predicate name)
-  (let ((type (new-make-record-type name '() <bundle>)))
+  (let ((type (make-record-type name '() <bundle>)))
     (set-record-type-applicator! type %bundle-applicator)
     (record-predicate type)))
 
@@ -76,7 +76,7 @@ USA.
               object)))
 \f
 (define <bundle>
-  (new-make-record-type '<bundle> '(alist)))
+  (make-record-type '<bundle> '(alist)))
 
 (define bundle?
   (record-predicate <bundle>))
index 39114b8b6bc24127c46c031d4f221da3f5386107..a8e3b5cbe1ecfe9ee961fbdf351d7977bf929366 100644 (file)
@@ -150,7 +150,7 @@ USA.
     (cons-stream* cons delay)
     (define lambda named-lambda)
     (define-integrable begin lambda let set! shallow-fluid-bind)
-    (define-record-type define new-make-record-type quote record-accessor
+    (define-record-type define make-record-type quote record-accessor
                        record-constructor record-modifier record-predicate)
     (define-values begin call-with-values define lambda set!)
     (delay delay-force make-promise)
index 06c6c02bc56d55c3859ab6f16451d6a57272b2e5..035dd7238a7393c60642b5b3c60a517133d4c397 100644 (file)
@@ -836,7 +836,7 @@ USA.
        (lambda (type-name parent maker-name maker-args pred-name field-specs)
         (apply scons-begin
                (scons-define type-name
-                 (scons-call (scons-close 'new-make-record-type)
+                 (scons-call (scons-close 'make-record-type)
                              (scons-quote type-name)
                              (scons-quote (map car field-specs))
                              (or parent (default-object))))
index 19d65980af34ad12632b4837e17833db1145e680..59410b483146e27c90844fa50728c7738c4710bb 100644 (file)
@@ -35,13 +35,13 @@ USA.
 (define-primitives
   (vector-cons 2))
 \f
-(define (new-make-record-type type-name field-specs #!optional parent-type)
-  (guarantee valid-field-specs? field-specs 'new-make-record-type)
-  (let ((type-name (->type-name type-name 'new-make-record-type)))
+(define (make-record-type type-name field-specs #!optional parent-type)
+  (guarantee valid-field-specs? field-specs 'make-record-type)
+  (let ((type-name (->type-name type-name 'make-record-type)))
     (if (default-object? parent-type)
        (%make-record-type type-name field-specs #f)
        (begin
-         (guarantee record-type? parent-type 'new-make-record-type)
+         (guarantee record-type? parent-type 'make-record-type)
          (%make-record-type type-name
                             (append (record-type-field-specs parent-type)
                                     field-specs)
@@ -90,32 +90,6 @@ USA.
 (define (initialize-record-procedures!)
   (run-deferred-boot-actions 'record-procedures))
 \f
-;; Replace this with new-make-record-type after the 9.3 release.
-(define (make-record-type type-name field-specs
-                         #!optional
-                         default-inits unparser-method entity-unparser-method)
-  (declare (ignore entity-unparser-method))
-  (let* ((caller 'make-record-type)
-        (type
-         (%make-record-type
-          (->type-name type-name caller)
-          (if (default-object? default-inits)
-              (begin
-                (guarantee valid-field-specs? field-specs caller)
-                field-specs)
-              (begin
-                (if (not (list-of-unique-symbols? field-specs))
-                    (error:not-a list-of-unique-symbols? field-specs caller))
-                (guarantee list? default-inits caller)
-                (if (not (fix:= (length field-specs) (length default-inits)))
-                    (error:bad-range-argument default-inits caller))
-                (map make-field-spec field-specs default-inits)))
-          #f)))
-    (if (and unparser-method
-            (not (default-object? unparser-method)))
-       (define-print-method (record-predicate type) unparser-method))
-    type))
-
 (define (list-of-unique-symbols? object)
   (and (list-of-type? object symbol?)
        (let loop ((elements object))
index 6911f1793177f55d626d3848483a500f568986b7..f6cd9e11ee17d2ac07aa47532fc626faf56dae97 100644 (file)
@@ -3804,6 +3804,7 @@ USA.
   (files "record")
   (parent (runtime))
   (export () deprecated:record
+         (new-make-record-type make-record-type) ;RELNOTE: delete
          set-record-type-unparser-method!)
   (export ()
          applicable-record?
@@ -3823,7 +3824,6 @@ USA.
          named-list?
          named-structure?
          named-vector?
-         new-make-record-type
          record-accessor
          record-applicator
          record-constructor