From 328d34167d9aabb3e008f6563188cf10df83c122 Mon Sep 17 00:00:00 2001 From: Chris Hanson 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 '() ))) + (let ((type (make-record-type name '() ))) (set-record-type-applicator! type %bundle-applicator) (record-predicate type))) @@ -76,7 +76,7 @@ USA. object))) (define - (new-make-record-type ' '(alist))) + (make-record-type ' '(alist))) (define bundle? (record-predicate )) 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