Changeset 14767 for release/4/postgresql/trunk/postgresql.scm

Timestamp:

05/25/09 01:12:16 (16 months ago)

Author:

sjamaan

Message:

Add highlevel alternatives to fold/loop/map through columns instead of rows

Files:

• release/4/postgresql/trunk/postgresql.scm (modified) (5 diffs)

release/4/postgresql/trunk/postgresql.scm

@@ -27 +27 @@
   connect reset-connection disconnect connection?
   
-  simple-queries query query*
+  multi-query query query*
   
   result? clear-result! row-count column-count
@@ -39 +39 @@
   
   row-fold row-fold* row-fold-right row-fold-right*
-  row-for-each row-for-each* row-map row-map*)
+  row-for-each row-for-each* row-map row-map*
+  column-fold column-fold* column-fold-right column-fold-right*
+  column-for-each column-for-each* column-map column-map*)
 
 (import chicken scheme foreign)
@@ -534 +536 @@
           (reverse! results)))))
 
-(define (simple-queries conn query)
+(define (multi-query conn queries)
   (if ((foreign-lambda bool PQsendQuery pgconn* (const c-string))
-       (pg-connection-ptr conn) query)
+       (pg-connection-ptr conn) queries)
       (collect-results conn)
-      (postgresql-error 'exec-simple-queries
-                        (conc "Unable to send query to server. "
+      (postgresql-error 'multi-query
+                        (conc "Unable to send multi-query to server. "
                               (PQerrorMessage (pg-connection-ptr conn)))
-                        conn query)))
+                        conn queries)))
 
 (define (query conn query . params)
@@ -686 +688 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (row-fold kons knil result)
-  (let ((rows (row-count result)))
-    (let loop ((seed knil)
-               (row 0))
-      (if (= row rows)
-          seed
-          (loop (kons (row-values result row) seed) (add1 row))))))
+(define (make-result-fold item-count extract-item)
+  (lambda (kons knil result)
+   (let ((items (item-count result)))
+     (let loop ((seed knil)
+                (item 0))
+       (if (= item items)
+           seed
+           (loop (kons (extract-item result item) seed) (add1 item)))))))
+
+(define row-fold (make-result-fold row-count row-values))
 (define (row-fold* kons knil result)
   (row-fold (lambda (values seed)
               (apply kons (append values (list seed)))) knil result))
 
-(define (row-fold-right kons knil result)
-  (let ((rows (row-count result)))
-    (let loop ((seed knil)
-               (row 0))
-      (if (= row rows)
-          seed
-          (kons (row-values result row) (loop seed (add1 row)))))))
+(define column-fold (make-result-fold column-count column-values))
+(define (column-fold* kons knil result)
+  (column-fold (lambda (values seed)
+                 (apply kons (append values (list seed)))) knil result))
+
+
+(define (make-result-fold-right item-count extract-item)
+  (lambda (kons knil result)
+    (let ((items (item-count result)))
+      (let loop ((seed knil)
+                 (item 0))
+        (if (= item items)
+            seed
+            (kons (extract-item result item) (loop seed (add1 item))))))))
+
+(define row-fold-right (make-result-fold-right row-count row-values))
 (define (row-fold-right* kons knil result)
   (row-fold-right (lambda (val seed)
                     (apply kons (append val (list seed)))) knil result))
+
+(define column-fold-right (make-result-fold-right column-count column-values))
+(define (column-fold-right* kons knil result)
+  (column-fold-right (lambda (values seed)
+                       (apply kons (append values (list seed)))) knil result))
+
 
 (define (row-for-each proc result)
@@ -715 +735 @@
   (void))
 
+(define (column-for-each proc result)
+  (column-fold (lambda (values seed) (proc values)) #f result)
+  (void))
+(define (column-for-each* proc result)
+  (column-fold (lambda (values seed) (apply proc values)) #f result)
+  (void))
+
+
 ;; Like regular Scheme map, the order in which the procedure is applied is
 ;; undefined.  We make good use of that by traversing the resultset from
 ;; the end back to the beginning, thereby avoiding a reverse! on the result.
-(define (row-map proc result)
-  (let loop ((lst '())
-             (row (row-count result)))
-    (if (= row 0)
-        lst
-        (loop (cons (proc (row-values result (sub1 row))) lst) (sub1 row)))))
+(define (make-result-map item-count extract-item)
+  (lambda (proc result)
+    (let loop ((lst '())
+               (item (item-count result)))
+      (if (= item 0)
+          lst
+          (loop (cons (proc (extract-item result (sub1 item))) lst) (sub1 item))))))
+(define row-map (make-result-map row-count row-values))
 (define (row-map* proc result)
   (row-map (lambda (values) (apply proc values)) result))
+(define column-map (make-result-map column-count column-values))
+(define (column-map* proc result)
+  (row-map (lambda (values) (apply proc values)) result))
 
 )