sqlite3.scm.in 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611
  1. ;; Guile-SQLite3
  2. ;; Copyright (C) 2010, 2014 Andy Wingo <wingo at pobox dot com>
  3. ;; Copyright (C) 2018 Ludovic Courtès <ludo@gnu.org>
  4. ;; This library is free software; you can redistribute it and/or modify
  5. ;; it under the terms of the GNU Lesser General Public License as
  6. ;; published by the Free Software Foundation; either version 3 of the
  7. ;; License, or (at your option) any later version.
  8. ;;
  9. ;; This library is distributed in the hope that it will be useful, but
  10. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12. ;; Lesser General Public License for more details.
  13. ;;
  14. ;; You should have received a copy of the GNU Lesser General Public
  15. ;; License along with this program; if not, contact:
  16. ;;
  17. ;; Free Software Foundation Voice: +1-617-542-5942
  18. ;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
  19. ;; Boston, MA 02111-1307, USA gnu@gnu.org
  20. ;;; Commentary:
  21. ;;
  22. ;; A Guile binding for sqlite.
  23. ;;
  24. ;;; Code:
  25. (define-module (sqlite3)
  26. #:use-module (system foreign)
  27. #:use-module (rnrs bytevectors)
  28. #:use-module (ice-9 match)
  29. #:use-module (srfi srfi-1)
  30. #:use-module (srfi srfi-9)
  31. #:use-module (srfi srfi-19)
  32. #:export (sqlite-open
  33. sqlite-db?
  34. sqlite-close
  35. sqlite-enable-load-extension
  36. sqlite-exec
  37. sqlite-prepare
  38. sqlite-bind
  39. sqlite-bind-arguments
  40. sqlite-column-names
  41. sqlite-step
  42. sqlite-fold
  43. sqlite-fold-right
  44. sqlite-map
  45. sqlite-reset
  46. sqlite-finalize
  47. sqlite-bind-parameter-index
  48. sqlite-busy-timeout
  49. SQLITE_OPEN_READONLY
  50. SQLITE_OPEN_READWRITE
  51. SQLITE_OPEN_CREATE
  52. SQLITE_OPEN_DELETEONCLOSE
  53. SQLITE_OPEN_EXCLUSIVE
  54. SQLITE_OPEN_MAIN_DB
  55. SQLITE_OPEN_TEMP_DB
  56. SQLITE_OPEN_TRANSIENT_DB
  57. SQLITE_OPEN_MAIN_JOURNAL
  58. SQLITE_OPEN_TEMP_JOURNAL
  59. SQLITE_OPEN_SUBJOURNAL
  60. SQLITE_OPEN_MASTER_JOURNAL
  61. SQLITE_OPEN_NOMUTEX
  62. SQLITE_OPEN_FULLMUTEX
  63. SQLITE_OPEN_SHAREDCACHE
  64. SQLITE_OPEN_PRIVATECACHE
  65. SQLITE_OPEN_URI
  66. SQLITE_CONSTRAINT
  67. SQLITE_CONSTRAINT_PRIMARYKEY
  68. SQLITE_CONSTRAINT_UNIQUE))
  69. ;;
  70. ;; Utils
  71. ;;
  72. (define (string->utf8-pointer s)
  73. (string->pointer s "utf-8"))
  74. (define (utf8-pointer->string p)
  75. (pointer->string p -1 "utf-8"))
  76. ;;
  77. ;; Constants
  78. ;;
  79. ;; FIXME: snarf using compiler. These are just copied from the header...
  80. ;;
  81. (define SQLITE_OPEN_READONLY #x00000001) ;; Ok for sqlite3_open_v2()
  82. (define SQLITE_OPEN_READWRITE #x00000002) ;; Ok for sqlite3_open_v2()
  83. (define SQLITE_OPEN_CREATE #x00000004) ;; Ok for sqlite3_open_v2()
  84. (define SQLITE_OPEN_DELETEONCLOSE #x00000008) ;; VFS only
  85. (define SQLITE_OPEN_EXCLUSIVE #x00000010) ;; VFS only
  86. (define SQLITE_OPEN_MAIN_DB #x00000100) ;; VFS only
  87. (define SQLITE_OPEN_TEMP_DB #x00000200) ;; VFS only
  88. (define SQLITE_OPEN_TRANSIENT_DB #x00000400) ;; VFS only
  89. (define SQLITE_OPEN_MAIN_JOURNAL #x00000800) ;; VFS only
  90. (define SQLITE_OPEN_TEMP_JOURNAL #x00001000) ;; VFS only
  91. (define SQLITE_OPEN_SUBJOURNAL #x00002000) ;; VFS only
  92. (define SQLITE_OPEN_MASTER_JOURNAL #x00004000) ;; VFS only
  93. (define SQLITE_OPEN_NOMUTEX #x00008000) ;; Ok for sqlite3_open_v2()
  94. (define SQLITE_OPEN_FULLMUTEX #x00010000) ;; Ok for sqlite3_open_v2()
  95. (define SQLITE_OPEN_SHAREDCACHE #x00020000) ;; Ok for sqlite3_open_v2()
  96. (define SQLITE_OPEN_PRIVATECACHE #x00040000) ;; Ok for sqlite3_open_v2()
  97. (define SQLITE_OPEN_URI #x00000040) ;; Ok for sqlite3_open_v2()
  98. (define SQLITE_CONSTRAINT 19)
  99. (define SQLITE_CONSTRAINT_PRIMARYKEY
  100. (logior SQLITE_CONSTRAINT (ash 6 8)))
  101. (define SQLITE_CONSTRAINT_UNIQUE
  102. (logior SQLITE_CONSTRAINT (ash 8 8)))
  103. (define libsqlite3 (dynamic-link "@SQLITE_LIBDIR@/libsqlite3"))
  104. (define-record-type <sqlite-db>
  105. (make-db pointer open? stmts)
  106. db?
  107. (pointer db-pointer)
  108. (open? db-open? set-db-open?!)
  109. (stmts db-stmts))
  110. (define-syntax sqlite-db?
  111. (identifier-syntax db?))
  112. (define-record-type <sqlite-stmt>
  113. (make-stmt pointer live? reset? cached?)
  114. stmt?
  115. (pointer stmt-pointer)
  116. (live? stmt-live? set-stmt-live?!)
  117. (reset? stmt-reset? set-stmt-reset?!)
  118. (cached? stmt-cached? set-stmt-cached?!))
  119. (define sqlite-errmsg
  120. (let ((f (pointer->procedure
  121. '*
  122. (dynamic-func "sqlite3_errmsg" libsqlite3)
  123. (list '*))))
  124. (lambda (db)
  125. (utf8-pointer->string (f (db-pointer db))))))
  126. (define sqlite-errcode
  127. (let ((f (pointer->procedure
  128. int
  129. (dynamic-func "sqlite3_extended_errcode" libsqlite3)
  130. (list '*))))
  131. (lambda (db)
  132. (f (db-pointer db)))))
  133. (define* (sqlite-error db who #:optional code
  134. (errmsg (and db (sqlite-errmsg db))))
  135. (throw 'sqlite-error who code errmsg))
  136. (define* (check-error db #:optional who)
  137. (let ((code (sqlite-errcode db)))
  138. (if (not (zero? code))
  139. (sqlite-error db who code))))
  140. (define sqlite-close
  141. (let ((f (pointer->procedure
  142. int
  143. (dynamic-func "sqlite3_close" libsqlite3)
  144. (list '*))))
  145. (lambda (db)
  146. (when (db-open? db)
  147. ;; Finalize cached statements.
  148. (hash-for-each (lambda (sql stmt)
  149. (set-stmt-cached?! stmt #f)
  150. (sqlite-finalize stmt))
  151. (db-stmts db))
  152. (hash-clear! (db-stmts db))
  153. (let ((p (db-pointer db)))
  154. (set-db-open?! db #f)
  155. (f p))))))
  156. (define db-guardian (make-guardian))
  157. (define (pump-db-guardian)
  158. (let ((db (db-guardian)))
  159. (if db
  160. (begin
  161. (sqlite-close db)
  162. (pump-db-guardian)))))
  163. (add-hook! after-gc-hook pump-db-guardian)
  164. (define (static-errcode->errmsg code)
  165. (case code
  166. ((1) "SQL error or missing database")
  167. ((2) "Internal logic error in SQLite")
  168. ((3) "Access permission denied")
  169. ((5) "The database file is locked")
  170. ((6) "A table in the database is locked")
  171. ((7) "A malloc() failed")
  172. ((8) "Attempt to write a readonly database")
  173. ((10) "Some kind of disk I/O error occurred")
  174. ((11) "The database disk image is malformed")
  175. ((14) "Unable to open the database file")
  176. ((21) "Library used incorrectly")
  177. ((22) "Uses OS features not supported on host")
  178. ((23) "Authorization denied")
  179. ((24) "Auxiliary database format error")
  180. ((26) "File opened that is not a database file")
  181. (else "Unknown error")))
  182. (define sqlite-open
  183. (let ((f (pointer->procedure
  184. int
  185. (dynamic-func "sqlite3_open_v2" libsqlite3)
  186. (list '* '* int '*))))
  187. (lambda* (filename #:optional
  188. (flags (logior SQLITE_OPEN_READWRITE
  189. SQLITE_OPEN_CREATE
  190. SQLITE_OPEN_URI))
  191. (vfs #f))
  192. (let* ((out-db (bytevector->pointer (make-bytevector (sizeof '*) 0)))
  193. (ret (f (string->utf8-pointer filename)
  194. out-db
  195. flags
  196. (if vfs (string->utf8-pointer vfs) %null-pointer))))
  197. (if (zero? ret)
  198. (let ((db (make-db (dereference-pointer out-db) #t
  199. (make-hash-table))))
  200. (db-guardian db)
  201. db)
  202. (sqlite-error #f 'sqlite-open ret (static-errcode->errmsg ret)))))))
  203. (define sqlite-enable-load-extension
  204. (let ((ele (pointer->procedure
  205. int
  206. (dynamic-func "sqlite3_enable_load_extension" libsqlite3)
  207. (list '* int))))
  208. (lambda (db onoff)
  209. (ele (db-pointer db) onoff))))
  210. (define sqlite-exec
  211. (let ((exec (pointer->procedure
  212. int
  213. (dynamic-func "sqlite3_exec" (@@ (sqlite3) libsqlite3))
  214. '(* * * * *))))
  215. (lambda* (db sql)
  216. "Evaluate the string SQL, which may contain one or several SQL
  217. statements, into DB. The result is unspecified."
  218. ;; XXX: 'sqlite3_exec' has a 'callback' parameter but we ignore it
  219. ;; here.
  220. (assert-live-db! db)
  221. (unless (zero? (exec (db-pointer db) (string->pointer sql)
  222. %null-pointer %null-pointer %null-pointer))
  223. (check-error db 'sqlite-exec)))))
  224. ;;;
  225. ;;; SQL statements
  226. ;;;
  227. (define sqlite-remove-statement!
  228. (lambda (db stmt)
  229. (when (stmt-cached? stmt)
  230. (let* ((stmts (db-stmts db))
  231. (key (catch 'value
  232. (lambda ()
  233. (hash-for-each (lambda (key value)
  234. (when (eq? value stmt)
  235. (throw 'value key)))
  236. stmts)
  237. #f)
  238. (lambda (_ key) key))))
  239. (hash-remove! stmts key)))))
  240. (define sqlite-finalize
  241. (let ((f (pointer->procedure
  242. int
  243. (dynamic-func "sqlite3_finalize" libsqlite3)
  244. (list '*))))
  245. (lambda (stmt)
  246. ;; Note: When STMT is cached, this merely resets. This ensures caching
  247. ;; actually works while still separating concerns: users can turn caching
  248. ;; on and off without having to change the rest of their code.
  249. (when (stmt-live? stmt)
  250. (if (stmt-cached? stmt)
  251. ;; It's necessary to reset cached statements due to the following:
  252. ;;
  253. ;; "An implicit transaction (a transaction that is started
  254. ;; automatically, not a transaction started by BEGIN) is committed
  255. ;; automatically when the last active statement finishes. A statement
  256. ;; finishes when its last cursor closes, which is guaranteed to happen
  257. ;; when the prepared statement is reset or finalized. Some statements
  258. ;; might "finish" for the purpose of transaction control prior to
  259. ;; being reset or finalized, but there is no guarantee of this."
  260. ;;
  261. ;; (see https://www.sqlite.org/lang_transaction.html)
  262. ;;
  263. ;; Thus, it's possible for an implicitly-started transaction to hang
  264. ;; around until sqlite-reset is called when the cached statement is
  265. ;; next used. Because the transaction is committed automatically only
  266. ;; when the *last active statement* finishes, the implicitly-started
  267. ;; transaction may later be upgraded to a write transaction (!) and
  268. ;; this non-reset statement will still be keeping the transaction from
  269. ;; committing until it is next used or the database connection is
  270. ;; closed. This has the potential to make (exclusive) write access to
  271. ;; the database necessary for much longer than it should be.
  272. ;;
  273. ;; So it's necessary to preserve the statement-finishing behavior of
  274. ;; sqlite_finalize here, which we do by calling sqlite-reset.
  275. (sqlite-reset stmt)
  276. (let ((p (stmt-pointer stmt)))
  277. (sqlite-remove-statement! (stmt->db stmt) stmt)
  278. (set-stmt-live?! stmt #f)
  279. (f p)))))))
  280. (define *stmt-map* (make-weak-key-hash-table))
  281. (define (stmt->db stmt)
  282. (hashq-ref *stmt-map* stmt))
  283. (define stmt-guardian (make-guardian))
  284. (define (pump-stmt-guardian)
  285. (let ((stmt (stmt-guardian)))
  286. (if stmt
  287. (begin
  288. (sqlite-finalize stmt)
  289. (pump-stmt-guardian)))))
  290. (add-hook! after-gc-hook pump-stmt-guardian)
  291. (define sqlite-reset
  292. (let ((reset (pointer->procedure
  293. int
  294. (dynamic-func "sqlite3_reset" libsqlite3)
  295. (list '*))))
  296. (lambda (stmt)
  297. (if (stmt-live? stmt)
  298. (let ((p (stmt-pointer stmt)))
  299. (set-stmt-reset?! stmt #t)
  300. (reset p))
  301. (error "statement already finalized" stmt)))))
  302. (define (assert-live-stmt! stmt)
  303. (if (not (stmt-live? stmt))
  304. (error "statement already finalized" stmt)))
  305. (define (assert-live-db! db)
  306. (if (not (db-open? db))
  307. (error "database already closed" db)))
  308. (define %sqlite-prepare
  309. (let ((prepare (pointer->procedure
  310. int
  311. (dynamic-func "sqlite3_prepare_v2" libsqlite3)
  312. (list '* '* int '* '*))))
  313. (lambda* (db sql #:key cache?)
  314. (assert-live-db! db)
  315. (let* ((out-stmt (bytevector->pointer (make-bytevector (sizeof '*) 0)))
  316. (out-tail (bytevector->pointer (make-bytevector (sizeof '*) 0)))
  317. (bv (string->utf8 sql))
  318. (bvp (bytevector->pointer bv))
  319. (ret (prepare (db-pointer db)
  320. bvp
  321. (bytevector-length bv)
  322. out-stmt
  323. out-tail)))
  324. (if (zero? ret)
  325. (if (= (bytevector-length bv)
  326. (- (pointer-address (dereference-pointer out-tail))
  327. (pointer-address bvp)))
  328. (let ((stmt (make-stmt (dereference-pointer out-stmt) #t #t
  329. cache?)))
  330. (stmt-guardian stmt)
  331. (hashq-set! *stmt-map* stmt db)
  332. stmt)
  333. (error "input sql has useless tail"
  334. (utf8-pointer->string
  335. (dereference-pointer out-tail))))
  336. (check-error db 'sqlite-prepare))))))
  337. (define* (sqlite-prepare db sql #:key cache?)
  338. (if cache?
  339. (match (hash-ref (db-stmts db) sql)
  340. (#f
  341. (let ((stmt (%sqlite-prepare db sql #:cache? #t)))
  342. (hash-set! (db-stmts db) sql stmt)
  343. stmt))
  344. (stmt
  345. (sqlite-reset stmt)
  346. stmt))
  347. (%sqlite-prepare db sql)))
  348. (define sqlite-bind-parameter-index
  349. (let ((bind-parameter-index (pointer->procedure
  350. int
  351. (dynamic-func "sqlite3_bind_parameter_index" libsqlite3)
  352. (list '* '*))))
  353. (lambda (stmt name)
  354. (assert-live-stmt! stmt)
  355. (let* ((ret (bind-parameter-index (stmt-pointer stmt)
  356. (string->utf8-pointer name))))
  357. (if (> ret 0)
  358. ret
  359. (begin
  360. (check-error (stmt->db stmt) 'sqlite-bind-parameter-index)
  361. (write ret)
  362. (newline)
  363. (error "No such parameter" name)))))))
  364. (define key->index
  365. (lambda (stmt key)
  366. (cond
  367. ((string? key) (sqlite-bind-parameter-index stmt key))
  368. ((symbol? key) (sqlite-bind-parameter-index stmt
  369. (string-append ":" (symbol->string key))))
  370. (else key))))
  371. (define sqlite-bind
  372. (let ((bind-blob (pointer->procedure
  373. int
  374. (dynamic-func "sqlite3_bind_blob" libsqlite3)
  375. (list '* int '* int '*)))
  376. (bind-text (pointer->procedure
  377. int
  378. (dynamic-func "sqlite3_bind_text" libsqlite3)
  379. (list '* int '* int '*)))
  380. (bind-int64 (pointer->procedure
  381. int
  382. (dynamic-func "sqlite3_bind_int64" libsqlite3)
  383. (list '* int int64)))
  384. (bind-double (pointer->procedure
  385. int
  386. (dynamic-func "sqlite3_bind_double" libsqlite3)
  387. (list '* int double)))
  388. (bind-null (pointer->procedure
  389. int
  390. (dynamic-func "sqlite3_bind_null" libsqlite3)
  391. (list '* int)))
  392. (sqlite-transient (make-pointer
  393. (bit-extract (lognot 0) 0 (* 8 (sizeof '*))))))
  394. (lambda (stmt key val)
  395. (assert-live-stmt! stmt)
  396. (let ((idx (key->index stmt key))
  397. (p (stmt-pointer stmt)))
  398. (cond
  399. ((bytevector? val)
  400. (bind-blob p idx (bytevector->pointer val) (bytevector-length val)
  401. sqlite-transient))
  402. ((string? val)
  403. (let ((bv (string->utf8 val)))
  404. (bind-text p idx (bytevector->pointer bv) (bytevector-length bv)
  405. sqlite-transient)))
  406. ((and (integer? val) (exact? val))
  407. (bind-int64 p idx val))
  408. ((number? val)
  409. (bind-double p idx (exact->inexact val)))
  410. ((not val)
  411. (bind-null p idx))
  412. (else
  413. (error "unexpected value" val)))
  414. (check-error (stmt->db stmt))))))
  415. (define (sqlite-bind-arguments stmt . args)
  416. "Bind STMT parameters, one after another, to ARGS.
  417. Also bind named parameters to the respective ones."
  418. (let loop ((i 1)
  419. (args args))
  420. (match args
  421. (()
  422. #f)
  423. (((? keyword? kw) value . rest)
  424. (sqlite-bind stmt (keyword->symbol kw) value)
  425. (loop i rest))
  426. ((arg . rest)
  427. (sqlite-bind stmt i arg)
  428. (loop (+ 1 i) rest)))))
  429. (define sqlite-column-count
  430. (let ((column-count
  431. (pointer->procedure
  432. int
  433. (dynamic-pointer "sqlite3_column_count" libsqlite3)
  434. (list '*))))
  435. (lambda (stmt)
  436. (assert-live-stmt! stmt)
  437. (column-count (stmt-pointer stmt)))))
  438. (define sqlite-column-name
  439. (let ((column-name
  440. (pointer->procedure
  441. '*
  442. (dynamic-pointer "sqlite3_column_name" libsqlite3)
  443. (list '* int))))
  444. (lambda (stmt i)
  445. (assert-live-stmt! stmt)
  446. (utf8-pointer->string (column-name (stmt-pointer stmt) i)))))
  447. (define sqlite-column-value
  448. (let ((value-type
  449. (pointer->procedure
  450. int
  451. (dynamic-pointer "sqlite3_column_type" libsqlite3)
  452. (list '* int)))
  453. (value-int
  454. (pointer->procedure
  455. int64
  456. (dynamic-pointer "sqlite3_column_int64" libsqlite3)
  457. (list '* int)))
  458. (value-double
  459. (pointer->procedure
  460. double
  461. (dynamic-pointer "sqlite3_column_double" libsqlite3)
  462. (list '* int)))
  463. (value-text
  464. (pointer->procedure
  465. '*
  466. (dynamic-pointer "sqlite3_column_text" libsqlite3)
  467. (list '* int)))
  468. (value-blob
  469. (pointer->procedure
  470. '*
  471. (dynamic-pointer "sqlite3_column_blob" libsqlite3)
  472. (list '* int)))
  473. (value-bytes
  474. (pointer->procedure
  475. int
  476. (dynamic-pointer "sqlite3_column_bytes" libsqlite3)
  477. (list '* int))))
  478. (lambda (stmt i)
  479. (assert-live-stmt! stmt)
  480. (let ((nbytes (value-bytes (stmt-pointer stmt) i)))
  481. (case (value-type (stmt-pointer stmt) i)
  482. ((1) ; SQLITE_INTEGER
  483. (value-int (stmt-pointer stmt) i))
  484. ((2) ; SQLITE_FLOAT
  485. (value-double (stmt-pointer stmt) i))
  486. ((3) ; SQLITE3_TEXT
  487. (let ((p (value-blob (stmt-pointer stmt) i)))
  488. (if (null-pointer? p)
  489. ""
  490. (utf8->string
  491. (pointer->bytevector p nbytes)))))
  492. ((4) ; SQLITE_BLOB
  493. (let ((p (value-blob (stmt-pointer stmt) i)))
  494. (if (null-pointer? p)
  495. (make-bytevector 0)
  496. (bytevector-copy
  497. (pointer->bytevector p nbytes)))))
  498. ((5) ; SQLITE_NULL
  499. #f))))))
  500. (define (sqlite-column-names stmt)
  501. (let ((v (make-vector (sqlite-column-count stmt))))
  502. (let lp ((i 0))
  503. (if (< i (vector-length v))
  504. (begin
  505. (vector-set! v i (sqlite-column-name stmt i))
  506. (lp (1+ i)))
  507. v))))
  508. (define (sqlite-row stmt)
  509. (let ((v (make-vector (sqlite-column-count stmt))))
  510. (let lp ((i 0))
  511. (if (< i (vector-length v))
  512. (begin
  513. (vector-set! v i (sqlite-column-value stmt i))
  514. (lp (1+ i)))
  515. v))))
  516. (define sqlite-busy-timeout
  517. (let ((f (pointer->procedure
  518. int
  519. (dynamic-func "sqlite3_busy_timeout" libsqlite3)
  520. (list '* int))))
  521. (lambda (db value)
  522. (assert-live-db! db)
  523. (let ((ret (f (db-pointer db) value)))
  524. (when (not (zero? ret))
  525. (check-error db 'sqlite-busy-timeout))))))
  526. (define sqlite-step
  527. (let ((step (pointer->procedure
  528. int
  529. (dynamic-pointer "sqlite3_step" libsqlite3)
  530. (list '*))))
  531. (lambda (stmt)
  532. (assert-live-stmt! stmt)
  533. (let ((ret (step (stmt-pointer stmt))))
  534. (case ret
  535. ((100) ; SQLITE_ROW
  536. (sqlite-row stmt))
  537. ((101) ; SQLITE_DONE
  538. #f)
  539. (else
  540. (check-error (stmt->db stmt))
  541. (error "shouldn't get here")))))))
  542. (define (sqlite-fold kons knil stmt)
  543. (assert-live-stmt! stmt)
  544. (let lp ((seed knil))
  545. (let ((row (sqlite-step stmt)))
  546. (if row
  547. (lp (kons row seed))
  548. seed))))
  549. (define (sqlite-fold-right kons knil stmt)
  550. (assert-live-stmt! stmt)
  551. (let lp ()
  552. (let ((row (sqlite-step stmt)))
  553. (if row
  554. (kons row (lp))
  555. knil))))
  556. (define (sqlite-map proc stmt)
  557. (map proc
  558. (reverse! (sqlite-fold cons '() stmt))))