From fa3f23105ddcf07c5900de47f19af43d1db1b597 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:27 -0800 Subject: Import Upstream version 2c3 --- rdms.scm | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) (limited to 'rdms.scm') 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) -- cgit v1.2.3