Import Debian changes 3b1-1debian/3b1-1

slib (3b1-1) unstable; urgency=low

  * New upstream release.
  * guile.init (library-vicinity): Repeat change from 3a4-2.
  * slib.texi (Library Catalogs): Repeat change from 3a3-3.
  * slib.sh: Repeat change from 3a5-3.
  * slib.1: Repeat change from 3a5-4.
  * Makefile: Repeat change from 3a2-1.

1 files changed, 327 insertions, 323 deletions

diff --git a/rdms.scm b/rdms.scm
index 09506bc..b6a0ffa 100644
--- a/rdms.scm
+++ b/rdms.scm
@@ -242,335 +242,339 @@
 
       (define (open-table table-name writable)
 	(define cat:row (cat:get-row base:catalog table-name))
-	(cond ((not cat:row)
-	       (slib:error "can't open-table:" table-name))
-	      ((and writable (not mutable))
-	       (slib:error "can't open-table for writing:" table-name)))
-	(let ((column-limit (row-ref cat:row catalog:column-limit-pos))
-	      (desc-table
-	       (base:open-table
-		lldb
-		(row-ref (cat:get-row
-			  base:catalog
-			  (row-ref cat:row catalog:coltab-name-pos))
-			 catalog:bastab-id-pos)
-		1 (itypes columns:init-cols)))
-	      (base-table #f)
-	      (base:get #f)
-	      (primary-limit 1)
-	      (column-name-alist '())
-	      (column-foreign-list '())
-	      (column-foreign-check-list '())
-	      (column-domain-list '())
-	      (column-type-list '())
-	      (export-alist '())
-	      (cirs '())
-	      (dirs '())
-	      (list->key #f)
-	      (key->list #f))
-
-	  (or desc-table
-	      (slib:error "descriptor table doesn't exist for:" table-name))
-	  (do ((ci column-limit (+ -1 ci)))
-	      ((zero? ci))
-	    (let* ((des:row (des:get-row desc-table ci))
-		   (column-name (row-ref des:row columns:name-pos))
-		   (column-domain (row-ref des:row columns:domain-name-pos)))
-	      (set! cirs
-		    (cons (row-eval des:row columns:integrity-rule-pos) cirs))
-	      (set! column-name-alist
-		    (cons (cons column-name ci) column-name-alist))
-	      (cond
-	       (column-domain
-		(let ((dom:row (dom:get-row base:domains column-domain)))
-		  (set! dirs
-			(cons (row-eval dom:row domains:integrity-rule-pos)
-			      dirs))
-		  (set! column-type-list
-			(cons (row-ref dom:row domains:type-id-pos)
-			      column-type-list))
-		  (set! column-domain-list
-			(cons column-domain column-domain-list))
-		  (set! column-foreign-list
-			(cons (let ((foreign-name
-				     (row-ref dom:row domains:foreign-pos)))
-				(and (not (eq? foreign-name table-name))
-				     foreign-name))
-			      column-foreign-list))
-		  (set! column-foreign-check-list
-			(cons
-			 (let ((foreign-name (car column-foreign-list)))
-			   (and foreign-name
-				(let* ((tab (open-table foreign-name #f))
-				       (p? (and tab (tab 'get 1))))
-				  (cond
-				   ((not tab)
-				    (slib:error "foreign key table missing for:"
-						foreign-name))
-				   ((not (= (tab 'primary-limit) 1))
-				    (slib:error "foreign key table wrong type:"
-						foreign-name))
-				   (else p?)))))
-			 column-foreign-check-list))))
-	       (else
-		(slib:error "missing domain for column:" ci column-name)))
-	      (cond
-	       ((row-ref des:row columns:primary?-pos)
-		(set! primary-limit (max primary-limit ci))
-		(cond
-		 ((base:supported-key-type? (car column-type-list)))
-		 (else (slib:error "key type not supported by base tables:"
-				   (car column-type-list)))))
-	       ((base:supported-type? (car column-type-list)))
-	       (else (slib:error "type not supported by base tables:"
-				 (car column-type-list))))))
-	  (set! base-table
-		(base:open-table lldb (row-ref cat:row catalog:bastab-id-pos)
-				 primary-limit column-type-list))
-	  (set! base:get ((basic 'make-getter) primary-limit column-type-list))
-	  (set! list->key
-		((basic 'make-list-keyifier) primary-limit column-type-list))
-	  (set! key->list
-		((basic 'make-key->list) primary-limit column-type-list))
-	  (letrec ((export-method
-		    (lambda (name proc)
-		      (set! export-alist
-			    (cons (cons name proc) export-alist))))
-		   (ckey:retrieve ;ckey gets whole row (assumes exists)
-		    (if (= primary-limit column-limit) key->list
-			(lambda (ckey) (append (key->list ckey)
-					       (base:get base-table ckey)))))
-		   (accumulate-over-table
-		    (lambda (operation)
-		      (lambda mkeys (base:map-primary-key
-				     base-table operation
-				     primary-limit column-type-list
-				     (norm-mkeys mkeys)))))
-		   (norm-mkeys
-		    (lambda (mkeys)
-		      (define mlim (length mkeys))
-		      (cond ((> mlim primary-limit)
-			     (slib:error "too many keys:" mkeys))
-			    ((= mlim primary-limit) mkeys)
-			    (else
-			     (append mkeys
-				     (do ((k (- primary-limit mlim) (+ -1 k))
-					  (result '() (cons #f result)))
-					 ((<= k 0) result))))))))
-	    (export-method
-	     'row:retrieve
-	     (if (= primary-limit column-limit)
-		 (lambda keys
-		   (let ((ckey (list->key keys)))
-		     (and (present? base-table ckey) keys)))
-		 (lambda keys
-		   (let ((vals (base:get base-table (list->key keys))))
-		     (and vals (append keys vals))))))
-	    (export-method 'row:retrieve*
-			   (accumulate-over-table
-			    (if (= primary-limit column-limit) key->list
-				ckey:retrieve)))
-	    (export-method
-	     'for-each-row
-	     (let ((r (if (= primary-limit column-limit) key->list
-			  ckey:retrieve)))
-	       (lambda (proc . mkeys)
-		 (base:for-each-primary-key
-		  base-table (lambda (ckey) (proc (r ckey)))
-		  primary-limit column-type-list
-		  (norm-mkeys mkeys)))))
-	    (and base:ordered-for-each-key
-		 (export-method
-		  'for-each-row-in-order
-		  (let ((r (if (= primary-limit column-limit) key->list
-			       ckey:retrieve)))
-		    (lambda (proc . mkeys)
-		      (base:ordered-for-each-key
-		       base-table (lambda (ckey) (proc (r ckey)))
-		       primary-limit column-type-list
-		       (norm-mkeys mkeys))))))
-	    (cond
-	     ((and mutable writable)
-	      (letrec
-		  ((combine-primary-keys
-		    (cond
-		     ((and (= primary-limit column-limit)
-			   (> primary-limit 0))
-		      list->key)
-		     ((eq? list->key car) list->key)
-		     (else
-		      (case primary-limit
-			((1) (let ((keyify-1 ((base 'make-keyifier-1)
-					      (car column-type-list))))
-			       (lambda (row) (keyify-1 (car row)))))
-			((2) (lambda (row)
-			       (list->key (list (car row) (cadr row)))))
-			((3) (lambda (row)
-			       (list->key (list (car row) (cadr row)
-						(caddr row)))))
-			(else (lambda (row)
-				(do ((rw row (cdr rw))
-				     (nrw '() (cons (car rw) nrw))
-				     (pl (+ -1 primary-limit) (+ -1 pl)))
-				    ((negative? pl)
-				     (list->key (reverse nrw))))))))))
-		   (uir (row-eval cat:row catalog:integrity-rule-pos))
-		   (check-rules
-		    (lambda (row)
-		      (if (= column-limit (length row)) #t
-			  (slib:error "bad row length:" row))
-		      (for-each
-		       (lambda (cir dir value column-name column-domain
-				    foreign)
-			 (cond
-			  ((and dir (not (dir value)))
-			   (slib:error "violated domain integrity rule:"
-				       table-name column-name
-				       column-domain value))
-			  ((and cir (not (cir value)))
-			   (slib:error "violated column integrity rule:"
-				       table-name column-name value))
-			  ((and foreign (not (foreign value)))
-			   (slib:error "foreign key missing:"
-				       table-name column-name value))))
-		       cirs dirs row column-name-alist column-domain-list
-		       column-foreign-check-list)
-		      (cond ((and uir (not (uir row)))
-			     (slib:error "violated user integrity rule:"
-					 row)))))
-		   (putter
-		    ((basic 'make-putter) primary-limit column-type-list))
-		   (row:insert
-		    (lambda (row)
-		      (check-rules row)
-		      (let ((ckey (combine-primary-keys row)))
-			(if (present? base-table ckey)
-			    (slib:error 'row:insert "row present:" row))
-			(putter base-table ckey
-				(list-tail row primary-limit)))))
-		   (row:update
-		    (lambda (row)
-		      (check-rules row)
-		      (putter base-table (combine-primary-keys row)
-			      (list-tail row primary-limit)))))
-
-		(export-method 'row:insert row:insert)
-		(export-method 'row:insert*
-			       (lambda (rows) (for-each row:insert rows)))
-		(export-method 'row:update row:update)
-		(export-method 'row:update*
-			       (lambda (rows) (for-each row:update rows))))
-
-	      (letrec ((base:delete (basic 'delete))
-		       (base:delete* (basic 'delete*))
-		       (ckey:remove (lambda (ckey)
-				      (let ((r (ckey:retrieve ckey)))
-					(and r (base:delete base-table ckey))
-					r))))
-		(export-method 'row:remove
-			       (lambda keys
-				 (let ((ckey (list->key keys)))
-				   (and (present? base-table ckey)
-					(ckey:remove ckey)))))
-		(export-method 'row:delete
-			       (lambda keys
-				 (base:delete base-table (list->key keys))))
-		(export-method 'row:remove*
-			       (accumulate-over-table ckey:remove))
-		(export-method 'row:delete*
-			       (lambda mkeys
-				 (base:delete* base-table
-					       primary-limit column-type-list
-					       (norm-mkeys mkeys))))
-		(export-method 'close-table
-			       (lambda () (set! base-table #f)
-				       (set! desc-table #f)
-				       (set! export-alist #f))))))
-
-	    (export-method 'column-names (map car column-name-alist))
-	    (export-method 'column-foreigns column-foreign-list)
-	    (export-method 'column-domains column-domain-list)
-	    (export-method 'column-types column-type-list)
-	    (export-method 'primary-limit primary-limit)
-
-	    (let ((translate-column
-		   (lambda (column)
-		     (let ((colp (assq column column-name-alist)))
-		       (cond (colp (cdr colp))
-			     ((and (integer? column)
-				   (<= 1 column column-limit))
-			      column)
-			     (else (slib:error "column not in table:"
-					       column table-name)))))))
-	      (lambda args
+	(cond
+	 ((not cat:row)
+	  (slib:warn "can't open-table:" table-name)
+	  #f)
+	 ((and writable (not mutable))
+	  (slib:warn "can't open-table for writing:" table-name)
+	  #f)
+	 (else
+	  (let ((column-limit (row-ref cat:row catalog:column-limit-pos))
+		(desc-table
+		 (base:open-table
+		  lldb
+		  (row-ref (cat:get-row
+			    base:catalog
+			    (row-ref cat:row catalog:coltab-name-pos))
+			   catalog:bastab-id-pos)
+		  1 (itypes columns:init-cols)))
+		(base-table #f)
+		(base:get #f)
+		(primary-limit 1)
+		(column-name-alist '())
+		(column-foreign-list '())
+		(column-foreign-check-list '())
+		(column-domain-list '())
+		(column-type-list '())
+		(export-alist '())
+		(cirs '())
+		(dirs '())
+		(list->key #f)
+		(key->list #f))
+
+	    (or desc-table
+		(slib:error "descriptor table doesn't exist for:" table-name))
+	    (do ((ci column-limit (+ -1 ci)))
+		((zero? ci))
+	      (let* ((des:row (des:get-row desc-table ci))
+		     (column-name (row-ref des:row columns:name-pos))
+		     (column-domain (row-ref des:row columns:domain-name-pos)))
+		(set! cirs
+		      (cons (row-eval des:row columns:integrity-rule-pos) cirs))
+		(set! column-name-alist
+		      (cons (cons column-name ci) column-name-alist))
 		(cond
-		 ((null? args) #f)
-		 ((and base:make-nexter (eq? 'isam-next (car args)))
-		  (base:make-nexter
-		   base-table primary-limit column-type-list
-		   (if (null? (cdr args))
-		       primary-limit
-		       (translate-column (cadr args)))))
-		 ((and base:make-prever (eq? 'isam-prev (car args)))
-		  (base:make-prever
-		   base-table primary-limit column-type-list
-		   (if (null? (cdr args))
-		       primary-limit
-		       (translate-column (cadr args)))))
-		 ((null? (cdr args))
-		  (let ((pp (assq (car args) export-alist)))
-		    (and pp (cdr pp))))
-		 ((not (null? (cddr args)))
-		  (slib:error "too many arguments to methods:" args))
+		 (column-domain
+		  (let ((dom:row (dom:get-row base:domains column-domain)))
+		    (set! dirs
+			  (cons (row-eval dom:row domains:integrity-rule-pos)
+				dirs))
+		    (set! column-type-list
+			  (cons (row-ref dom:row domains:type-id-pos)
+				column-type-list))
+		    (set! column-domain-list
+			  (cons column-domain column-domain-list))
+		    (set! column-foreign-list
+			  (cons (let ((foreign-name
+				       (row-ref dom:row domains:foreign-pos)))
+				  (and (not (eq? foreign-name table-name))
+				       foreign-name))
+				column-foreign-list))
+		    (set! column-foreign-check-list
+			  (cons
+			   (let ((foreign-name (car column-foreign-list)))
+			     (and foreign-name
+				  (let* ((tab (open-table foreign-name #f))
+					 (p? (and tab (tab 'get 1))))
+				    (cond
+				     ((not tab)
+				      (slib:error "foreign key table missing for:"
+						  foreign-name))
+				     ((not (= (tab 'primary-limit) 1))
+				      (slib:error "foreign key table wrong type:"
+						  foreign-name))
+				     (else p?)))))
+			   column-foreign-check-list))))
 		 (else
-		  (let ((ci (translate-column (cadr args))))
-		    (cond
-		     ((<= ci primary-limit) ;primary-key?
-		      (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
-				     key-extractor
-				     primary-limit column-type-list
-				     (norm-mkeys mkeys)))))
-			(else #f)))
-		     (else
-		      (let ((index (- ci (+ primary-limit 1)))
-			    (get-1 (base 'make-getter-1)))
-			(cond
-			 (get-1
-			  (set! get-1
-				(get-1 primary-limit column-type-list ci))
-			  (case (car args)
-			    ((get) (lambda keys
-				     (get-1 base-table (list->key keys))))
-			    ((get*) (lambda mkeys
-				      (base:map-primary-key
-				       base-table
-				       (lambda (ckey) (get-1 base-table ckey))
+		  (slib:error "missing domain for column:" ci column-name)))
+		(cond
+		 ((row-ref des:row columns:primary?-pos)
+		  (set! primary-limit (max primary-limit ci))
+		  (cond
+		   ((base:supported-key-type? (car column-type-list)))
+		   (else (slib:error "key type not supported by base tables:"
+				     (car column-type-list)))))
+		 ((base:supported-type? (car column-type-list)))
+		 (else (slib:error "type not supported by base tables:"
+				   (car column-type-list))))))
+	    (set! base-table
+		  (base:open-table lldb (row-ref cat:row catalog:bastab-id-pos)
+				   primary-limit column-type-list))
+	    (set! base:get ((basic 'make-getter) primary-limit column-type-list))
+	    (set! list->key
+		  ((basic 'make-list-keyifier) primary-limit column-type-list))
+	    (set! key->list
+		  ((basic 'make-key->list) primary-limit column-type-list))
+	    (letrec ((export-method
+		      (lambda (name proc)
+			(set! export-alist
+			      (cons (cons name proc) export-alist))))
+		     (ckey:retrieve ;ckey gets whole row (assumes exists)
+		      (if (= primary-limit column-limit) key->list
+			  (lambda (ckey) (append (key->list ckey)
+						 (base:get base-table ckey)))))
+		     (accumulate-over-table
+		      (lambda (operation)
+			(lambda mkeys (base:map-primary-key
+				       base-table operation
 				       primary-limit column-type-list
-				       (norm-mkeys mkeys))))))
-			 (else
-			  (case (car args)
-			    ((get) (lambda keys
-				     (let ((row (base:get base-table
-							  (list->key keys))))
-				       (and row (list-ref row index)))))
-			    ((get*) (lambda mkeys
+				       (norm-mkeys mkeys)))))
+		     (norm-mkeys
+		      (lambda (mkeys)
+			(define mlim (length mkeys))
+			(cond ((> mlim primary-limit)
+			       (slib:error "too many keys:" mkeys))
+			      ((= mlim primary-limit) mkeys)
+			      (else
+			       (append mkeys
+				       (do ((k (- primary-limit mlim) (+ -1 k))
+					    (result '() (cons #f result)))
+					   ((<= k 0) result))))))))
+	      (export-method
+	       'row:retrieve
+	       (if (= primary-limit column-limit)
+		   (lambda keys
+		     (let ((ckey (list->key keys)))
+		       (and (present? base-table ckey) keys)))
+		   (lambda keys
+		     (let ((vals (base:get base-table (list->key keys))))
+		       (and vals (append keys vals))))))
+	      (export-method 'row:retrieve*
+			     (accumulate-over-table
+			      (if (= primary-limit column-limit) key->list
+				  ckey:retrieve)))
+	      (export-method
+	       'for-each-row
+	       (let ((r (if (= primary-limit column-limit) key->list
+			    ckey:retrieve)))
+		 (lambda (proc . mkeys)
+		   (base:for-each-primary-key
+		    base-table (lambda (ckey) (proc (r ckey)))
+		    primary-limit column-type-list
+		    (norm-mkeys mkeys)))))
+	      (and base:ordered-for-each-key
+		   (export-method
+		    'for-each-row-in-order
+		    (let ((r (if (= primary-limit column-limit) key->list
+				 ckey:retrieve)))
+		      (lambda (proc . mkeys)
+			(base:ordered-for-each-key
+			 base-table (lambda (ckey) (proc (r ckey)))
+			 primary-limit column-type-list
+			 (norm-mkeys mkeys))))))
+	      (cond
+	       ((and mutable writable)
+		(letrec
+		    ((combine-primary-keys
+		      (cond
+		       ((and (= primary-limit column-limit)
+			     (> primary-limit 0))
+			list->key)
+		       ((eq? list->key car) list->key)
+		       (else
+			(case primary-limit
+			  ((1) (let ((keyify-1 ((base 'make-keyifier-1)
+						(car column-type-list))))
+				 (lambda (row) (keyify-1 (car row)))))
+			  ((2) (lambda (row)
+				 (list->key (list (car row) (cadr row)))))
+			  ((3) (lambda (row)
+				 (list->key (list (car row) (cadr row)
+						  (caddr row)))))
+			  (else (lambda (row)
+				  (do ((rw row (cdr rw))
+				       (nrw '() (cons (car rw) nrw))
+				       (pl (+ -1 primary-limit) (+ -1 pl)))
+				      ((negative? pl)
+				       (list->key (reverse nrw))))))))))
+		     (uir (row-eval cat:row catalog:integrity-rule-pos))
+		     (check-rules
+		      (lambda (row)
+			(if (= column-limit (length row)) #t
+			    (slib:error "bad row length:" row))
+			(for-each
+			 (lambda (cir dir value column-name column-domain
+				      foreign)
+			   (cond
+			    ((and dir (not (dir value)))
+			     (slib:error "violated domain integrity rule:"
+					 table-name column-name
+					 column-domain value))
+			    ((and cir (not (cir value)))
+			     (slib:error "violated column integrity rule:"
+					 table-name column-name value))
+			    ((and foreign (not (foreign value)))
+			     (slib:error "foreign key missing:"
+					 table-name column-name value))))
+			 cirs dirs row column-name-alist column-domain-list
+			 column-foreign-check-list)
+			(cond ((and uir (not (uir row)))
+			       (slib:error "violated user integrity rule:"
+					   row)))))
+		     (putter
+		      ((basic 'make-putter) primary-limit column-type-list))
+		     (row:insert
+		      (lambda (row)
+			(check-rules row)
+			(let ((ckey (combine-primary-keys row)))
+			  (if (present? base-table ckey)
+			      (slib:error 'row:insert "row present:" row))
+			  (putter base-table ckey
+				  (list-tail row primary-limit)))))
+		     (row:update
+		      (lambda (row)
+			(check-rules row)
+			(putter base-table (combine-primary-keys row)
+				(list-tail row primary-limit)))))
+
+		  (export-method 'row:insert row:insert)
+		  (export-method 'row:insert*
+				 (lambda (rows) (for-each row:insert rows)))
+		  (export-method 'row:update row:update)
+		  (export-method 'row:update*
+				 (lambda (rows) (for-each row:update rows))))
+
+		(letrec ((base:delete (basic 'delete))
+			 (base:delete* (basic 'delete*))
+			 (ckey:remove (lambda (ckey)
+					(let ((r (ckey:retrieve ckey)))
+					  (and r (base:delete base-table ckey))
+					  r))))
+		  (export-method 'row:remove
+				 (lambda keys
+				   (let ((ckey (list->key keys)))
+				     (and (present? base-table ckey)
+					  (ckey:remove ckey)))))
+		  (export-method 'row:delete
+				 (lambda keys
+				   (base:delete base-table (list->key keys))))
+		  (export-method 'row:remove*
+				 (accumulate-over-table ckey:remove))
+		  (export-method 'row:delete*
+				 (lambda mkeys
+				   (base:delete* base-table
+						 primary-limit column-type-list
+						 (norm-mkeys mkeys))))
+		  (export-method 'close-table
+				 (lambda () (set! base-table #f)
+					 (set! desc-table #f)
+					 (set! export-alist #f))))))
+
+	      (export-method 'column-names (map car column-name-alist))
+	      (export-method 'column-foreigns column-foreign-list)
+	      (export-method 'column-domains column-domain-list)
+	      (export-method 'column-types column-type-list)
+	      (export-method 'primary-limit primary-limit)
+
+	      (let ((translate-column
+		     (lambda (column)
+		       (let ((colp (assq column column-name-alist)))
+			 (cond (colp (cdr colp))
+			       ((and (integer? column)
+				     (<= 1 column column-limit))
+				column)
+			       (else (slib:error "column not in table:"
+						 column table-name)))))))
+		(lambda args
+		  (cond
+		   ((null? args) #f)
+		   ((and base:make-nexter (eq? 'isam-next (car args)))
+		    (base:make-nexter
+		     base-table primary-limit column-type-list
+		     (if (null? (cdr args))
+			 primary-limit
+			 (translate-column (cadr args)))))
+		   ((and base:make-prever (eq? 'isam-prev (car args)))
+		    (base:make-prever
+		     base-table primary-limit column-type-list
+		     (if (null? (cdr args))
+			 primary-limit
+			 (translate-column (cadr args)))))
+		   ((null? (cdr args))
+		    (let ((pp (assq (car args) export-alist)))
+		      (and pp (cdr pp))))
+		   ((not (null? (cddr args)))
+		    (slib:error "too many arguments to methods:" args))
+		   (else
+		    (let ((ci (translate-column (cadr args))))
+		      (cond
+		       ((<= ci primary-limit) ;primary-key?
+			(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)
-					 (list-ref (base:get base-table ckey)
-						   index))
+				       key-extractor
 				       primary-limit column-type-list
-				       (norm-mkeys mkeys))))
-			    (else #f)))))))))))))))
+				       (norm-mkeys mkeys)))))
+			  (else #f)))
+		       (else
+			(let ((index (- ci (+ primary-limit 1)))
+			      (get-1 (base 'make-getter-1)))
+			  (cond
+			   (get-1
+			    (set! get-1
+				  (get-1 primary-limit column-type-list ci))
+			    (case (car args)
+			      ((get) (lambda keys
+				       (get-1 base-table (list->key keys))))
+			      ((get*) (lambda mkeys
+					(base:map-primary-key
+					 base-table
+					 (lambda (ckey) (get-1 base-table ckey))
+					 primary-limit column-type-list
+					 (norm-mkeys mkeys))))))
+			   (else
+			    (case (car args)
+			      ((get) (lambda keys
+				       (let ((row (base:get base-table
+							    (list->key keys))))
+					 (and row (list-ref row index)))))
+			      ((get*) (lambda mkeys
+					(base:map-primary-key
+					 base-table
+					 (lambda (ckey)
+					   (list-ref (base:get base-table ckey)
+						     index))
+					 primary-limit column-type-list
+					 (norm-mkeys mkeys))))
+			      (else #f)))))))))))))))))
 
       (define create-table
 	(and