Import Upstream version 2c3upstream/2c3

1 files changed, 13 insertions, 12 deletions

diff --git a/rdms.scm b/rdms.scm
index 8c20362..9f176f9 100644
--- a/rdms.scm
+++ b/rdms.scm
@@ -216,8 +216,9 @@
 			   base:catalog base:domains rdms:catalog)
 
       (define (write-database filename)
-	(write-base lldb filename)
-	(set! rdms:filename filename))
+	(let ((ans (write-base lldb filename)))
+	  (and ans (set! rdms:filename filename))
+	  ans))
 
       (define (close-database)
 	(close-base lldb)
@@ -489,19 +490,19 @@
 		  (let ((ci (translate-column (cadr args))))
 		    (cond
 		     ((<= ci primary-limit) ;primary-key?
-		      (let ((key-extractor
-			     ((base 'make-key-extractor)
-			      primary-limit column-type-list ci)))
-			(case (car args)
-			  ((get) (lambda keys
-				   (and (present? base-table (list->key keys))
-					(list-ref keys (+ -1 ci)))))
-			  ((get*) (lambda mkeys
+		      (case (car args)
+			((get) (lambda gkeys
+				 (and (present? base-table (list->key gkeys))
+				      (list-ref gkeys (+ -1 ci)))))
+			((get*) (let ((key-extractor
+				       ((base 'make-key-extractor)
+					primary-limit column-type-list ci)))
+				  (lambda mkeys
 				    (base:map-primary-key
 				     base-table
 				     (lambda (ckey) (key-extractor ckey))
-				     (norm-mkeys mkeys))))
-			  (else #f))))
+				     (norm-mkeys mkeys)))))
+			(else #f)))
 		     (else
 		      (let ((index (- ci (+ 1 primary-limit))))
 			(case (car args)