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

Timestamp:

05/24/09 20:58:12 (16 months ago)

Author:

sjamaan

Message:

Add query-map and query-fold-right to the high-level procedures

Files:

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

release/4/postgresql/trunk/postgresql.scm

@@ -38 +38 @@
   escape-string escape-bytea unescape-bytea
   
-  query-fold query-fold* query-for-each query-for-each*)
+  query-fold query-fold* query-fold-right query-fold-right*
+  query-for-each query-for-each* query-map query-map*)
 
 (import chicken scheme foreign)
@@ -743 +744 @@
           (loop (kons (result-values result row) seed) (add1 row))))))
 
+(define (query-fold-right kons knil conn query #!optional (params '()))
+  (let* ((result (exec-query conn query params))
+         (rows (result-row-count result)))
+    (let loop ((seed knil)
+               (row 0))
+      (if (= row rows)
+          seed
+          (kons (result-values result row) (loop seed (add1 row)))))))
+
 (define (query-fold* kons knil conn query #!optional (params '()))
   (query-fold (lambda (values seed) (apply kons (append values (list seed))))
               knil conn query params))
+(define (query-fold-right* kons knil conn query #!optional (params '()))
+  (query-fold-right (lambda (val seed) (apply kons (append val (list seed))))
+              knil conn query params))
 
 (define (query-for-each proc conn query #!optional (params '()))
@@ -755 +768 @@
   (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 (query-map proc conn query #!optional (params '()))
+  (let ((result (exec-query conn query params)))
+    (let loop ((output '())
+               (row (result-row-count result)))
+      (if (= row 0)
+          output
+          (loop (cons (proc (result-values result (sub1 row))) output)
+                (sub1 row))))))
+
+(define (query-map* proc conn query #!optional (params '()))
+  (query-map (lambda (values seed) (apply proc values)) #f conn query params))
+
 )