summaryrefslogtreecommitdiffstats
path: root/rdms.scm
diff options
context:
space:
mode:
Diffstat (limited to 'rdms.scm')
-rw-r--r--rdms.scm25
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)