From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 16 Nov 2018 05:31:22 +0000 (-0800)
Subject: Eliminate old version of make-record-type.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~94
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=328d34167d9aabb3e008f6563188cf10df83c122;p=mit-scheme.git

Eliminate old version of make-record-type.
---

diff --git a/src/runtime/bundle.scm b/src/runtime/bundle.scm
index 25dab6e82..44d6e669e 100644
--- a/src/runtime/bundle.scm
+++ b/src/runtime/bundle.scm
@@ -37,7 +37,7 @@ USA.
 (declare (usual-integrations))
 
 (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)))
 
 (define <bundle>
-  (new-make-record-type '<bundle> '(alist)))
+  (make-record-type '<bundle> '(alist)))
 
 (define bundle?
   (record-predicate <bundle>))
diff --git a/src/runtime/library-standard.scm b/src/runtime/library-standard.scm
index 39114b8b6..a8e3b5cbe 100644
--- a/src/runtime/library-standard.scm
+++ b/src/runtime/library-standard.scm
@@ -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)
diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 06c6c02bc..035dd7238 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -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))))
diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index 19d65980a..59410b483 100644
--- a/src/runtime/record.scm
+++ b/src/runtime/record.scm
@@ -35,13 +35,13 @@ USA.
 (define-primitives
   (vector-cons 2))
 
-(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))
 
-;; 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))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 6911f1793..f6cd9e11e 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -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