Don't need to allow #F as default-init in MAKE-DEFINE-STRUCTURE-TYPE.
authorChris Hanson <org/chris-hanson/cph>
Fri, 14 Mar 2003 20:10:20 +0000 (20:10 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 14 Mar 2003 20:10:20 +0000 (20:10 +0000)
v7/src/runtime/record.scm

index f411d80d6b40876912f6338a0256a15abba0142e..ccd2d5cda93a2b2d2c265b4ab9f4451493317db1 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: record.scm,v 1.44 2003/03/14 20:06:02 cph Exp $
+$Id: record.scm,v 1.45 2003/03/14 20:10:20 cph Exp $
 
 Copyright 1989,1990,1991,1993,1994,1996 Massachusetts Institute of Technology
 Copyright 1997,2002,2003 Massachusetts Institute of Technology
@@ -493,27 +493,20 @@ USA.
        (let ((constructor (record-constructor rtd:structure-type)))
          (lambda (physical-type name field-names field-indexes default-inits
                                 unparser-method tag length)
-           (let ((inits
-                  (if (vector? default-inits)
-                      (vector-copy default-inits)
-                      (list->vector default-inits))))
-             (let ((n (vector-length inits)))
-               (do ((i 0 (fix:+ i 1)))
-                   ((not (fix:< i n)))
-                 (if (not (vector-ref inits i))
-                     (vector-set! inits i (lambda () #f)))))
-             (constructor physical-type
-                          name
-                          (if (vector? field-names)
-                              field-names
-                              (list->vector field-names))
-                          (if (vector? field-indexes)
-                              field-indexes
-                              (list->vector field-indexes))
-                          inits
-                          unparser-method
-                          tag
-                          length)))))
+           (constructor physical-type
+                        name
+                        (if (vector? field-names)
+                            field-names
+                            (list->vector field-names))
+                        (if (vector? field-indexes)
+                            field-indexes
+                            (list->vector field-indexes))
+                        (if (vector? default-inits)
+                            (vector-copy default-inits)
+                            (list->vector default-inits))
+                        unparser-method
+                        tag
+                        length))))
   (set! structure-type?
        (record-predicate rtd:structure-type))
   (set! structure-type/physical-type