name)
         (list (wrap `(immutable ,(syntax->datum #'name)))
               (guess-accessor-name #'name)
               #f)]
        [else
         (syntax-violation 'define-record-type "invalid field specifier" x)]))
    (map f fields))
  
  (define-syntax define-record-type0
    (lambda (stx)	  
      (define *unspecified* (cons #f #f))
      (define (unspecified? obj)
        (eq? *unspecified* obj))
      (syntax-case stx ()
        ((_ (record-name constructor-name predicate-name) record-clause ...)
         (let loop ((_fields *unspecified*)
                    (_parent *unspecified*)
                    (_protocol *unspecified*)
                    (_sealed *unspecified*)
                    (_opaque *unspecified*)
                    (_nongenerative *unspecified*)
                    (_constructor *unspecified*)
                    (_parent-rtd *unspecified*)
                    (record-clauses #'(record-clause ...)))
           (syntax-case record-clauses
               (fields parent protocol sealed opaque nongenerative
                       constructor parent-rtd)
             [()
              (let* ((fields (if (unspecified? _fields) '() _fields))
                     (field-names (list->vector (map car fields)))
                     (field-accessors
                      (fold-left (lambda (lst x c)
                                   (cons #`(define #,(cadr x)
                                             (record-accessor record-name #,c))
                                         lst))
                                 '() fields (sequence (length fields))))
                     (field-mutators
                      (fold-left (lambda (lst x c)
                                   (if (caddr x)
                                       (cons #`(define #,(caddr x)
                                                 (record-mutator record-name
                                                                 #,c))
                                             lst)
                                       lst))
                                 '() fields (sequence (length fields))))
                     (parent-cd (cond ((not (unspecified? _parent))
                                       #`(record-constructor-descriptor
                                          #,_parent))
                                      ((not (unspecified? _parent-rtd))
                                       (cadr _parent-rtd))
                                      (else #f)))
                     (parent-rtd (cond ((not (unspecified? _parent))
                                        #`(record-type-descriptor #,_parent))
                                       ((not (unspecified? _parent-rtd))
                                        (car _parent-rtd))
                                       (else #f)))
                     (protocol (if (unspecified? _protocol) #f _protocol))
                     (uid (if (unspecified? _nongenerative) #f _nongenerative))
                     (sealed? (if (unspecified? _sealed) #f _sealed))
                     (opaque? (if (unspecified? _opaque) #f _opaque)))
                #`(begin
                    (define record-name
                      (make-record-type-descriptor
                       (quote record-name)
                       #,parent-rtd #,uid #,sealed? #,opaque?
                       #,field-names))
                    (define constructor-name
                      (record-constructor
                       (make-record-constructor-descriptor
                        record-name #,parent-cd #,protocol)))
                    (define dummy
                      (let ()
                        (register-record-type 
                         (quote record-name)
                         record-name (make-record-constructor-descriptor 
                                      record-name #,parent-cd #,protocol))
                        'dummy))
                    (define predicate-name (record-predicate record-name))
                    #,@field-accessors
                    #,@field-mutators))]
             [((fields record-fields ...) . rest)
              (if (unspecified? _fields)
                  (loop (process-fields #'record-name #'(record-fields ...))
                        _parent _protocol _sealed _opaque _nongenerative
                        _constructor _parent-rtd #'rest)
                  (raise (make-assertion-violation)))]
             [((parent parent-name) . rest)
              (if (not (unspecified? _parent-rtd))
                  (raise (make-assertion-violation))
                  (if (unspecified? _parent)
                      (loop _fields #'parent-name _protocol _sealed _opaque
                            _nongenerative _constructor _parent-rtd #'rest)
                      (raise (make-assertion-violation))))]
             [((protocol expression) . rest)
              (if (unspecified? _protocol)
                  (loop _fields _parent #'expression _sealed _opaque
                        _nongenerative _constructor _parent-rtd #'rest)
                  (raise (make-assertion-violation)))]
             [((sealed sealed?) . rest)
              (if (unspecified? _sealed)
                  (loop _fields _parent _protocol #'sealed? _opaque
                        _nongenerative _constructor _parent-rtd #'rest)
                  (raise (make-assertion-violation)))]
             [((opaque opaque?) . rest)
              (if (unspecified? _opaque)
                  (loop _fields _parent _protocol _sealed #'opaque?
                        _nongenerative _constructor _parent-rtd #'rest)
                  (raise (make-assertion-violation)))]
             [((nongenerative) . rest)
              (if (unspecified? _nongenerative)
                  (loop _fields _parent _protocol _sealed _opaque
                        #`(quote #,(datum->syntax #'record-name (gensym)))
                        _constructor _parent-rtd #'rest)
                  (raise (make-assertion-violation)))]
             [((nongenerative uid) . rest)
              (if (unspecified? _nongenerative)
                  (loop _fields _parent _protocol _sealed
                        _opaque #''uid _constructor
                        _parent-rtd #'rest)
                  (raise (make-assertion-violation)))]
             [((parent-rtd rtd cd) . rest)
              (if (not (unspecified? _parent))
                  (raise (make-assertion-violation))
                  (if (unspecified? _parent-rtd)
                      (loop _fields _parent _protocol _sealed _opaque
                            _nongenerative _constructor #'(rtd cd)
                            #'rest)
                      (raise (make-assertion-violation))))]))))))

  (define-syntax record-type-descriptor
    (lambda (stx)
      (syntax-case stx ()
	((_ name) #`(lookup-record-type-descriptor 
		     #,(datum->syntax 
			stx (list 'quote (syntax->datum #'name))))))))

  (define-syntax record-constructor-descriptor
    (lambda (stx)
      (syntax-case stx ()
	((_ name) #`(lookup-record-constructor-descriptor 
		     #,(datum->syntax 
			stx (list 'quote (syntax->datum #'name))))))))
)