From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 15 Feb 2018 02:48:53 +0000 (-0800)
Subject: Make field-names argument of condition-constructor be optional.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~243
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=99759c9d84f4f6807d0c16abda18a2b416e95fe0;p=mit-scheme.git

Make field-names argument of condition-constructor be optional.

When that happens it uses the type's field-names value.
---

diff --git a/src/runtime/error.scm b/src/runtime/error.scm
index 0aad2b939..6677a38ec 100644
--- a/src/runtime/error.scm
+++ b/src/runtime/error.scm
@@ -193,35 +193,36 @@ USA.
 		     (cadr alist))))
     condition))
 
-(define (condition-constructor type field-names)
-  (guarantee-condition-type type 'CONDITION-CONSTRUCTOR)
-  (guarantee list-of-unique-symbols? field-names 'CONDITION-CONSTRUCTOR)
-  (let ((indexes
-	 (map (lambda (field-name)
-		(%condition-type/field-index type field-name
-					     'CONDITION-CONSTRUCTOR))
-	      field-names)))
-    (letrec
-	((constructor
-	  (lambda (continuation restarts . field-values)
-	    (guarantee continuation? continuation constructor)
-	    (let ((condition
-		   (%make-condition type
-				    continuation
-				    (%restarts-argument restarts
-							constructor))))
-	      (let ((values (%condition/field-values condition)))
-		(do ((i indexes (cdr i))
-		     (v field-values (cdr v)))
-		    ((not (and (pair? i) (pair? v)))
-		     (if (or (pair? i) (pair? v))
-			 (error:wrong-number-of-arguments
-			  constructor
-			  (fix:+ (length indexes) 2)
-			  (cons* continuation restarts field-values))))
-		  (vector-set! values (car i) (car v))))
-	      condition))))
-      constructor)))
+(define (condition-constructor type #!optional field-names)
+  (let ((caller 'condition-constructor))
+    (guarantee-condition-type type caller)
+    (let ((indexes
+	   (map (lambda (field-name)
+		  (%condition-type/field-index type field-name caller))
+		(if (default-object? field-names)
+		    (condition-type/field-names type)
+		    (guarantee list-of-unique-symbols? field-names caller)))))
+      (letrec
+	  ((constructor
+	    (lambda (continuation restarts . field-values)
+	      (guarantee continuation? continuation constructor)
+	      (let ((condition
+		     (%make-condition type
+				      continuation
+				      (%restarts-argument restarts
+							  constructor))))
+		(let ((values (%condition/field-values condition)))
+		  (do ((i indexes (cdr i))
+		       (v field-values (cdr v)))
+		      ((not (and (pair? i) (pair? v)))
+		       (if (or (pair? i) (pair? v))
+			   (error:wrong-number-of-arguments
+			    constructor
+			    (fix:+ (length indexes) 2)
+			    (cons* continuation restarts field-values))))
+		    (vector-set! values (car i) (car v))))
+		condition))))
+	constructor))))
 
 (define-integrable (%restarts-argument restarts operator)
   (cond ((eq? 'BOUND-RESTARTS restarts)