From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 25 Apr 2003 03:27:55 +0000 (+0000)
Subject: Fix bug: THUNK? was getting called too early in the boot load.
X-Git-Tag: 20090517-FFI~1918
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=bbe86af69fb178609ac6ae7dc2e65b137c76f415;p=mit-scheme.git

Fix bug: THUNK? was getting called too early in the boot load.
---

diff --git a/v7/src/runtime/record.scm b/v7/src/runtime/record.scm
index 079cf4d7d..6eaa2e139 100644
--- a/v7/src/runtime/record.scm
+++ b/v7/src/runtime/record.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: record.scm,v 1.46 2003/03/14 20:38:39 cph Exp $
+$Id: record.scm,v 1.47 2003/04/25 03:27:55 cph Exp $
 
 Copyright 1989,1990,1991,1993,1994,1996 Massachusetts Institute of Technology
 Copyright 1997,2002,2003 Massachusetts Institute of Technology
@@ -99,6 +99,8 @@ USA.
 		     (write-char #\space port)
 		     (write (dispatch-tag-contents tag) port))))
 		(else record-method))))))
+  (set! %set-record-type-default-inits!
+	%set-record-type-default-inits!/after-boot)
   (set! set-record-type-unparser-method!
 	set-record-type-unparser-method!/after-boot)
   (for-each (lambda (t.m)
@@ -196,23 +198,27 @@ USA.
     (guarantee-record-type record-type caller)
     (%set-record-type-default-inits! record-type default-inits caller)))
 
-(define (%set-record-type-default-inits! record-type default-inits caller)
-  (let ((v (%record-type-default-inits record-type))
-	(lose (lambda () (error:bad-range-argument default-inits caller))))
-    (if (not (fix:= (guarantee-list->length default-inits caller)
-		    (vector-length v)))
-	(lose))
-    (do ((values default-inits (cdr values))
-	 (i 0 (fix:+ i 1)))
-	((not (pair? values)))
-      (vector-set! v i
-		   (let ((init (car values)))
-		     (if init
-			 (begin
-			   (if (not (thunk? init))
-			       (lose))
-			   init)
-			 (lambda () #f)))))))
+(define %set-record-type-default-inits!
+  (lambda (record-type default-inits caller)
+    caller
+    (let ((v (%record-type-default-inits record-type)))
+      (do ((values default-inits (cdr values))
+	   (i 0 (fix:+ i 1)))
+	  ((not (pair? values)))
+	(vector-set! v i (car values))))))
+
+(define %set-record-type-default-inits!/after-boot
+  (named-lambda (%set-record-type-default-inits! record-type default-inits
+						 caller)
+    (let ((v (%record-type-default-inits record-type)))
+      (if (not (fix:= (guarantee-list-of-type->length
+		       default-inits thunk? "default initializers" caller)
+		      (vector-length v)))
+	  (error:bad-range-argument default-inits caller))
+      (do ((values default-inits (cdr values))
+	   (i 0 (fix:+ i 1)))
+	  ((not (pair? values)))
+	(vector-set! v i (car values))))))
 
 (define (record-type-default-value record-type field-name)
   ((vector-ref (%record-type-default-inits record-type)