From: Mark Friedman <edu/mit/csail/zurich/markf>
Date: Mon, 25 Mar 1991 22:03:47 +0000 (+0000)
Subject: Fixed bug about boa-constructors of record types.
X-Git-Tag: 20090517-FFI~10815
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=90a13e2eb99ccdfa99d445731d38a73374c5d70c;p=mit-scheme.git

Fixed bug about boa-constructors of record types.
---

diff --git a/v7/src/runtime/defstr.scm b/v7/src/runtime/defstr.scm
index bf9d6dcb0..4918ebd7f 100644
--- a/v7/src/runtime/defstr.scm
+++ b/v7/src/runtime/defstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/defstr.scm,v 14.15 1991/01/11 22:08:09 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/defstr.scm,v 14.16 1991/03/25 22:03:47 markf Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -621,15 +621,8 @@ must be defined when the defstruct is evaluated.
 	(map cdr alist))))
 
 (define (constructor-definition/boa structure name lambda-list)
-  `(DEFINE (,name . ,lambda-list)
-     (,(let ((scheme-type (structure/scheme-type structure)))
-	 (if (eq? scheme-type 'RECORD)
-	     ((absolute 'RECORD-CONSTRUCTOR)
-	      (structure/type structure))
-	     ;; *** Kludge -- SCHEME-TYPE happens to be same as constructor.
-	     (absolute scheme-type)))
-      ,@(constructor-prefix-slots structure)
-      ,@(parse-lambda-list lambda-list
+  (let ((handle-defaults
+	 (parse-lambda-list lambda-list
 	  (lambda (required optional rest)
 	    (let ((name->slot
 		   (lambda (name)
@@ -648,7 +641,19 @@ must be defined when the defstruct is evaluated.
 				   ,(slot/name slot)))
 			     (else
 			      (slot/default slot))))
-		     (structure/slots structure)))))))))
+		     (structure/slots structure)))))))
+	 (prefix-slots (constructor-prefix-slots structure))
+	 (scheme-type (structure/scheme-type structure)))
+    (if (eq? scheme-type 'RECORD)
+	`(DEFINE (,name . ,lambda-list)
+	   (,((access RECORD-CONSTRUCTOR '())
+	      (structure/type structure))
+	    ,@handle-defaults))
+	`(DEFINE (,name . ,lambda-list)
+	   ;; *** Kludge -- SCHEME-TYPE happens to be same as constructor.
+	   (,(absolute scheme-type)
+	    ,@prefix-slots
+	    ,@handle-defaults)))))
 
 (define (constructor-prefix-slots structure)
   (let ((offsets (make-list (structure/offset structure) false)))