Changeset 14759 in project


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

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

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

Legend:

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

    r14758 r14759  
    3838  escape-string escape-bytea unescape-bytea
    3939 
    40   query-fold query-fold* query-for-each query-for-each*)
     40  query-fold query-fold* query-fold-right query-fold-right*
     41  query-for-each query-for-each* query-map query-map*)
    4142
    4243(import chicken scheme foreign)
     
    743744          (loop (kons (result-values result row) seed) (add1 row))))))
    744745
     746(define (query-fold-right kons knil conn query #!optional (params '()))
     747  (let* ((result (exec-query conn query params))
     748         (rows (result-row-count result)))
     749    (let loop ((seed knil)
     750               (row 0))
     751      (if (= row rows)
     752          seed
     753          (kons (result-values result row) (loop seed (add1 row)))))))
     754
    745755(define (query-fold* kons knil conn query #!optional (params '()))
    746756  (query-fold (lambda (values seed) (apply kons (append values (list seed))))
    747757              knil conn query params))
     758(define (query-fold-right* kons knil conn query #!optional (params '()))
     759  (query-fold-right (lambda (val seed) (apply kons (append val (list seed))))
     760              knil conn query params))
    748761
    749762(define (query-for-each proc conn query #!optional (params '()))
     
    755768  (void))
    756769
     770;; Like regular Scheme map, the order in which the procedure is applied is
     771;; undefined.  We make good use of that by traversing the resultset from
     772;; the end back to the beginning, thereby avoiding a reverse! on the result.
     773(define (query-map proc conn query #!optional (params '()))
     774  (let ((result (exec-query conn query params)))
     775    (let loop ((output '())
     776               (row (result-row-count result)))
     777      (if (= row 0)
     778          output
     779          (loop (cons (proc (result-values result (sub1 row))) output)
     780                (sub1 row))))))
     781
     782(define (query-map* proc conn query #!optional (params '()))
     783  (query-map (lambda (values seed) (apply proc values)) #f conn query params))
     784
    757785)
  • release/4/postgresql/trunk/tests/run.scm

    r14758 r14759  
    260260          ("three" "four"))
    261261        (reverse
    262          (query-fold cons '()
    263                      conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'"))))
     262         (query-fold
     263          cons '() conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'")))
     264  (test "query-fold-right"
     265        '(("one" "two")
     266          ("three" "four"))
     267        (query-fold-right
     268         cons '() conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'"))
     269  (test "query-for-each"
     270        '(("one" "two")
     271          ("three" "four"))
     272        (let ((res '()))
     273          (query-for-each
     274           (lambda (row) (set! res (cons row res)))
     275           conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'")
     276          (reverse res)))
     277  (test "query-map"
     278        '(("one" "two")
     279          ("three" "four"))
     280        (query-map
     281         identity conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'")))
Note: See TracChangeset for help on using the changeset viewer.