(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)))
object)))
\f
(define <bundle>
- (new-make-record-type '<bundle> '(alist)))
+ (make-record-type '<bundle> '(alist)))
(define bundle?
(record-predicate <bundle>))
(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)
(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)
(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))