Fix bug: STRUCTURE-TAG/DEFAULT-VALUE can't be used on untagged

structures.

diff --git a/v7/src/runtime/defstr.scm b/v7/src/runtime/defstr.scm
index d2dc2e770a1200c7d53de659a9a80d76c4dac3d3..2efd8edff4064728c6f7507d54cac313113a64cb 100644 (file)
--- a/v7/src/runtime/defstr.scm
+++ b/v7/src/runtime/defstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: defstr.scm,v 14.49 2003/03/11 05:00:41 cph Exp $
+$Id: defstr.scm,v 14.50 2003/03/12 20:40:28 cph Exp $
 
 Copyright 1987,1988,1989,1990,1991,1992 Massachusetts Institute of Technology
 Copyright 1993,1994,1995,1996,1997,2000 Massachusetts Institute of Technology
@@ -742,20 +742,25 @@ differences:
                                     (eq? slot rest))
                                 name
                                 (let ((dv
-                                       (if (eq? type 'RECORD)
-                                           `(,(absolute
-                                               'RECORD-TYPE-DEFAULT-VALUE
-                                               context)
-                                             ,(close (structure/tag-expression
-                                                      structure)
-                                                     context)
-                                             ',name)
-                                           `(,(absolute
-                                               'STRUCTURE-TAG/DEFAULT-VALUE
-                                               context)
-                                             ,tag-expression
-                                             ',type
-                                             ',name))))
+                                       (cond ((eq? type 'RECORD)
+                                              `(,(absolute
+                                                  'RECORD-TYPE-DEFAULT-VALUE
+                                                  context)
+                                                ,(close
+                                                  (structure/tag-expression
+                                                   structure)
+                                                  context)
+                                                ',name))
+                                             (tag-expression
+                                              `(,(absolute
+                                                  'STRUCTURE-TAG/DEFAULT-VALUE
+                                                  context)
+                                                ,tag-expression
+                                                ',type
+                                                ',name))
+                                             (else
+                                              (close (slot/default slot)
+                                                     context)))))
                                   (if (memq slot optional)
                                       `(IF (DEFAULT-OBJECT? ,name) ,dv ,name)
                                       dv)))))