Changeset 14767 in project


Ignore:
Timestamp:
05/24/09 18:12:16 (10 years ago)
Author:
sjamaan
Message:

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

Location:
release/4/postgresql/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/postgresql/trunk/postgresql.scm

    r14766 r14767  
    2727  connect reset-connection disconnect connection?
    2828 
    29   simple-queries query query*
     29  multi-query query query*
    3030 
    3131  result? clear-result! row-count column-count
     
    3939 
    4040  row-fold row-fold* row-fold-right row-fold-right*
    41   row-for-each row-for-each* row-map row-map*)
     41  row-for-each row-for-each* row-map row-map*
     42  column-fold column-fold* column-fold-right column-fold-right*
     43  column-for-each column-for-each* column-map column-map*)
    4244
    4345(import chicken scheme foreign)
     
    534536          (reverse! results)))))
    535537
    536 (define (simple-queries conn query)
     538(define (multi-query conn queries)
    537539  (if ((foreign-lambda bool PQsendQuery pgconn* (const c-string))
    538        (pg-connection-ptr conn) query)
     540       (pg-connection-ptr conn) queries)
    539541      (collect-results conn)
    540       (postgresql-error 'exec-simple-queries
    541                         (conc "Unable to send query to server. "
     542      (postgresql-error 'multi-query
     543                        (conc "Unable to send multi-query to server. "
    542544                              (PQerrorMessage (pg-connection-ptr conn)))
    543                         conn query)))
     545                        conn queries)))
    544546
    545547(define (query conn query . params)
     
    686688;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    687689
    688 (define (row-fold kons knil result)
    689   (let ((rows (row-count result)))
    690     (let loop ((seed knil)
    691                (row 0))
    692       (if (= row rows)
    693           seed
    694           (loop (kons (row-values result row) seed) (add1 row))))))
     690(define (make-result-fold item-count extract-item)
     691  (lambda (kons knil result)
     692   (let ((items (item-count result)))
     693     (let loop ((seed knil)
     694                (item 0))
     695       (if (= item items)
     696           seed
     697           (loop (kons (extract-item result item) seed) (add1 item)))))))
     698
     699(define row-fold (make-result-fold row-count row-values))
    695700(define (row-fold* kons knil result)
    696701  (row-fold (lambda (values seed)
    697702              (apply kons (append values (list seed)))) knil result))
    698703
    699 (define (row-fold-right kons knil result)
    700   (let ((rows (row-count result)))
    701     (let loop ((seed knil)
    702                (row 0))
    703       (if (= row rows)
    704           seed
    705           (kons (row-values result row) (loop seed (add1 row)))))))
     704(define column-fold (make-result-fold column-count column-values))
     705(define (column-fold* kons knil result)
     706  (column-fold (lambda (values seed)
     707                 (apply kons (append values (list seed)))) knil result))
     708
     709
     710(define (make-result-fold-right item-count extract-item)
     711  (lambda (kons knil result)
     712    (let ((items (item-count result)))
     713      (let loop ((seed knil)
     714                 (item 0))
     715        (if (= item items)
     716            seed
     717            (kons (extract-item result item) (loop seed (add1 item))))))))
     718
     719(define row-fold-right (make-result-fold-right row-count row-values))
    706720(define (row-fold-right* kons knil result)
    707721  (row-fold-right (lambda (val seed)
    708722                    (apply kons (append val (list seed)))) knil result))
     723
     724(define column-fold-right (make-result-fold-right column-count column-values))
     725(define (column-fold-right* kons knil result)
     726  (column-fold-right (lambda (values seed)
     727                       (apply kons (append values (list seed)))) knil result))
     728
    709729
    710730(define (row-for-each proc result)
     
    715735  (void))
    716736
     737(define (column-for-each proc result)
     738  (column-fold (lambda (values seed) (proc values)) #f result)
     739  (void))
     740(define (column-for-each* proc result)
     741  (column-fold (lambda (values seed) (apply proc values)) #f result)
     742  (void))
     743
     744
    717745;; Like regular Scheme map, the order in which the procedure is applied is
    718746;; undefined.  We make good use of that by traversing the resultset from
    719747;; the end back to the beginning, thereby avoiding a reverse! on the result.
    720 (define (row-map proc result)
    721   (let loop ((lst '())
    722              (row (row-count result)))
    723     (if (= row 0)
    724         lst
    725         (loop (cons (proc (row-values result (sub1 row))) lst) (sub1 row)))))
     748(define (make-result-map item-count extract-item)
     749  (lambda (proc result)
     750    (let loop ((lst '())
     751               (item (item-count result)))
     752      (if (= item 0)
     753          lst
     754          (loop (cons (proc (extract-item result (sub1 item))) lst) (sub1 item))))))
     755(define row-map (make-result-map row-count row-values))
    726756(define (row-map* proc result)
    727757  (row-map (lambda (values) (apply proc values)) result))
     758(define column-map (make-result-map column-count column-values))
     759(define (column-map* proc result)
     760  (row-map (lambda (values) (apply proc values)) result))
    728761
    729762)
  • release/4/postgresql/trunk/tests/run.scm

    r14766 r14767  
    3333  (test-assert "query returns result"
    3434               (result? (query conn "SELECT 1")))
    35   (test "simple queries return several results"
     35  (test "multi-query returns several results"
    3636        2
    37         (length (simple-queries conn "SELECT 10; SELECT 100")))
     37        (length (multi-query conn "SELECT 10; SELECT 100")))
    3838  (test "Correct row count"
    3939        2
     
    273273                 "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
    274274                 "one" 2))))
     275  (test "column-fold"
     276        '(("one" "three")
     277          (2 4))
     278        (reverse
     279         (column-fold
     280          cons '()
     281          (query conn
     282                 "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
     283                 "one" 2))))
    275284  (test "row-fold-right"
    276285        '(("one" 2)
    277286          ("three" 4))
    278287        (row-fold-right
     288         cons '()
     289         (query conn
     290                "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
     291                "one" 2)))
     292  (test "column-fold-right"
     293        '(("one" "three")
     294          (2 4))
     295        (column-fold-right
    279296         cons '()
    280297         (query conn
     
    291308            "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))
    292309          (reverse res)))
     310  (test "column-for-each"
     311        '(("one" "three")
     312          (2 4))
     313        (let ((res '()))
     314          (column-for-each
     315           (lambda (col) (set! res (cons col res)))
     316           (query
     317            conn
     318            "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))
     319          (reverse res)))
    293320  (test "row-map"
    294321        '(("one" 2)
     
    297324         identity
    298325         (query conn
     326                "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2)))
     327  (test "column-map"
     328        '(("one" "three")
     329          (2 4))
     330        (column-map
     331         identity
     332         (query conn
    299333                "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))))
Note: See TracChangeset for help on using the changeset viewer.