From 328d34167d9aabb3e008f6563188cf10df83c122 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 15 Nov 2018 21:31:22 -0800
Subject: [PATCH] Eliminate old version of make-record-type.
---
src/runtime/bundle.scm | 4 ++--
src/runtime/library-standard.scm | 2 +-
src/runtime/mit-macros.scm | 2 +-
src/runtime/record.scm | 34 ++++----------------------------
src/runtime/runtime.pkg | 2 +-
5 files changed, 9 insertions(+), 35 deletions(-)
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
--
2.25.1