Thunderchez: Hex Artifact Content

Artifact 4bb86b5c646a49f44f24982c375ee147500808da:

File sqlite3.sls — part of check-in [538cf8286e] at 2019-04-11 18:15:56 on branch trunk — add sql field to sqlite3 statement (user: aldo size: 30080)
0000: 3b 3b 3b 3b 20 73 71 6c 69 74 65 33 2e 73 63 6d  ;;;; sqlite3.scm
0010: 0a 3b 3b 3b 3b 20 3a 74 61 62 53 69 7a 65 3d 32  .;;;; :tabSize=2
0020: 3a 69 6e 64 65 6e 74 53 69 7a 65 3d 32 3a 6e 6f  :indentSize=2:no
0030: 54 61 62 73 3d 74 72 75 65 3a 0a 3b 3b 3b 3b 20  Tabs=true:.;;;; 
0040: 62 69 6e 64 69 6e 67 73 20 74 6f 20 74 68 65 20  bindings to the 
0050: 53 51 4c 69 74 65 33 20 64 61 74 61 62 61 73 65  SQLite3 database
0060: 20 6c 69 62 72 61 72 79 0a 0a 23 21 63 68 65 7a   library..#!chez
0070: 73 63 68 65 6d 65 0a 28 6c 69 62 72 61 72 79 0a  scheme.(library.
0080: 20 28 73 71 6c 69 74 65 33 29 0a 20 28 65 78 70   (sqlite3). (exp
0090: 6f 72 74 0a 20 20 3b 3b 20 70 72 6f 63 65 64 75  ort.  ;; procedu
00a0: 72 65 73 0a 20 20 6f 70 65 6e 2d 64 61 74 61 62  res.  open-datab
00b0: 61 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20  ase.            
00c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
00d0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 64 65 66              ;def
00e0: 69 6e 65 2d 63 6f 6c 6c 61 74 69 6f 6e 0a 20 20  ine-collation.  
00f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0110: 20 20 20 20 20 20 3b 64 65 66 69 6e 65 2d 66 75        ;define-fu
0120: 6e 63 74 69 6f 6e 0a 20 20 73 65 74 2d 62 75 73  nction.  set-bus
0130: 79 2d 68 61 6e 64 6c 65 72 21 0a 20 20 20 20 20  y-handler!.     
0140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0160: 20 20 20 3b 6d 61 6b 65 2d 62 75 73 79 2d 74 69     ;make-busy-ti
0170: 6d 65 6f 75 74 0a 20 20 73 71 6c 69 74 65 33 2d  meout.  sqlite3-
0180: 62 75 73 79 2d 74 69 6d 65 6f 75 74 0a 20 20 69  busy-timeout.  i
0190: 6e 74 65 72 72 75 70 74 21 0a 20 20 61 75 74 6f  nterrupt!.  auto
01a0: 2d 63 6f 6d 6d 69 74 74 69 6e 67 3f 0a 20 20 63  -committing?.  c
01b0: 68 61 6e 67 65 2d 63 6f 75 6e 74 0a 20 20 6c 61  hange-count.  la
01c0: 73 74 2d 69 6e 73 65 72 74 2d 72 6f 77 69 64 0a  st-insert-rowid.
01d0: 20 20 66 69 6e 61 6c 69 7a 65 21 0a 20 20 70 72    finalize!.  pr
01e0: 65 70 61 72 65 0a 20 20 73 6f 75 72 63 65 2d 73  epare.  source-s
01f0: 71 6c 0a 20 20 72 65 73 65 74 21 0a 20 20 62 69  ql.  reset!.  bi
0200: 6e 64 2d 70 61 72 61 6d 65 74 65 72 2d 63 6f 75  nd-parameter-cou
0210: 6e 74 0a 20 20 62 69 6e 64 2d 70 61 72 61 6d 65  nt.  bind-parame
0220: 74 65 72 2d 69 6e 64 65 78 0a 20 20 62 69 6e 64  ter-index.  bind
0230: 2d 70 61 72 61 6d 65 74 65 72 2d 6e 61 6d 65 0a  -parameter-name.
0240: 20 20 62 69 6e 64 21 0a 20 20 62 69 6e 64 2d 70    bind!.  bind-p
0250: 61 72 61 6d 65 74 65 72 73 21 0a 20 20 73 74 65  arameters!.  ste
0260: 70 21 0a 20 20 63 6f 6c 75 6d 6e 2d 63 6f 75 6e  p!.  column-coun
0270: 74 0a 20 20 63 6f 6c 75 6d 6e 2d 74 79 70 65 0a  t.  column-type.
0280: 20 20 63 6f 6c 75 6d 6e 2d 64 65 63 6c 61 72 65    column-declare
0290: 64 2d 74 79 70 65 0a 20 20 63 6f 6c 75 6d 6e 2d  d-type.  column-
02a0: 6e 61 6d 65 0a 20 20 63 6f 6c 75 6d 6e 2d 64 61  name.  column-da
02b0: 74 61 0a 20 20 63 61 6c 6c 2d 77 69 74 68 2d 74  ta.  call-with-t
02c0: 65 6d 70 6f 72 61 72 79 2d 73 74 61 74 65 6d 65  emporary-stateme
02d0: 6e 74 73 0a 20 20 65 78 65 63 75 74 65 0a 20 20  nts.  execute.  
02e0: 75 70 64 61 74 65 0a 20 20 66 69 72 73 74 2d 72  update.  first-r
02f0: 65 73 75 6c 74 0a 20 20 66 69 72 73 74 2d 72 6f  esult.  first-ro
0300: 77 0a 20 20 66 6f 6c 64 2d 72 6f 77 0a 20 20 66  w.  fold-row.  f
0310: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 6d 61  or-each-row.  ma
0320: 70 2d 72 6f 77 0a 20 20 77 69 74 68 2d 74 72 61  p-row.  with-tra
0330: 6e 73 61 63 74 69 6f 6e 0a 20 20 73 71 6c 2d 63  nsaction.  sql-c
0340: 6f 6d 70 6c 65 74 65 3f 0a 20 20 64 61 74 61 62  omplete?.  datab
0350: 61 73 65 2d 76 65 72 73 69 6f 6e 0a 20 20 64 61  ase-version.  da
0360: 74 61 62 61 73 65 2d 6d 65 6d 6f 72 79 2d 75 73  tabase-memory-us
0370: 65 64 0a 20 20 64 61 74 61 62 61 73 65 2d 6d 65  ed.  database-me
0380: 6d 6f 72 79 2d 68 69 67 68 77 61 74 65 72 0a 20  mory-highwater. 
0390: 20 65 6e 61 62 6c 65 2d 73 68 61 72 65 64 2d 63   enable-shared-c
03a0: 61 63 68 65 21 0a 20 20 65 6e 61 62 6c 65 2d 6c  ache!.  enable-l
03b0: 6f 61 64 2d 65 78 74 65 6e 73 69 6f 6e 21 0a 0a  oad-extension!..
03c0: 20 20 73 71 6c 69 74 65 33 2d 74 72 61 63 65 0a    sqlite3-trace.
03d0: 20 20 73 71 6c 69 74 65 33 2d 63 6f 6e 66 69 67    sqlite3-config
03e0: 2d 6c 6f 67 29 0a 0a 20 28 69 6d 70 6f 72 74 0a  -log).. (import.
03f0: 20 20 28 63 68 65 7a 73 63 68 65 6d 65 29 0a 20    (chezscheme). 
0400: 20 28 73 72 66 69 20 73 30 20 63 6f 6e 64 2d 65   (srfi s0 cond-e
0410: 78 70 61 6e 64 29 0a 20 20 28 73 72 66 69 20 73  xpand).  (srfi s
0420: 32 20 61 6e 64 2d 6c 65 74 29 0a 20 20 28 6d 61  2 and-let).  (ma
0430: 74 63 68 61 62 6c 65 29 0a 20 20 28 6f 6e 6c 79  tchable).  (only
0440: 20 28 73 72 66 69 20 73 31 33 20 73 74 72 69 6e   (srfi s13 strin
0450: 67 73 29 20 73 74 72 69 6e 67 2d 63 6f 6e 74 61  gs) string-conta
0460: 69 6e 73 2d 63 69 29 0a 20 20 28 73 72 66 69 20  ins-ci).  (srfi 
0470: 73 31 31 20 6c 65 74 2d 76 61 6c 75 65 73 29 0a  s11 let-values).
0480: 20 20 28 73 72 66 69 20 73 32 36 20 63 75 74 29    (srfi s26 cut)
0490: 0a 20 20 28 73 71 6c 2d 6e 75 6c 6c 29 29 0a 0a  .  (sql-null))..
04a0: 20 23 3b 28 64 65 66 69 6e 65 20 28 73 71 6c 69   #;(define (sqli
04b0: 74 65 33 2d 6c 69 62 72 61 72 79 2d 69 6e 69 74  te3-library-init
04c0: 29 29 0a 20 28 64 65 66 69 6e 65 20 6c 69 62 69  )). (define libi
04d0: 6e 69 74 0a 20 20 20 28 62 65 67 69 6e 0a 20 20  nit.   (begin.  
04e0: 20 20 20 28 63 61 73 65 20 28 6d 61 63 68 69 6e     (case (machin
04f0: 65 2d 74 79 70 65 29 0a 20 20 20 20 20 20 20 5b  e-type).       [
0500: 28 69 33 6e 74 20 61 36 6e 74 20 69 33 6d 77 20  (i3nt a6nt i3mw 
0510: 61 36 6d 77 29 0a 09 28 6c 6f 61 64 2d 73 68 61  a6mw)..(load-sha
0520: 72 65 64 2d 6f 62 6a 65 63 74 20 22 73 71 6c 69  red-object "sqli
0530: 74 65 33 2e 64 6c 6c 22 29 5d 0a 20 20 20 20 20  te3.dll")].     
0540: 20 20 5b 65 6c 73 65 0a 09 28 6c 6f 61 64 2d 73    [else..(load-s
0550: 68 61 72 65 64 2d 6f 62 6a 65 63 74 20 22 6c 69  hared-object "li
0560: 62 73 71 6c 69 74 65 33 2e 73 6f 2e 30 22 29 5d  bsqlite3.so.0")]
0570: 29 29 29 0a 20 3b 28 64 65 66 69 6e 65 20 6c 69  ))). ;(define li
0580: 62 69 6e 69 74 20 28 62 65 67 69 6e 20 28 6c 6f  binit (begin (lo
0590: 61 64 2d 73 68 61 72 65 64 2d 6f 62 6a 65 63 74  ad-shared-object
05a0: 20 22 73 71 6c 69 74 65 33 2e 64 6c 6c 22 29 29   "sqlite3.dll"))
05b0: 29 0a 20 3b 3b 20 63 6f 6d 70 61 74 69 62 69 6c  ). ;; compatibil
05c0: 69 74 79 20 66 75 6e 63 74 69 6f 6e 73 0a 20 28  ity functions. (
05d0: 64 65 66 69 6e 65 20 28 68 61 73 68 74 61 62 6c  define (hashtabl
05e0: 65 2d 77 61 6c 6b 20 68 74 20 66 29 0a 20 20 20  e-walk ht f).   
05f0: 28 76 65 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68  (vector-for-each
0600: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20   (lambda (x).   
0610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0620: 20 20 20 28 66 20 78 20 28 68 61 73 68 74 61 62     (f x (hashtab
0630: 6c 65 2d 72 65 66 20 68 74 20 78 20 23 66 29 29  le-ref ht x #f))
0640: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
0650: 20 20 20 20 20 20 28 68 61 73 68 74 61 62 6c 65        (hashtable
0660: 2d 6b 65 79 73 20 68 74 29 29 29 0a 0a 20 28 64  -keys ht))).. (d
0670: 65 66 69 6e 65 20 28 2d 3e 73 74 72 69 6e 67 20  efine (->string 
0680: 78 29 0a 20 20 20 28 77 69 74 68 2d 6f 75 74 70  x).   (with-outp
0690: 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61  ut-to-string (la
06a0: 6d 62 64 61 20 28 29 20 28 64 69 73 70 6c 61 79  mbda () (display
06b0: 20 78 29 29 29 29 0a 0a 20 28 64 65 66 69 6e 65   x)))).. (define
06c0: 20 28 63 6f 6e 63 20 2e 20 61 72 67 73 29 0a 20   (conc . args). 
06d0: 20 20 28 61 70 70 6c 79 20 73 74 72 69 6e 67 2d    (apply string-
06e0: 61 70 70 65 6e 64 20 28 6d 61 70 20 2d 3e 73 74  append (map ->st
06f0: 72 69 6e 67 20 61 72 67 73 29 29 20 29 0a 0a 3b  ring args)) )..;
0700: 3b 3b 20 46 6f 72 65 69 67 6e 20 74 79 70 65 73  ;; Foreign types
0710: 20 26 20 76 61 6c 75 65 73 0a 0a 20 3b 3b 20 45   & values.. ;; E
0720: 6e 75 6d 65 72 61 74 69 6f 6e 20 61 6e 64 20 63  numeration and c
0730: 6f 6e 73 74 61 6e 74 20 64 65 66 69 6e 69 74 69  onstant definiti
0740: 6f 6e 73 0a 20 28 64 65 66 69 6e 65 20 73 71 6c  ons. (define sql
0750: 69 74 65 33 3a 73 74 61 74 75 73 0a 20 20 20 27  ite3:status.   '
0760: 28 28 6f 6b 20 20 20 20 20 20 20 20 20 2e 20 20  ((ok         .  
0770: 30 29 20 3b 20 53 75 63 63 65 73 73 66 75 6c 20  0) ; Successful 
0780: 72 65 73 75 6c 74 20 28 23 66 3f 29 0a 20 20 20  result (#f?).   
0790: 20 20 28 65 72 72 6f 72 20 20 20 20 20 20 2e 20    (error      . 
07a0: 20 31 29 20 3b 20 53 51 4c 20 65 72 72 6f 72 20   1) ; SQL error 
07b0: 6f 72 20 6d 69 73 73 69 6e 67 20 64 61 74 61 62  or missing datab
07c0: 61 73 65 0a 20 20 20 20 20 28 69 6e 74 65 72 6e  ase.     (intern
07d0: 61 6c 20 20 20 2e 20 20 32 29 20 3b 20 4e 4f 54  al   .  2) ; NOT
07e0: 20 55 53 45 44 2e 20 49 6e 74 65 72 6e 61 6c 20   USED. Internal 
07f0: 6c 6f 67 69 63 20 65 72 72 6f 72 20 69 6e 20 53  logic error in S
0800: 51 4c 69 74 65 0a 20 20 20 20 20 28 70 65 72 6d  QLite.     (perm
0810: 69 73 73 69 6f 6e 20 2e 20 20 33 29 20 3b 20 41  ission .  3) ; A
0820: 63 63 65 73 73 20 70 65 72 6d 69 73 73 69 6f 6e  ccess permission
0830: 20 64 65 6e 69 65 64 0a 20 20 20 20 20 28 61 62   denied.     (ab
0840: 6f 72 74 20 20 20 20 20 20 2e 20 20 34 29 20 3b  ort      .  4) ;
0850: 20 43 61 6c 6c 62 61 63 6b 20 72 6f 75 74 69 6e   Callback routin
0860: 65 20 72 65 71 75 65 73 74 65 64 20 61 6e 20 61  e requested an a
0870: 62 6f 72 74 0a 20 20 20 20 20 28 62 75 73 79 20  bort.     (busy 
0880: 20 20 20 20 20 20 2e 20 20 35 29 20 3b 20 54 68        .  5) ; Th
0890: 65 20 64 61 74 61 62 61 73 65 20 66 69 6c 65 20  e database file 
08a0: 69 73 20 6c 6f 63 6b 65 64 0a 20 20 20 20 20 28  is locked.     (
08b0: 6c 6f 63 6b 65 64 20 20 20 20 20 2e 20 20 36 29  locked     .  6)
08c0: 20 3b 20 41 20 74 61 62 6c 65 20 69 6e 20 74 68   ; A table in th
08d0: 65 20 64 61 74 61 62 61 73 65 20 69 73 20 6c 6f  e database is lo
08e0: 63 6b 65 64 0a 20 20 20 20 20 28 6e 6f 2d 6d 65  cked.     (no-me
08f0: 6d 6f 72 79 20 20 2e 20 20 37 29 20 3b 20 41 20  mory  .  7) ; A 
0900: 6d 61 6c 6c 6f 63 28 29 20 66 61 69 6c 65 64 0a  malloc() failed.
0910: 20 20 20 20 20 28 72 65 61 64 2d 6f 6e 6c 79 20       (read-only 
0920: 20 2e 20 20 38 29 20 3b 20 41 74 74 65 6d 70 74   .  8) ; Attempt
0930: 20 74 6f 20 77 72 69 74 65 20 61 20 72 65 61 64   to write a read
0940: 6f 6e 6c 79 20 64 61 74 61 62 61 73 65 0a 20 20  only database.  
0950: 20 20 20 28 69 6e 74 65 72 72 75 70 74 20 20 2e     (interrupt  .
0960: 20 20 39 29 20 3b 20 4f 70 65 72 61 74 69 6f 6e    9) ; Operation
0970: 20 74 65 72 6d 69 6e 61 74 65 64 20 62 79 20 73   terminated by s
0980: 71 6c 69 74 65 33 5f 69 6e 74 65 72 72 75 70 74  qlite3_interrupt
0990: 28 29 0a 20 20 20 20 20 28 69 6f 2d 65 72 72 6f  ().     (io-erro
09a0: 72 20 20 20 2e 20 31 30 29 20 3b 20 53 6f 6d 65  r   . 10) ; Some
09b0: 20 6b 69 6e 64 20 6f 66 20 64 69 73 6b 20 49 2f   kind of disk I/
09c0: 4f 20 65 72 72 6f 72 20 6f 63 63 75 72 72 65 64  O error occurred
09d0: 0a 20 20 20 20 20 28 63 6f 72 72 75 70 74 20 20  .     (corrupt  
09e0: 20 20 2e 20 31 31 29 20 3b 20 54 68 65 20 64 61    . 11) ; The da
09f0: 74 61 62 61 73 65 20 64 69 73 6b 20 69 6d 61 67  tabase disk imag
0a00: 65 20 69 73 20 6d 61 6c 66 6f 72 6d 65 64 0a 20  e is malformed. 
0a10: 20 20 20 20 28 6e 6f 74 2d 66 6f 75 6e 64 20 20      (not-found  
0a20: 2e 20 31 32 29 20 3b 20 4e 4f 54 20 55 53 45 44  . 12) ; NOT USED
0a30: 2e 20 54 61 62 6c 65 20 6f 72 20 72 65 63 6f 72  . Table or recor
0a40: 64 20 6e 6f 74 20 66 6f 75 6e 64 0a 20 20 20 20  d not found.    
0a50: 20 28 66 75 6c 6c 20 20 20 20 20 20 20 2e 20 31   (full       . 1
0a60: 33 29 20 3b 20 49 6e 73 65 72 74 69 6f 6e 20 66  3) ; Insertion f
0a70: 61 69 6c 65 64 20 62 65 63 61 75 73 65 20 64 61  ailed because da
0a80: 74 61 62 61 73 65 20 69 73 20 66 75 6c 6c 0a 20  tabase is full. 
0a90: 20 20 20 20 28 63 61 6e 74 2d 6f 70 65 6e 20 20      (cant-open  
0aa0: 2e 20 31 34 29 20 3b 20 55 6e 61 62 6c 65 20 74  . 14) ; Unable t
0ab0: 6f 20 6f 70 65 6e 20 74 68 65 20 64 61 74 61 62  o open the datab
0ac0: 61 73 65 20 66 69 6c 65 0a 20 20 20 20 20 28 70  ase file.     (p
0ad0: 72 6f 74 6f 63 6f 6c 20 20 20 2e 20 31 35 29 20  rotocol   . 15) 
0ae0: 3b 20 4e 4f 54 20 55 53 45 44 2e 20 44 61 74 61  ; NOT USED. Data
0af0: 62 61 73 65 20 6c 6f 63 6b 20 70 72 6f 74 6f 63  base lock protoc
0b00: 6f 6c 20 65 72 72 6f 72 0a 20 20 20 20 20 28 65  ol error.     (e
0b10: 6d 70 74 79 20 20 20 20 20 20 2e 20 31 36 29 20  mpty      . 16) 
0b20: 3b 20 44 61 74 61 62 61 73 65 20 69 73 20 65 6d  ; Database is em
0b30: 70 74 79 0a 20 20 20 20 20 28 73 63 68 65 6d 61  pty.     (schema
0b40: 20 20 20 20 20 2e 20 31 37 29 20 3b 20 54 68 65       . 17) ; The
0b50: 20 64 61 74 61 62 61 73 65 20 73 63 68 65 6d 61   database schema
0b60: 20 63 68 61 6e 67 65 64 0a 20 20 20 20 20 28 74   changed.     (t
0b70: 6f 6f 2d 62 69 67 20 20 20 20 2e 20 31 38 29 20  oo-big    . 18) 
0b80: 20 3b 20 53 74 72 69 6e 67 20 6f 72 20 42 4c 4f   ; String or BLO
0b90: 42 20 65 78 63 65 65 64 73 20 73 69 7a 65 20 6c  B exceeds size l
0ba0: 69 6d 69 74 0a 20 20 20 20 20 28 63 6f 6e 73 74  imit.     (const
0bb0: 72 61 69 6e 74 20 2e 20 31 39 29 20 3b 20 41 62  raint . 19) ; Ab
0bc0: 6f 72 74 20 64 75 65 20 74 6f 20 63 6f 6e 74 72  ort due to contr
0bd0: 61 69 6e 74 20 76 69 6f 6c 61 74 69 6f 6e 0a 20  aint violation. 
0be0: 20 20 20 20 28 6d 69 73 6d 61 74 63 68 20 20 20      (mismatch   
0bf0: 2e 20 32 30 29 20 3b 20 44 61 74 61 20 74 79 70  . 20) ; Data typ
0c00: 65 20 6d 69 73 6d 61 74 63 68 0a 20 20 20 20 20  e mismatch.     
0c10: 28 6d 69 73 75 73 65 20 20 20 20 20 2e 20 32 31  (misuse     . 21
0c20: 29 20 3b 20 4c 69 62 72 61 72 79 20 75 73 65 64  ) ; Library used
0c30: 20 69 6e 63 6f 72 72 65 63 74 6c 79 0a 20 20 20   incorrectly.   
0c40: 20 20 28 6e 6f 2d 6c 66 73 20 20 20 20 20 2e 20    (no-lfs     . 
0c50: 32 32 29 20 3b 20 55 73 65 73 20 4f 53 20 66 65  22) ; Uses OS fe
0c60: 61 74 75 72 65 73 20 6e 6f 74 20 73 75 70 70 6f  atures not suppo
0c70: 72 74 65 64 20 6f 6e 20 68 6f 73 74 0a 20 20 20  rted on host.   
0c80: 20 20 28 61 75 74 68 20 20 20 20 20 20 20 2e 20    (auth       . 
0c90: 32 33 29 20 3b 20 41 75 74 68 6f 72 69 7a 61 74  23) ; Authorizat
0ca0: 69 6f 6e 20 64 65 6e 69 65 64 0a 20 20 20 20 20  ion denied.     
0cb0: 28 66 6f 72 6d 61 74 20 20 20 20 20 2e 20 32 34  (format     . 24
0cc0: 29 20 3b 20 41 75 78 69 6c 69 61 72 79 20 64 61  ) ; Auxiliary da
0cd0: 74 61 62 61 73 65 20 66 6f 72 6d 61 74 20 65 72  tabase format er
0ce0: 72 6f 72 0a 20 20 20 20 20 28 72 61 6e 67 65 20  ror.     (range 
0cf0: 20 20 20 20 20 2e 20 32 35 29 20 3b 20 32 6e 64       . 25) ; 2nd
0d00: 20 70 61 72 61 6d 65 74 65 72 20 74 6f 20 73 71   parameter to sq
0d10: 6c 69 74 65 33 5f 62 69 6e 64 20 6f 75 74 20 6f  lite3_bind out o
0d20: 66 20 72 61 6e 67 65 0a 20 20 20 20 20 28 6e 6f  f range.     (no
0d30: 74 2d 61 2d 64 62 20 20 20 2e 20 32 36 29 20 3b  t-a-db   . 26) ;
0d40: 20 46 69 6c 65 20 6f 70 65 6e 65 64 20 74 68 61   File opened tha
0d50: 74 20 69 73 20 6e 6f 74 20 61 20 64 61 74 61 62  t is not a datab
0d60: 61 73 65 20 66 69 6c 65 0a 20 20 20 20 20 28 6e  ase file.     (n
0d70: 6f 74 69 63 65 20 20 20 20 20 2e 20 32 37 29 20  otice     . 27) 
0d80: 3b 20 4e 6f 74 69 66 69 63 61 74 69 6f 6e 73 20  ; Notifications 
0d90: 66 72 6f 6d 20 73 71 6c 69 74 65 33 5f 6c 6f 67  from sqlite3_log
0da0: 28 29 0a 20 20 20 20 20 28 77 61 72 6e 69 6e 67  ().     (warning
0db0: 20 20 20 20 2e 20 32 38 29 20 3b 20 57 61 72 6e      . 28) ; Warn
0dc0: 69 6e 67 73 20 66 72 6f 6d 20 73 71 6c 69 74 65  ings from sqlite
0dd0: 33 5f 6c 6f 67 28 29 0a 20 20 20 20 20 28 72 6f  3_log().     (ro
0de0: 77 20 20 20 20 20 20 20 2e 20 31 30 30 29 20 3b  w       . 100) ;
0df0: 20 73 71 6c 69 74 65 33 5f 73 74 65 70 28 29 20   sqlite3_step() 
0e00: 68 61 73 20 61 6e 6f 74 68 65 72 20 72 6f 77 20  has another row 
0e10: 72 65 61 64 79 0a 20 20 20 20 20 28 64 6f 6e 65  ready.     (done
0e20: 20 20 20 20 20 20 2e 20 31 30 31 29 20 3b 20 73        . 101) ; s
0e30: 71 6c 69 74 65 33 5f 73 74 65 70 28 29 20 68 61  qlite3_step() ha
0e40: 73 20 66 69 6e 69 73 68 65 64 20 65 78 65 63 75  s finished execu
0e50: 74 69 6e 67 0a 20 20 20 20 20 29 29 0a 0a 20 28  ting.     )).. (
0e60: 64 65 66 69 6e 65 20 28 6e 75 6d 62 65 72 2d 3e  define (number->
0e70: 73 71 6c 69 74 65 33 3a 73 74 61 74 75 73 20 73  sqlite3:status s
0e80: 74 61 74 75 73 29 0a 20 20 20 28 6c 65 74 20 28  tatus).   (let (
0e90: 5b 78 20 28 66 69 6e 64 20 28 6c 61 6d 62 64 61  [x (find (lambda
0ea0: 20 28 61 29 20 28 65 71 75 61 6c 3f 20 28 63 64   (a) (equal? (cd
0eb0: 72 20 61 29 20 73 74 61 74 75 73 29 29 20 73 71  r a) status)) sq
0ec0: 6c 69 74 65 33 3a 73 74 61 74 75 73 29 5d 29 0a  lite3:status)]).
0ed0: 20 20 20 20 20 28 69 66 20 28 70 61 69 72 3f 20       (if (pair? 
0ee0: 78 29 20 28 63 61 72 20 78 29 20 23 66 29 29 29  x) (car x) #f)))
0ef0: 0a 0a 20 28 64 65 66 69 6e 65 20 73 71 6c 69 74  .. (define sqlit
0f00: 65 33 3a 74 79 70 65 2d 65 6e 75 6d 20 28 6d 61  e3:type-enum (ma
0f10: 6b 65 2d 65 6e 75 6d 65 72 61 74 69 6f 6e 20 27  ke-enumeration '
0f20: 28 75 6e 64 65 66 69 6e 65 64 20 69 6e 74 65 67  (undefined integ
0f30: 65 72 20 66 6c 6f 61 74 20 74 65 78 74 20 62 6c  er float text bl
0f40: 6f 62 20 6e 75 6c 6c 29 29 29 0a 20 28 64 65 66  ob null))). (def
0f50: 69 6e 65 20 73 71 6c 69 74 65 33 3a 74 79 70 65  ine sqlite3:type
0f60: 2d 69 6e 64 65 78 20 28 65 6e 75 6d 2d 73 65 74  -index (enum-set
0f70: 2d 69 6e 64 65 78 65 72 20 73 71 6c 69 74 65 33  -indexer sqlite3
0f80: 3a 74 79 70 65 2d 65 6e 75 6d 29 29 0a 20 28 64  :type-enum)). (d
0f90: 65 66 69 6e 65 20 28 73 71 6c 69 74 65 33 3a 74  efine (sqlite3:t
0fa0: 79 70 65 2d 72 65 66 20 69 6e 64 65 78 29 0a 20  ype-ref index). 
0fb0: 20 20 28 6c 69 73 74 2d 72 65 66 20 28 65 6e 75    (list-ref (enu
0fc0: 6d 2d 73 65 74 2d 3e 6c 69 73 74 20 73 71 6c 69  m-set->list sqli
0fd0: 74 65 33 3a 74 79 70 65 2d 65 6e 75 6d 29 20 69  te3:type-enum) i
0fe0: 6e 64 65 78 29 29 0a 0a 20 0a 0a 20 3b 3b 20 41  ndex)).. .. ;; A
0ff0: 75 78 69 6c 69 61 72 79 20 74 79 70 65 73 0a 0a  uxiliary types..
1000: 20 28 64 65 66 69 6e 65 2d 66 74 79 70 65 20 73   (define-ftype s
1010: 71 6c 69 74 65 33 3a 63 6f 6e 74 65 78 74 20 76  qlite3:context v
1020: 6f 69 64 2a 29 0a 0a 20 28 64 65 66 69 6e 65 2d  oid*).. (define-
1030: 66 74 79 70 65 20 73 71 6c 69 74 65 33 3a 76 61  ftype sqlite3:va
1040: 6c 75 65 20 76 6f 69 64 2a 29 0a 0a 20 3b 3b 20  lue void*).. ;; 
1050: 54 79 70 65 73 20 66 6f 72 20 64 61 74 61 62 61  Types for databa
1060: 73 65 73 20 61 6e 64 20 73 74 61 74 65 6d 65 6e  ses and statemen
1070: 74 73 0a 0a 20 28 64 65 66 69 6e 65 2d 66 74 79  ts.. (define-fty
1080: 70 65 20 73 71 6c 69 74 65 33 3a 64 61 74 61 62  pe sqlite3:datab
1090: 61 73 65 2a 20 76 6f 69 64 2a 29 0a 0a 20 28 64  ase* void*).. (d
10a0: 65 66 69 6e 65 2d 66 74 79 70 65 20 73 71 6c 69  efine-ftype sqli
10b0: 74 65 33 3a 64 61 74 61 62 61 73 65 2a 2a 20 28  te3:database** (
10c0: 2a 20 73 71 6c 69 74 65 33 3a 64 61 74 61 62 61  * sqlite3:databa
10d0: 73 65 2a 29 29 0a 20 20 20 20 20 20 20 20 20 20  se*)).          
10e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 28                ;(
1100: 64 65 66 69 6e 65 2d 63 68 65 63 6b 2b 65 72 72  define-check+err
1110: 6f 72 2d 74 79 70 65 20 64 61 74 61 62 61 73 65  or-type database
1120: 29 0a 20 28 64 65 66 69 6e 65 2d 66 74 79 70 65  ). (define-ftype
1130: 20 73 71 6c 69 74 65 33 3a 73 74 61 74 65 6d 65   sqlite3:stateme
1140: 6e 74 2a 20 76 6f 69 64 2a 29 0a 20 28 64 65 66  nt* void*). (def
1150: 69 6e 65 2d 66 74 79 70 65 20 73 71 6c 69 74 65  ine-ftype sqlite
1160: 33 3a 73 74 61 74 65 6d 65 6e 74 2a 2a 20 28 2a  3:statement** (*
1170: 20 73 71 6c 69 74 65 33 3a 73 74 61 74 65 6d 65   sqlite3:stateme
1180: 6e 74 2a 29 29 0a 0a 20 28 64 65 66 69 6e 65 2d  nt*)).. (define-
1190: 72 65 63 6f 72 64 2d 74 79 70 65 20 28 26 73 71  record-type (&sq
11a0: 6c 69 74 65 33 20 6d 61 6b 65 2d 73 71 6c 69 74  lite3 make-sqlit
11b0: 65 33 2d 63 6f 6e 64 69 74 69 6f 6e 20 24 73 71  e3-condition $sq
11c0: 6c 69 74 65 33 2d 63 6f 6e 64 69 74 69 6f 6e 3f  lite3-condition?
11d0: 29 0a 20 20 20 28 70 61 72 65 6e 74 20 26 63 6f  ).   (parent &co
11e0: 6e 64 69 74 69 6f 6e 29 0a 20 20 20 28 66 69 65  ndition).   (fie
11f0: 6c 64 73 20 28 69 6d 6d 75 74 61 62 6c 65 20 73  lds (immutable s
1200: 74 61 74 75 73 20 24 73 71 6c 69 74 65 33 2d 63  tatus $sqlite3-c
1210: 6f 6e 64 69 74 69 6f 6e 2d 73 74 61 74 75 73 29  ondition-status)
1220: 29 29 0a 0a 20 28 64 65 66 69 6e 65 2d 72 65 63  )).. (define-rec
1230: 6f 72 64 2d 74 79 70 65 20 64 61 74 61 62 61 73  ord-type databas
1240: 65 0a 20 20 20 28 66 69 65 6c 64 73 0a 20 20 20  e.   (fields.   
1250: 20 28 6d 75 74 61 62 6c 65 20 70 74 72 29 0a 20   (mutable ptr). 
1260: 20 20 20 28 6d 75 74 61 62 6c 65 20 62 75 73 79     (mutable busy
1270: 2d 68 61 6e 64 6c 65 72 29 29 29 0a 0a 20 28 64  -handler))).. (d
1280: 65 66 69 6e 65 2d 72 65 63 6f 72 64 2d 74 79 70  efine-record-typ
1290: 65 20 73 74 61 74 65 6d 65 6e 74 0a 20 20 20 28  e statement.   (
12a0: 66 69 65 6c 64 73 0a 20 20 20 20 28 6d 75 74 61  fields.    (muta
12b0: 62 6c 65 20 70 74 72 29 0a 20 20 20 20 28 6d 75  ble ptr).    (mu
12c0: 74 61 62 6c 65 20 64 61 74 61 62 61 73 65 29 0a  table database).
12d0: 20 20 20 20 28 6d 75 74 61 62 6c 65 20 73 71 6c      (mutable sql
12e0: 29 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20  )))..           
12f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1300: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 28 64               ;(d
1310: 65 66 69 6e 65 2d 63 68 65 63 6b 2b 65 72 72 6f  efine-check+erro
1320: 72 2d 74 79 70 65 20 73 74 61 74 65 6d 65 6e 74  r-type statement
1330: 29 0a 0a 3b 3b 3b 20 48 65 6c 70 65 72 73 0a 0a  )..;;; Helpers..
1340: 20 3b 3b 20 43 6f 6e 64 69 74 69 6f 6e 73 0a 20   ;; Conditions. 
1350: 28 64 65 66 69 6e 65 20 72 74 64 20 28 72 65 63  (define rtd (rec
1360: 6f 72 64 2d 74 79 70 65 2d 64 65 73 63 72 69 70  ord-type-descrip
1370: 74 6f 72 20 26 73 71 6c 69 74 65 33 29 29 0a 20  tor &sqlite3)). 
1380: 28 64 65 66 69 6e 65 20 73 71 6c 69 74 65 33 2d  (define sqlite3-
1390: 63 6f 6e 64 69 74 69 6f 6e 3f 20 28 63 6f 6e 64  condition? (cond
13a0: 69 74 69 6f 6e 2d 70 72 65 64 69 63 61 74 65 20  ition-predicate 
13b0: 72 74 64 29 29 0a 20 28 64 65 66 69 6e 65 20 73  rtd)). (define s
13c0: 71 6c 69 74 65 33 2d 73 74 61 74 75 73 20 28 63  qlite3-status (c
13d0: 6f 6e 64 69 74 69 6f 6e 2d 61 63 63 65 73 73 6f  ondition-accesso
13e0: 72 20 72 74 64 20 24 73 71 6c 69 74 65 33 2d 63  r rtd $sqlite3-c
13f0: 6f 6e 64 69 74 69 6f 6e 2d 73 74 61 74 75 73 29  ondition-status)
1400: 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 6d 61 6b  ).. (define (mak
1410: 65 2d 73 71 6c 69 74 65 33 2d 65 72 72 6f 72 2d  e-sqlite3-error-
1420: 63 6f 6e 64 69 74 69 6f 6e 20 6c 6f 63 20 6d 73  condition loc ms
1430: 67 20 73 74 61 20 2e 20 61 72 67 73 29 0a 20 20  g sta . args).  
1440: 20 28 63 6f 6e 64 69 74 69 6f 6e 0a 20 20 20 20   (condition.    
1450: 28 6d 61 6b 65 2d 73 71 6c 69 74 65 33 2d 63 6f  (make-sqlite3-co
1460: 6e 64 69 74 69 6f 6e 20 73 74 61 29 0a 20 20 20  ndition sta).   
1470: 20 28 6d 61 6b 65 2d 77 68 6f 2d 63 6f 6e 64 69   (make-who-condi
1480: 74 69 6f 6e 20 6c 6f 63 29 0a 20 20 20 20 28 6d  tion loc).    (m
1490: 61 6b 65 2d 6d 65 73 73 61 67 65 2d 63 6f 6e 64  ake-message-cond
14a0: 69 74 69 6f 6e 20 6d 73 67 29 0a 20 20 20 20 28  ition msg).    (
14b0: 6d 61 6b 65 2d 69 72 72 69 74 61 6e 74 73 2d 63  make-irritants-c
14c0: 6f 6e 64 69 74 69 6f 6e 20 61 72 67 73 29 0a 20  ondition args). 
14d0: 20 20 20 29 29 0a 0a 20 28 64 65 66 69 6e 65 20     )).. (define 
14e0: 28 6d 61 6b 65 2d 6e 6f 2d 64 61 74 61 2d 63 6f  (make-no-data-co
14f0: 6e 64 69 74 69 6f 6e 20 6c 6f 63 20 73 74 6d 74  ndition loc stmt
1500: 20 70 61 72 61 6d 73 29 0a 20 20 20 28 6d 61 6b   params).   (mak
1510: 65 2d 73 71 6c 69 74 65 33 2d 65 72 72 6f 72 2d  e-sqlite3-error-
1520: 63 6f 6e 64 69 74 69 6f 6e 20 6c 6f 63 0a 20 20  condition loc.  
1530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22                 "
1550: 74 68 65 20 73 74 61 74 65 6d 65 6e 74 20 72 65  the statement re
1560: 74 75 72 6e 65 64 20 6e 6f 20 64 61 74 61 22 0a  turned no data".
1570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1590: 20 27 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20   'done.         
15a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
15b0: 20 20 20 20 20 20 20 20 73 74 6d 74 20 70 61 72          stmt par
15c0: 61 6d 73 29 29 0a 0a 20 3b 3b 20 45 72 72 6f 72  ams)).. ;; Error
15d0: 73 0a 20 28 64 65 66 69 6e 65 20 28 61 62 6f 72  s. (define (abor
15e0: 74 2d 73 71 6c 69 74 65 33 2d 65 72 72 6f 72 20  t-sqlite3-error 
15f0: 6c 6f 63 20 64 62 20 2e 20 61 72 67 73 29 0a 20  loc db . args). 
1600: 20 20 28 6c 61 6d 62 64 61 20 28 73 74 61 29 0a    (lambda (sta).
1610: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65       (if (not (e
1620: 71 75 61 6c 3f 20 73 74 61 20 30 29 29 0a 20 20  qual? sta 0)).  
1630: 20 20 20 20 20 20 20 28 72 61 69 73 65 0a 20 20         (raise.  
1640: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 6d          (apply m
1650: 61 6b 65 2d 73 71 6c 69 74 65 33 2d 65 72 72 6f  ake-sqlite3-erro
1660: 72 2d 63 6f 6e 64 69 74 69 6f 6e 0a 20 20 20 20  r-condition.    
1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 63               loc
1680: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
1690: 20 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65    (if db (sqlite
16a0: 33 2d 65 72 72 6d 73 67 20 64 62 29 20 22 73 74  3-errmsg db) "st
16b0: 61 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  a").            
16c0: 20 20 20 20 20 73 74 61 0a 20 20 20 20 20 20 20       sta.       
16d0: 20 20 20 20 20 20 20 20 20 20 61 72 67 73 29 29            args))
16e0: 29 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 70  ))).. (define (p
16f0: 72 69 6e 74 2d 65 72 72 6f 72 2d 6d 65 73 73 61  rint-error-messa
1700: 67 65 20 6f 62 6a 20 70 6f 72 74 20 73 74 72 29  ge obj port str)
1710: 0a 20 20 20 28 64 69 73 70 6c 61 79 20 6f 62 6a  .   (display obj
1720: 20 70 6f 72 74 29 20 28 64 69 73 70 6c 61 79 20   port) (display 
1730: 73 74 72 20 70 6f 72 74 29 20 28 6e 65 77 6c 69  str port) (newli
1740: 6e 65 20 70 6f 72 74 29 29 0a 0a 20 28 64 65 66  ne port)).. (def
1750: 69 6e 65 20 28 70 72 69 6e 74 2d 65 72 72 6f 72  ine (print-error
1760: 20 6d 73 67 20 6f 62 6a 29 0a 20 20 20 28 70 72   msg obj).   (pr
1770: 69 6e 74 2d 65 72 72 6f 72 2d 6d 65 73 73 61 67  int-error-messag
1780: 65 20 6f 62 6a 20 28 63 75 72 72 65 6e 74 2d 65  e obj (current-e
1790: 72 72 6f 72 2d 70 6f 72 74 29 20 28 73 74 72 69  rror-port) (stri
17a0: 6e 67 2d 61 70 70 65 6e 64 20 22 45 72 72 6f 72  ng-append "Error
17b0: 3a 20 22 20 6d 73 67 29 29 29 0a 0a 3b 3b 3b 20  : " msg)))..;;; 
17c0: 44 61 74 61 62 61 73 65 20 69 6e 74 65 72 66 61  Database interfa
17d0: 63 65 0a 0a 20 3b 3b 20 47 65 74 20 61 6e 79 20  ce.. ;; Get any 
17e0: 65 72 72 6f 72 20 6d 65 73 73 61 67 65 0a 20 28  error message. (
17f0: 64 65 66 69 6e 65 20 73 71 6c 69 74 65 33 5f 65  define sqlite3_e
1800: 72 72 6d 73 67 0a 20 20 20 28 66 6f 72 65 69 67  rrmsg.   (foreig
1810: 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 73 71 6c  n-procedure "sql
1820: 69 74 65 33 5f 65 72 72 6d 73 67 22 20 28 73 71  ite3_errmsg" (sq
1830: 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 2a 29  lite3:database*)
1840: 20 73 74 72 69 6e 67 29 29 0a 20 28 64 65 66 69   string)). (defi
1850: 6e 65 20 28 73 71 6c 69 74 65 33 2d 65 72 72 6d  ne (sqlite3-errm
1860: 73 67 20 64 62 29 0a 20 20 20 28 63 68 65 63 6b  sg db).   (check
1870: 2d 64 61 74 61 62 61 73 65 20 27 73 71 6c 69 74  -database 'sqlit
1880: 65 33 2d 65 72 72 6d 73 67 20 64 62 29 0a 20 20  e3-errmsg db).  
1890: 20 28 73 71 6c 69 74 65 33 5f 65 72 72 6d 73 67   (sqlite3_errmsg
18a0: 20 28 64 61 74 61 62 61 73 65 2d 61 64 64 72 20   (database-addr 
18b0: 64 62 29 29 29 0a 0a 20 3b 3b 20 4f 70 65 6e 20  db))).. ;; Open 
18c0: 61 20 64 61 74 61 62 61 73 65 0a 20 28 64 65 66  a database. (def
18d0: 69 6e 65 20 28 6f 70 65 6e 2d 64 61 74 61 62 61  ine (open-databa
18e0: 73 65 20 70 61 74 68 29 0a 20 20 20 28 61 73 73  se path).   (ass
18f0: 65 72 74 20 28 61 6e 64 20 6f 70 65 6e 2d 64 61  ert (and open-da
1900: 74 61 62 61 73 65 20 28 73 74 72 69 6e 67 3f 20  tabase (string? 
1910: 70 61 74 68 29 29 29 0a 20 20 20 28 6c 65 74 2a  path))).   (let*
1920: 20 28 5b 70 74 72 20 28 6d 61 6b 65 2d 66 74 79   ([ptr (make-fty
1930: 70 65 2d 70 6f 69 6e 74 65 72 20 73 71 6c 69 74  pe-pointer sqlit
1940: 65 33 3a 64 61 74 61 62 61 73 65 2a 2a 0a 20 20  e3:database**.  
1950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1970: 20 28 66 6f 72 65 69 67 6e 2d 61 6c 6c 6f 63 20   (foreign-alloc 
1980: 28 66 74 79 70 65 2d 73 69 7a 65 6f 66 20 73 71  (ftype-sizeof sq
1990: 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 2a 2a  lite3:database**
19a0: 29 29 29 5d 0a 20 20 20 20 20 20 20 20 20 20 5b  )))].          [
19b0: 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65  f (foreign-proce
19c0: 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 6f 70  dure "sqlite3_op
19d0: 65 6e 22 20 28 73 74 72 69 6e 67 20 76 6f 69 64  en" (string void
19e0: 2a 29 20 69 6e 74 29 5d 0a 20 20 20 20 20 20 20  *) int)].       
19f0: 20 20 20 5b 65 20 28 66 20 70 61 74 68 20 28 66     [e (f path (f
1a00: 74 79 70 65 2d 70 6f 69 6e 74 65 72 2d 61 64 64  type-pointer-add
1a10: 72 65 73 73 20 70 74 72 29 29 5d 29 0a 20 20 20  ress ptr))]).   
1a20: 20 20 28 69 66 20 28 3d 20 65 20 30 29 0a 20 20    (if (= e 0).  
1a30: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 64 61 74         (make-dat
1a40: 61 62 61 73 65 20 28 66 74 79 70 65 2d 26 72 65  abase (ftype-&re
1a50: 66 20 73 71 6c 69 74 65 33 3a 64 61 74 61 62 61  f sqlite3:databa
1a60: 73 65 2a 2a 20 28 2a 29 20 70 74 72 29 20 23 66  se** (*) ptr) #f
1a70: 29 0a 09 20 28 28 61 62 6f 72 74 2d 73 71 6c 69  ).. ((abort-sqli
1a80: 74 65 33 2d 65 72 72 6f 72 20 27 6f 70 65 6e 2d  te3-error 'open-
1a90: 64 61 74 61 62 61 73 65 20 23 66 20 70 61 74 68  database #f path
1aa0: 29 20 65 29 29 29 29 0a 0a 20 28 64 65 66 69 6e  ) e)))).. (defin
1ab0: 65 20 28 63 68 65 63 6b 2d 64 61 74 61 62 61 73  e (check-databas
1ac0: 65 20 63 6f 6e 74 65 78 74 20 64 62 29 0a 20 20  e context db).  
1ad0: 20 28 61 73 73 65 72 74 20 28 61 6e 64 20 63 6f   (assert (and co
1ae0: 6e 74 65 78 74 20 28 64 61 74 61 62 61 73 65 3f  ntext (database?
1af0: 20 64 62 29 29 29 29 0a 0a 20 28 64 65 66 69 6e   db)))).. (defin
1b00: 65 20 28 63 68 65 63 6b 2d 73 74 61 74 65 6d 65  e (check-stateme
1b10: 6e 74 20 63 6f 6e 74 65 78 74 20 64 62 29 0a 20  nt context db). 
1b20: 20 20 28 61 73 73 65 72 74 20 28 61 6e 64 20 63    (assert (and c
1b30: 6f 6e 74 65 78 74 20 28 73 74 61 74 65 6d 65 6e  ontext (statemen
1b40: 74 3f 20 64 62 29 29 29 29 0a 0a 20 3b 3b 20 53  t? db)))).. ;; S
1b50: 65 74 20 61 70 70 6c 69 63 61 74 69 6f 6e 20 62  et application b
1b60: 75 73 79 20 68 61 6e 64 6c 65 72 2e 20 20 44 6f  usy handler.  Do
1b70: 65 73 20 6e 6f 74 20 75 73 65 20 61 20 63 61 6c  es not use a cal
1b80: 6c 62 61 63 6b 2c 20 73 6f 20 69 74 20 69 73 20  lback, so it is 
1b90: 73 61 66 65 0a 20 3b 3b 20 74 6f 20 79 69 65 6c  safe. ;; to yiel
1ba0: 64 2e 20 20 48 61 6e 64 6c 65 72 20 69 73 20 63  d.  Handler is c
1bb0: 61 6c 6c 65 64 20 77 69 74 68 20 44 42 2c 20 43  alled with DB, C
1bc0: 4f 55 4e 54 20 61 6e 64 20 4c 41 53 54 20 28 74  OUNT and LAST (t
1bd0: 68 65 20 6c 61 73 74 20 76 61 6c 75 65 0a 20 3b  he last value. ;
1be0: 3b 20 69 74 20 72 65 74 75 72 6e 65 64 29 2e 20  ; it returned). 
1bf0: 20 52 65 74 75 72 6e 20 74 72 75 65 20 76 61 6c   Return true val
1c00: 75 65 20 74 6f 20 63 6f 6e 74 69 6e 75 65 20 74  ue to continue t
1c10: 72 79 69 6e 67 2c 20 6f 72 20 23 66 20 74 6f 20  rying, or #f to 
1c20: 73 74 6f 70 2e 0a 20 28 64 65 66 69 6e 65 20 28  stop.. (define (
1c30: 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72  set-busy-handler
1c40: 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20 20  ! db handler).  
1c50: 20 28 63 68 65 63 6b 2d 64 61 74 61 62 61 73 65   (check-database
1c60: 20 27 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c   'set-busy-handl
1c70: 65 72 21 20 64 62 29 0a 20 20 20 28 64 61 74 61  er! db).   (data
1c80: 62 61 73 65 2d 62 75 73 79 2d 68 61 6e 64 6c 65  base-busy-handle
1c90: 72 2d 73 65 74 21 20 64 62 20 68 61 6e 64 6c 65  r-set! db handle
1ca0: 72 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 73  r)).. (define (s
1cb0: 71 6c 69 74 65 33 2d 62 75 73 79 2d 74 69 6d 65  qlite3-busy-time
1cc0: 6f 75 74 20 64 62 20 6d 73 29 0a 20 20 20 28 6c  out db ms).   (l
1cd0: 65 74 20 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d  et ([f (foreign-
1ce0: 70 72 6f 63 65 64 75 72 65 20 22 73 71 6c 69 74  procedure "sqlit
1cf0: 65 33 5f 62 75 73 79 5f 74 69 6d 65 6f 75 74 22  e3_busy_timeout"
1d00: 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 61   (sqlite3:databa
1d10: 73 65 2a 20 69 6e 74 29 20 69 6e 74 29 5d 29 0a  se* int) int)]).
1d20: 20 20 20 20 20 28 66 20 28 64 61 74 61 62 61 73       (f (databas
1d30: 65 2d 61 64 64 72 20 64 62 29 20 6d 73 29 29 29  e-addr db) ms)))
1d40: 0a 20 0a 20 28 64 65 66 69 6e 65 20 28 64 61 74  . . (define (dat
1d50: 61 62 61 73 65 2d 61 64 64 72 20 64 62 29 0a 20  abase-addr db). 
1d60: 20 20 28 66 74 79 70 65 2d 70 6f 69 6e 74 65 72    (ftype-pointer
1d70: 2d 61 64 64 72 65 73 73 20 28 64 61 74 61 62 61  -address (databa
1d80: 73 65 2d 70 74 72 20 64 62 29 29 29 0a 0a 20 28  se-ptr db))).. (
1d90: 64 65 66 69 6e 65 20 28 73 74 61 74 65 6d 65 6e  define (statemen
1da0: 74 2d 61 64 64 72 20 73 74 6d 74 29 0a 20 20 20  t-addr stmt).   
1db0: 28 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 2d 61  (ftype-pointer-a
1dc0: 64 64 72 65 73 73 20 28 73 74 61 74 65 6d 65 6e  ddress (statemen
1dd0: 74 2d 70 74 72 20 73 74 6d 74 29 29 29 0a 0a 20  t-ptr stmt))).. 
1de0: 3b 3b 20 43 61 6e 63 65 6c 20 61 6e 79 20 72 75  ;; Cancel any ru
1df0: 6e 6e 69 6e 67 20 64 61 74 61 62 61 73 65 20 6f  nning database o
1e00: 70 65 72 61 74 69 6f 6e 20 61 73 20 73 6f 6f 6e  peration as soon
1e10: 20 61 73 20 70 6f 73 73 69 62 6c 65 0a 20 28 64   as possible. (d
1e20: 65 66 69 6e 65 20 28 69 6e 74 65 72 72 75 70 74  efine (interrupt
1e30: 21 20 64 62 29 0a 20 20 20 28 63 68 65 63 6b 2d  ! db).   (check-
1e40: 64 61 74 61 62 61 73 65 20 27 69 6e 74 65 72 72  database 'interr
1e50: 75 70 74 21 20 64 62 29 0a 20 20 20 28 6c 65 74  upt! db).   (let
1e60: 20 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72   ([f (foreign-pr
1e70: 6f 63 65 64 75 72 65 20 22 73 71 6c 69 74 65 33  ocedure "sqlite3
1e80: 5f 69 6e 74 65 72 72 75 70 74 22 20 28 73 71 6c  _interrupt" (sql
1e90: 69 74 65 33 3a 64 61 74 61 62 61 73 65 2a 29 20  ite3:database*) 
1ea0: 76 6f 69 64 29 5d 29 0a 20 20 20 20 20 28 66 20  void)]).     (f 
1eb0: 28 64 61 74 61 62 61 73 65 2d 61 64 64 72 20 64  (database-addr d
1ec0: 62 29 29 29 29 0a 0a 20 3b 3b 20 43 68 65 63 6b  b)))).. ;; Check
1ed0: 20 77 68 65 74 68 65 72 20 74 68 65 20 64 61 74   whether the dat
1ee0: 61 62 61 73 65 20 69 73 20 69 6e 20 61 75 74 6f  abase is in auto
1ef0: 63 6f 6d 6d 69 74 20 6d 6f 64 65 0a 20 28 64 65  commit mode. (de
1f00: 66 69 6e 65 20 28 61 75 74 6f 2d 63 6f 6d 6d 69  fine (auto-commi
1f10: 74 74 69 6e 67 3f 20 64 62 29 0a 20 20 20 28 63  tting? db).   (c
1f20: 68 65 63 6b 2d 64 61 74 61 62 61 73 65 20 27 61  heck-database 'a
1f30: 75 74 6f 2d 63 6f 6d 6d 69 74 74 69 6e 67 3f 20  uto-committing? 
1f40: 64 62 29 0a 20 20 20 28 6c 65 74 20 28 5b 66 20  db).   (let ([f 
1f50: 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75  (foreign-procedu
1f60: 72 65 20 22 73 71 6c 69 74 65 33 5f 67 65 74 5f  re "sqlite3_get_
1f70: 61 75 74 6f 63 6f 6d 6d 69 74 22 20 28 73 71 6c  autocommit" (sql
1f80: 69 74 65 33 3a 64 61 74 61 62 61 73 65 2a 29 20  ite3:database*) 
1f90: 62 6f 6f 6c 65 61 6e 29 5d 29 0a 20 20 20 20 20  boolean)]).     
1fa0: 28 66 20 28 64 61 74 61 62 61 73 65 2d 61 64 64  (f (database-add
1fb0: 72 20 64 62 29 29 29 29 0a 0a 20 3b 3b 20 47 65  r db)))).. ;; Ge
1fc0: 74 20 74 68 65 20 6e 75 6d 62 65 72 20 6f 66 20  t the number of 
1fd0: 63 68 61 6e 67 65 73 20 6d 61 64 65 20 74 6f 20  changes made to 
1fe0: 74 68 65 20 64 61 74 61 62 61 73 65 0a 20 28 64  the database. (d
1ff0: 65 66 69 6e 65 20 63 68 61 6e 67 65 2d 63 6f 75  efine change-cou
2000: 6e 74 0a 20 20 20 28 63 61 73 65 2d 6c 61 6d 62  nt.   (case-lamb
2010: 64 61 0a 20 20 20 20 20 5b 28 64 62 29 20 28 63  da.     [(db) (c
2020: 68 61 6e 67 65 2d 63 6f 75 6e 74 20 64 62 20 23  hange-count db #
2030: 66 29 5d 0a 20 20 20 20 20 5b 28 64 62 20 74 6f  f)].     [(db to
2040: 74 61 6c 29 0a 20 20 20 20 20 20 28 63 68 65 63  tal).      (chec
2050: 6b 2d 64 61 74 61 62 61 73 65 20 27 63 68 61 6e  k-database 'chan
2060: 67 65 2d 63 6f 75 6e 74 20 64 62 29 0a 20 20 20  ge-count db).   
2070: 20 20 20 28 6c 65 74 20 28 5b 74 6f 74 61 6c 2d     (let ([total-
2080: 63 68 61 6e 67 65 73 20 28 66 6f 72 65 69 67 6e  changes (foreign
2090: 2d 70 72 6f 63 65 64 75 72 65 20 22 73 71 6c 69  -procedure "sqli
20a0: 74 65 33 5f 74 6f 74 61 6c 5f 63 68 61 6e 67 65  te3_total_change
20b0: 73 22 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61  s" (sqlite3:data
20c0: 62 61 73 65 2a 29 20 69 6e 74 29 5d 0a 20 20 20  base*) int)].   
20d0: 20 20 20 20 20 20 20 20 20 5b 63 68 61 6e 67 65           [change
20e0: 73 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65  s (foreign-proce
20f0: 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 63 68  dure "sqlite3_ch
2100: 61 6e 67 65 73 22 20 28 73 71 6c 69 74 65 33 3a  anges" (sqlite3:
2110: 64 61 74 61 62 61 73 65 2a 29 20 69 6e 74 29 5d  database*) int)]
2120: 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 74 6f  ).        (if to
2130: 74 61 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20  tal.            
2140: 28 74 6f 74 61 6c 2d 63 68 61 6e 67 65 73 20 28  (total-changes (
2150: 64 61 74 61 62 61 73 65 2d 61 64 64 72 20 64 62  database-addr db
2160: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  )).            (
2170: 63 68 61 6e 67 65 73 20 28 64 61 74 61 62 61 73  changes (databas
2180: 65 2d 61 64 64 72 20 64 62 29 29 29 29 5d 29 29  e-addr db))))]))
2190: 0a 0a 20 3b 3b 20 47 65 74 20 74 68 65 20 72 6f  .. ;; Get the ro
21a0: 77 20 49 44 20 6f 66 20 74 68 65 20 6c 61 73 74  w ID of the last
21b0: 20 69 6e 73 65 72 74 65 64 20 72 6f 77 0a 20 28   inserted row. (
21c0: 64 65 66 69 6e 65 20 28 6c 61 73 74 2d 69 6e 73  define (last-ins
21d0: 65 72 74 2d 72 6f 77 69 64 20 64 62 29 0a 20 20  ert-rowid db).  
21e0: 20 28 63 68 65 63 6b 2d 64 61 74 61 62 61 73 65   (check-database
21f0: 20 27 6c 61 73 74 2d 69 6e 73 65 72 74 2d 72 6f   'last-insert-ro
2200: 77 69 64 20 64 62 29 0a 20 20 20 28 6c 65 74 20  wid db).   (let 
2210: 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f  ([f (foreign-pro
2220: 63 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f  cedure "sqlite3_
2230: 6c 61 73 74 5f 69 6e 73 65 72 74 5f 72 6f 77 69  last_insert_rowi
2240: 64 22 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61  d" (sqlite3:data
2250: 62 61 73 65 2a 29 20 69 6e 74 29 5d 29 0a 20 20  base*) int)]).  
2260: 20 20 20 28 66 20 28 64 61 74 61 62 61 73 65 2d     (f (database-
2270: 61 64 64 72 20 64 62 29 29 29 29 0a 0a 20 3b 3b  addr db)))).. ;;
2280: 20 43 6c 6f 73 65 20 61 20 64 61 74 61 62 61 73   Close a databas
2290: 65 20 6f 72 20 73 74 61 74 65 6d 65 6e 74 20 68  e or statement h
22a0: 61 6e 64 6c 65 0a 20 28 64 65 66 69 6e 65 20 28  andle. (define (
22b0: 73 71 6c 69 74 65 33 2d 66 69 6e 61 6c 69 7a 65  sqlite3-finalize
22c0: 20 64 62 29 0a 20 20 20 28 63 68 65 63 6b 2d 64   db).   (check-d
22d0: 61 74 61 62 61 73 65 20 27 73 71 6c 69 74 65 33  atabase 'sqlite3
22e0: 2d 66 69 6e 61 6c 69 7a 65 20 64 62 29 0a 20 20  -finalize db).  
22f0: 20 28 6c 65 74 2a 20 28 5b 66 20 28 66 6f 72 65   (let* ([f (fore
2300: 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 73  ign-procedure "s
2310: 71 6c 69 74 65 33 5f 66 69 6e 61 6c 69 7a 65 22  qlite3_finalize"
2320: 20 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62    (sqlite3:datab
2330: 61 73 65 2a 29 20 69 6e 74 29 5d 0a 20 20 20 20  ase*) int)].    
2340: 20 20 20 20 20 20 5b 6e 20 28 66 20 28 64 61 74        [n (f (dat
2350: 61 62 61 73 65 2d 61 64 64 72 20 64 62 29 29 5d  abase-addr db))]
2360: 29 0a 20 20 20 20 20 28 64 61 74 61 62 61 73 65  ).     (database
2370: 2d 70 74 72 2d 73 65 74 21 20 64 62 20 23 66 29  -ptr-set! db #f)
2380: 0a 20 20 20 20 20 6e 29 29 0a 0a 20 28 64 65 66  .     n)).. (def
2390: 69 6e 65 20 28 73 71 6c 69 74 65 33 2d 6e 65 78  ine (sqlite3-nex
23a0: 74 2d 73 74 6d 74 20 64 62 29 0a 20 20 20 28 63  t-stmt db).   (c
23b0: 68 65 63 6b 2d 64 61 74 61 62 61 73 65 20 27 73  heck-database 's
23c0: 71 6c 69 74 65 33 2d 6e 65 78 74 2d 73 74 6d 74  qlite3-next-stmt
23d0: 20 64 62 29 0a 20 20 20 28 6c 65 74 2a 20 28 5b   db).   (let* ([
23e0: 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65  f (foreign-proce
23f0: 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 6e 65  dure "sqlite3_ne
2400: 78 74 5f 73 74 6d 74 22 20 28 73 71 6c 69 74 65  xt_stmt" (sqlite
2410: 33 3a 64 61 74 61 62 61 73 65 2a 29 20 73 71 6c  3:database*) sql
2420: 69 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a 29  ite3:statement*)
2430: 5d 0a 20 20 20 20 20 20 20 20 20 20 5b 73 74 6d  ].          [stm
2440: 74 2a 20 28 66 20 28 64 61 74 61 62 61 73 65 2d  t* (f (database-
2450: 61 64 64 72 20 64 62 29 29 5d 29 0a 20 20 20 20  addr db))]).    
2460: 20 28 6d 61 6b 65 2d 73 74 61 74 65 6d 65 6e 74   (make-statement
2470: 20 28 6d 61 6b 65 2d 66 74 79 70 65 2d 70 6f 69   (make-ftype-poi
2480: 6e 74 65 72 20 73 71 6c 69 74 65 33 3a 73 74 61  nter sqlite3:sta
2490: 74 65 6d 65 6e 74 2a 20 73 74 6d 74 2a 29 0a 20  tement* stmt*). 
24a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
24b0: 20 20 20 20 64 62 20 22 22 29 29 29 0a 0a 20 28      db ""))).. (
24c0: 64 65 66 69 6e 65 20 66 69 6e 61 6c 69 7a 65 21  define finalize!
24d0: 0a 20 20 20 28 63 61 73 65 2d 6c 61 6d 62 64 61  .   (case-lambda
24e0: 0a 20 20 20 20 5b 28 78 29 0a 20 20 20 20 20 28  .    [(x).     (
24f0: 66 69 6e 61 6c 69 7a 65 21 20 78 20 23 66 29 5d  finalize! x #f)]
2500: 0a 20 20 20 20 5b 28 78 20 66 69 6e 61 6c 69 7a  .    [(x finaliz
2510: 65 2d 73 74 61 74 65 6d 65 6e 74 73 3f 29 0a 20  e-statements?). 
2520: 20 20 20 20 28 64 65 66 69 6e 65 20 73 71 6c 69      (define sqli
2530: 74 65 33 5f 66 69 6e 61 6c 69 7a 65 20 28 66 6f  te3_finalize (fo
2540: 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20  reign-procedure 
2550: 22 73 71 6c 69 74 65 33 5f 66 69 6e 61 6c 69 7a  "sqlite3_finaliz
2560: 65 22 20 28 73 71 6c 69 74 65 33 3a 73 74 61 74  e" (sqlite3:stat
2570: 65 6d 65 6e 74 2a 29 20 69 6e 74 29 29 0a 20 20  ement*) int)).  
2580: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 5b     (cond.      [
2590: 28 64 61 74 61 62 61 73 65 3f 20 78 29 0a 20 20  (database? x).  
25a0: 20 20 20 20 20 28 63 6f 6e 64 0a 09 5b 28 6e 6f       (cond..[(no
25b0: 74 20 28 64 61 74 61 62 61 73 65 2d 70 74 72 20  t (database-ptr 
25c0: 78 29 29 0a 09 20 28 76 6f 69 64 29 5d 0a 09 5b  x)).. (void)]..[
25d0: 28 6c 65 74 20 6c 6f 6f 70 20 28 5b 73 74 6d 74  (let loop ([stmt
25e0: 0a 09 09 20 20 20 20 20 28 61 6e 64 0a 09 09 20  ...     (and... 
25f0: 20 20 20 20 20 66 69 6e 61 6c 69 7a 65 2d 73 74       finalize-st
2600: 61 74 65 6d 65 6e 74 73 3f 0a 09 09 20 20 20 20  atements?...    
2610: 20 20 28 73 71 6c 69 74 65 33 2d 6e 65 78 74 2d    (sqlite3-next-
2620: 73 74 6d 74 20 78 29 29 5d 29 0a 09 20 20 20 28  stmt x))])..   (
2630: 69 66 20 73 74 6d 74 0a 09 20 20 20 20 20 20 20  if stmt..       
2640: 28 6f 72 20 28 73 71 6c 69 74 65 33 5f 66 69 6e  (or (sqlite3_fin
2650: 61 6c 69 7a 65 20 28 73 74 61 74 65 6d 65 6e 74  alize (statement
2660: 2d 70 74 72 20 73 74 6d 74 29 29 0a 09 09 20 20  -ptr stmt))...  
2670: 20 28 6c 6f 6f 70 20 28 73 71 6c 69 74 65 33 2d   (loop (sqlite3-
2680: 6e 65 78 74 2d 73 74 6d 74 20 28 73 74 61 74 65  next-stmt (state
2690: 6d 65 6e 74 2d 64 61 74 61 62 61 73 65 20 73 74  ment-database st
26a0: 6d 74 29 29 29 29 0a 09 20 20 20 20 20 20 20 28  mt))))..       (
26b0: 6c 65 74 20 28 5b 66 20 28 66 6f 72 65 69 67 6e  let ([f (foreign
26c0: 2d 70 72 6f 63 65 64 75 72 65 20 22 73 71 6c 69  -procedure "sqli
26d0: 74 65 33 5f 63 6c 6f 73 65 22 20 28 73 71 6c 69  te3_close" (sqli
26e0: 74 65 33 3a 64 61 74 61 62 61 73 65 2a 29 20 69  te3:database*) i
26f0: 6e 74 29 5d 29 0a 09 09 20 28 66 20 28 64 61 74  nt)])... (f (dat
2700: 61 62 61 73 65 2d 61 64 64 72 20 78 29 29 29 29  abase-addr x))))
2710: 29 0a 09 20 3d 3e 20 28 61 62 6f 72 74 2d 73 71  ).. => (abort-sq
2720: 6c 69 74 65 33 2d 65 72 72 6f 72 20 27 66 69 6e  lite3-error 'fin
2730: 61 6c 69 7a 65 21 20 78 20 78 29 5d 29 5d 0a 20  alize! x x)])]. 
2740: 20 20 20 20 20 5b 28 73 74 61 74 65 6d 65 6e 74       [(statement
2750: 3f 20 78 29 0a 20 20 20 20 20 20 20 28 63 6f 6e  ? x).       (con
2760: 64 0a 09 5b 28 6e 6f 74 20 28 73 74 61 74 65 6d  d..[(not (statem
2770: 65 6e 74 2d 70 74 72 20 78 29 29 0a 09 20 28 76  ent-ptr x)).. (v
2780: 6f 69 64 29 5d 0a 09 5b 20 28 73 71 6c 69 74 65  oid)]..[ (sqlite
2790: 33 5f 66 69 6e 61 6c 69 7a 65 20 28 73 74 61 74  3_finalize (stat
27a0: 65 6d 65 6e 74 2d 61 64 64 72 20 78 29 29 0a 09  ement-addr x))..
27b0: 20 20 3d 3e 20 28 61 62 6f 72 74 2d 73 71 6c 69    => (abort-sqli
27c0: 74 65 33 2d 65 72 72 6f 72 20 27 66 69 6e 61 6c  te3-error 'final
27d0: 69 7a 65 21 20 28 73 74 61 74 65 6d 65 6e 74 2d  ize! (statement-
27e0: 64 61 74 61 62 61 73 65 20 78 29 20 78 29 5d 0a  database x) x)].
27f0: 09 5b 65 6c 73 65 0a 09 20 28 73 74 61 74 65 6d  .[else.. (statem
2800: 65 6e 74 2d 70 74 72 2d 73 65 74 21 20 78 20 23  ent-ptr-set! x #
2810: 66 29 5d 29 5d 0a 20 20 20 20 20 20 5b 65 6c 73  f)])].      [els
2820: 65 0a 20 20 20 20 20 20 20 28 65 72 72 6f 72 66  e.       (errorf
2830: 20 27 66 69 6e 61 6c 69 7a 65 21 20 22 64 61 74   'finalize! "dat
2840: 61 62 61 73 65 20 6f 72 20 73 74 61 74 65 6d 65  abase or stateme
2850: 6e 74 20 7e 64 22 20 78 29 5d 29 5d 29 29 0a 20  nt ~d" x)])])). 
2860: 20 20 20 20 3b 3b 20 23 3b 28 64 65 66 69 6e 65      ;; #;(define
2870: 20 66 69 6e 61 6c 69 7a 65 21 0a 20 3b 3b 20 20   finalize!. ;;  
2880: 20 28 6d 61 74 63 68 2d 6c 61 6d 62 64 61 2a 0a   (match-lambda*.
2890: 20 3b 3b 20 20 20 20 5b 28 28 3f 20 64 61 74 61   ;;    [((? data
28a0: 62 61 73 65 3f 20 64 62 29 20 2e 20 66 69 6e 61  base? db) . fina
28b0: 6c 69 7a 65 2d 73 74 61 74 65 6d 65 6e 74 73 3f  lize-statements?
28c0: 29 0a 20 3b 3b 20 20 20 20 20 20 28 63 6f 6e 64  ). ;;      (cond
28d0: 0a 20 3b 3b 20 20 20 20 20 20 20 5b 28 6e 6f 74  . ;;       [(not
28e0: 20 28 64 61 74 61 62 61 73 65 2d 70 74 72 20 64   (database-ptr d
28f0: 62 29 29 0a 20 3b 3b 20 20 20 20 20 20 20 28 76  b)). ;;       (v
2900: 6f 69 64 29 5d 0a 20 3b 3b 20 20 20 20 20 20 20  oid)]. ;;       
2910: 5b 28 6c 65 74 20 6c 6f 6f 70 20 28 5b 73 74 6d  [(let loop ([stm
2920: 74 0a 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20  t. ;;           
2930: 20 20 20 20 20 20 20 20 28 61 6e 64 0a 20 3b 3b          (and. ;;
2940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2950: 20 20 20 20 20 28 6f 70 74 69 6f 6e 61 6c 20 66       (optional f
2960: 69 6e 61 6c 69 7a 65 2d 73 74 61 74 65 6d 65 6e  inalize-statemen
2970: 74 73 3f 20 23 66 29 0a 20 3b 3b 20 20 20 20 20  ts? #f). ;;     
2980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2990: 28 73 71 6c 69 74 65 33 5f 6e 65 78 74 5f 73 74  (sqlite3_next_st
29a0: 6d 74 20 64 62 20 23 66 29 29 5d 29 0a 20 3b 3b  mt db #f))]). ;;
29b0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 73 74            (if st
29c0: 6d 74 0a 20 3b 3b 20 20 20 20 20 20 20 20 20 20  mt. ;;          
29d0: 20 20 20 20 28 6f 72 20 28 73 71 6c 69 74 65 33      (or (sqlite3
29e0: 5f 66 69 6e 61 6c 69 7a 65 20 73 74 6d 74 29 20  _finalize stmt) 
29f0: 28 6c 6f 6f 70 20 28 73 71 6c 69 74 65 33 5f 6e  (loop (sqlite3_n
2a00: 65 78 74 5f 73 74 6d 74 20 64 62 20 73 74 6d 74  ext_stmt db stmt
2a10: 29 29 29 0a 20 3b 3b 20 20 20 20 20 20 20 20 20  ))). ;;         
2a20: 20 20 20 20 20 28 28 66 6f 72 65 69 67 6e 2d 73       ((foreign-s
2a30: 61 66 65 2d 6c 61 6d 62 64 61 20 73 71 6c 69 74  afe-lambda sqlit
2a40: 65 33 3a 73 74 61 74 75 73 20 22 73 71 6c 69 74  e3:status "sqlit
2a50: 65 33 5f 63 6c 6f 73 65 22 20 73 71 6c 69 74 65  e3_close" sqlite
2a60: 33 3a 64 61 74 61 62 61 73 65 29 20 64 62 29 29  3:database) db))
2a70: 29 0a 20 3b 3b 20 20 20 20 20 20 20 3d 3e 20 28  ). ;;       => (
2a80: 61 62 6f 72 74 2d 73 71 6c 69 74 65 33 2d 65 72  abort-sqlite3-er
2a90: 72 6f 72 20 27 66 69 6e 61 6c 69 7a 65 21 20 64  ror 'finalize! d
2aa0: 62 20 64 62 29 5d 0a 20 3b 3b 20 20 20 20 20 20  b db)]. ;;      
2ab0: 20 5b 65 6c 73 65 0a 20 3b 3b 20 20 20 20 20 20   [else. ;;      
2ac0: 20 28 6c 65 74 20 28 5b 69 64 20 28 70 6f 69 6e   (let ([id (poin
2ad0: 74 65 72 2d 3e 61 64 64 72 65 73 73 20 28 64 61  ter->address (da
2ae0: 74 61 62 61 73 65 2d 70 74 72 20 64 62 29 29 5d  tabase-ptr db))]
2af0: 0a 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20  . ;;            
2b00: 20 5b 72 65 6c 65 61 73 65 2d 71 6e 73 20 28 6c   [release-qns (l
2b10: 61 6d 62 64 61 20 28 5f 20 69 6e 66 6f 29 20 28  ambda (_ info) (
2b20: 6f 62 6a 65 63 74 2d 72 65 6c 65 61 73 65 20 28  object-release (
2b30: 76 65 63 74 6f 72 2d 72 65 66 20 69 6e 66 6f 20  vector-ref info 
2b40: 30 29 29 29 5d 29 0a 20 3b 3b 20 20 20 20 20 20  0)))]). ;;      
2b50: 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 2f 73 79     (call-with/sy
2b60: 6e 63 68 20 2a 63 6f 6c 6c 61 74 69 6f 6e 73 2a  nch *collations*
2b70: 0a 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20  . ;;            
2b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
2b90: 63 75 74 65 20 68 61 73 68 2d 74 61 62 6c 65 2d  cute hash-table-
2ba0: 74 72 65 65 2d 63 6c 65 61 72 21 20 3c 3e 20 69  tree-clear! <> i
2bb0: 64 20 72 65 6c 65 61 73 65 2d 71 6e 73 29 29 0a  d release-qns)).
2bc0: 20 3b 3b 20 20 20 20 20 20 20 20 20 28 63 61 6c   ;;         (cal
2bd0: 6c 2d 77 69 74 68 2f 73 79 6e 63 68 20 2a 66 75  l-with/synch *fu
2be0: 6e 63 74 69 6f 6e 73 2a 0a 20 3b 3b 20 20 20 20  nctions*. ;;    
2bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2c00: 20 20 20 20 20 20 20 28 63 75 74 65 20 68 61 73         (cute has
2c10: 68 2d 74 61 62 6c 65 2d 74 72 65 65 2d 63 6c 65  h-table-tree-cle
2c20: 61 72 21 20 3c 3e 20 69 64 20 72 65 6c 65 61 73  ar! <> id releas
2c30: 65 2d 71 6e 73 29 29 0a 20 3b 3b 20 20 20 20 20  e-qns)). ;;     
2c40: 20 20 20 20 28 64 61 74 61 62 61 73 65 2d 70 74      (database-pt
2c50: 72 2d 73 65 74 21 20 64 62 20 23 66 29 0a 20 3b  r-set! db #f). ;
2c60: 3b 20 20 20 20 20 20 20 20 20 28 64 61 74 61 62  ;         (datab
2c70: 61 73 65 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72  ase-busy-handler
2c80: 2d 73 65 74 21 20 64 62 20 23 66 29 29 5d 29 5d  -set! db #f))])]
2c90: 0a 20 3b 3b 20 20 20 20 5b 28 28 3f 20 73 74 61  . ;;    [((? sta
2ca0: 74 65 6d 65 6e 74 3f 20 73 74 6d 74 29 29 0a 20  tement? stmt)). 
2cb0: 3b 3b 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 3b  ;;      (cond. ;
2cc0: 3b 20 20 20 20 20 20 20 5b 28 6e 6f 74 20 28 73  ;       [(not (s
2cd0: 74 61 74 65 6d 65 6e 74 2d 70 74 72 20 73 74 6d  tatement-ptr stm
2ce0: 74 29 29 0a 20 3b 3b 20 20 20 20 20 20 20 28 76  t)). ;;       (v
2cf0: 6f 69 64 29 5d 0a 20 3b 3b 20 20 20 20 20 20 20  oid)]. ;;       
2d00: 5b 28 73 71 6c 69 74 65 33 5f 66 69 6e 61 6c 69  [(sqlite3_finali
2d10: 7a 65 20 28 73 74 61 74 65 6d 65 6e 74 2d 70 74  ze (statement-pt
2d20: 72 20 73 74 6d 74 29 29 0a 20 3b 3b 20 20 20 20  r stmt)). ;;    
2d30: 20 20 20 3d 3e 20 28 61 62 6f 72 74 2d 73 71 6c     => (abort-sql
2d40: 69 74 65 33 2d 65 72 72 6f 72 20 27 66 69 6e 61  ite3-error 'fina
2d50: 6c 69 7a 65 21 20 28 73 74 61 74 65 6d 65 6e 74  lize! (statement
2d60: 2d 64 61 74 61 62 61 73 65 20 73 74 6d 74 29 20  -database stmt) 
2d70: 73 74 6d 74 29 5d 0a 20 3b 3b 20 20 20 20 20 20  stmt)]. ;;      
2d80: 20 5b 65 6c 73 65 0a 20 3b 3b 20 20 20 20 20 20   [else. ;;      
2d90: 20 28 73 74 61 74 65 6d 65 6e 74 2d 70 74 72 2d   (statement-ptr-
2da0: 73 65 74 21 20 73 74 6d 74 20 23 66 29 5d 29 5d  set! stmt #f)])]
2db0: 0a 20 3b 3b 20 20 20 20 5b 28 76 20 2e 20 5f 29  . ;;    [(v . _)
2dc0: 0a 20 3b 3b 20 20 20 20 20 20 28 65 72 72 6f 72  . ;;      (error
2dd0: 2d 61 72 67 75 6d 65 6e 74 2d 74 79 70 65 20 27  -argument-type '
2de0: 66 69 6e 61 6c 69 7a 65 21 20 76 20 22 64 61 74  finalize! v "dat
2df0: 61 62 61 73 65 20 6f 72 20 73 74 61 74 65 6d 65  abase or stateme
2e00: 6e 74 22 29 5d 29 29 0a 0a 3b 3b 3b 20 53 74 61  nt")]))..;;; Sta
2e10: 74 65 6d 65 6e 74 20 69 6e 74 65 72 66 61 63 65  tement interface
2e20: 0a 20 28 64 65 66 69 6e 65 20 73 71 6c 69 74 65  . (define sqlite
2e30: 33 5f 70 72 65 70 61 72 65 5f 76 32 20 28 66 6f  3_prepare_v2 (fo
2e40: 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20  reign-procedure 
2e50: 22 73 71 6c 69 74 65 33 5f 70 72 65 70 61 72 65  "sqlite3_prepare
2e60: 5f 76 32 22 0a 20 20 20 20 20 20 20 20 20 20 20  _v2".           
2e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e90: 20 20 20 20 28 20 73 71 6c 69 74 65 33 3a 64 61      ( sqlite3:da
2ea0: 74 61 62 61 73 65 2a 20 75 38 2a 20 69 6e 74 20  tabase* u8* int 
2eb0: 76 6f 69 64 2a 20 75 38 2a 29 20 69 6e 74 29 29  void* u8*) int))
2ec0: 0a 20 28 64 65 66 69 6e 65 20 28 61 6c 6c 6f 63  . (define (alloc
2ed0: 2d 73 74 61 74 65 6d 65 6e 74 2a 29 0a 20 20 20  -statement*).   
2ee0: 28 6d 61 6b 65 2d 66 74 79 70 65 2d 70 6f 69 6e  (make-ftype-poin
2ef0: 74 65 72 20 73 71 6c 69 74 65 33 3a 73 74 61 74  ter sqlite3:stat
2f00: 65 6d 65 6e 74 2a 2a 0a 20 20 20 20 20 20 20 20  ement**.        
2f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
2f20: 66 6f 72 65 69 67 6e 2d 61 6c 6c 6f 63 20 28 66  foreign-alloc (f
2f30: 74 79 70 65 2d 73 69 7a 65 6f 66 20 73 71 6c 69  type-sizeof sqli
2f40: 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a 2a 29  te3:statement**)
2f50: 29 29 29 0a 0a 20 3b 3b 20 43 72 65 61 74 65 20  ))).. ;; Create 
2f60: 61 20 6e 65 77 20 73 74 61 74 65 6d 65 6e 74 0a  a new statement.
2f70: 20 28 64 65 66 69 6e 65 20 28 70 72 65 70 61 72   (define (prepar
2f80: 65 20 64 62 20 73 71 6c 29 0a 20 20 20 28 63 68  e db sql).   (ch
2f90: 65 63 6b 2d 64 61 74 61 62 61 73 65 20 27 70 72  eck-database 'pr
2fa0: 65 70 61 72 65 20 64 62 29 0a 20 20 20 28 61 73  epare db).   (as
2fb0: 73 65 72 74 20 28 61 6e 64 20 70 72 65 70 61 72  sert (and prepar
2fc0: 65 20 28 73 74 72 69 6e 67 3f 20 73 71 6c 29 29  e (string? sql))
2fd0: 29 0a 20 20 20 28 6c 65 74 20 72 65 74 72 79 20  ).   (let retry 
2fe0: 28 5b 72 65 74 72 69 65 73 20 30 5d 29 0a 20 20  ([retries 0]).  
2ff0: 20 20 20 28 6c 65 74 2a 20 28 5b 70 74 72 20 28     (let* ([ptr (
3000: 61 6c 6c 6f 63 2d 73 74 61 74 65 6d 65 6e 74 2a  alloc-statement*
3010: 29 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 5b  )].            [
3020: 7a 53 71 6c 20 28 73 74 72 69 6e 67 2d 3e 75 74  zSql (string->ut
3030: 66 38 20 73 71 6c 29 5d 0a 20 20 20 20 20 20 20  f8 sql)].       
3040: 20 20 20 20 20 5b 6e 42 79 74 65 20 28 62 79 74       [nByte (byt
3050: 65 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 7a  evector-length z
3060: 53 71 6c 29 5d 0a 20 20 20 20 20 20 20 20 20 20  Sql)].          
3070: 20 20 5b 65 20 28 73 71 6c 69 74 65 33 5f 70 72    [e (sqlite3_pr
3080: 65 70 61 72 65 5f 76 32 20 28 64 61 74 61 62 61  epare_v2 (databa
3090: 73 65 2d 61 64 64 72 20 64 62 29 20 7a 53 71 6c  se-addr db) zSql
30a0: 20 6e 42 79 74 65 20 28 66 74 79 70 65 2d 70 6f   nByte (ftype-po
30b0: 69 6e 74 65 72 2d 61 64 64 72 65 73 73 20 70 74  inter-address pt
30c0: 72 29 20 23 66 29 5d 29 0a 20 20 20 20 20 20 20  r) #f)]).       
30d0: 28 63 6f 6e 64 20 5b 28 65 71 75 61 6c 3f 20 65  (cond [(equal? e
30e0: 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20   0).            
30f0: 20 20 28 6d 61 6b 65 2d 73 74 61 74 65 6d 65 6e    (make-statemen
3100: 74 20 28 66 74 79 70 65 2d 26 72 65 66 20 73 71  t (ftype-&ref sq
3110: 6c 69 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a  lite3:statement*
3120: 2a 20 28 2a 29 20 70 74 72 29 20 64 62 20 73 71  * (*) ptr) db sq
3130: 6c 29 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20  l)].            
3140: 20 5b 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20   [else.         
3150: 20 20 20 20 20 28 63 61 73 65 20 28 6e 75 6d 62       (case (numb
3160: 65 72 2d 3e 73 71 6c 69 74 65 33 3a 73 74 61 74  er->sqlite3:stat
3170: 75 73 20 65 29 0a 20 20 20 20 20 20 20 20 20 20  us e).          
3180: 20 20 20 20 20 20 23 3b 5b 28 62 75 73 79 29 0a        #;[(busy).
3190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
31a0: 20 28 6c 65 74 20 28 5b 68 20 28 64 61 74 61 62   (let ([h (datab
31b0: 61 73 65 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72  ase-busy-handler
31c0: 20 64 62 29 5d 29 0a 20 20 20 20 20 20 20 20 20   db)]).         
31d0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a            (cond.
31e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
31f0: 20 20 20 20 5b 28 61 6e 64 20 68 20 28 68 20 64      [(and h (h d
3200: 62 20 72 65 74 72 69 65 73 29 29 0a 20 20 20 20  b retries)).    
3210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3220: 20 28 72 65 74 72 79 20 28 66 78 2b 20 72 65 74   (retry (fx+ ret
3230: 72 69 65 73 20 31 29 29 5d 0a 20 20 20 20 20 20  ries 1))].      
3240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 65                [e
3250: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20  lse.            
3260: 20 20 20 20 20 20 20 20 20 28 28 61 62 6f 72 74           ((abort
3270: 2d 73 71 6c 69 74 65 33 2d 65 72 72 6f 72 20 27  -sqlite3-error '
3280: 70 72 65 70 61 72 65 20 64 62 20 64 62 20 73 71  prepare db db sq
3290: 6c 29 20 65 29 5d 29 29 5d 0a 20 20 20 20 20 20  l) e)]))].      
32a0: 20 20 20 20 20 20 20 20 20 20 5b 65 6c 73 65 0a            [else.
32b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
32c0: 20 28 28 61 62 6f 72 74 2d 73 71 6c 69 74 65 33   ((abort-sqlite3
32d0: 2d 65 72 72 6f 72 20 27 70 72 65 70 61 72 65 20  -error 'prepare 
32e0: 64 62 20 64 62 20 73 71 6c 29 20 65 29 5d 29 5d  db db sql) e)])]
32f0: 29 29 29 29 0a 0a 20 3b 3b 20 52 65 74 72 69 65  )))).. ;; Retrie
3300: 76 65 20 74 68 65 20 53 51 4c 20 73 6f 75 72 63  ve the SQL sourc
3310: 65 20 63 6f 64 65 20 6f 66 20 61 20 73 74 61 74  e code of a stat
3320: 65 6d 65 6e 74 0a 20 28 64 65 66 69 6e 65 20 28  ement. (define (
3330: 73 6f 75 72 63 65 2d 73 71 6c 20 73 74 6d 74 29  source-sql stmt)
3340: 0a 20 20 20 28 63 68 65 63 6b 2d 73 74 61 74 65  .   (check-state
3350: 6d 65 6e 74 20 27 73 6f 75 72 63 65 2d 73 71 6c  ment 'source-sql
3360: 20 73 74 6d 74 29 0a 20 20 20 28 6c 65 74 2a 20   stmt).   (let* 
3370: 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f  ([f (foreign-pro
3380: 63 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f  cedure "sqlite3_
3390: 73 71 6c 22 20 28 73 71 6c 69 74 65 33 3a 73 74  sql" (sqlite3:st
33a0: 61 74 65 6d 65 6e 74 2a 29 20 73 74 72 69 6e 67  atement*) string
33b0: 29 5d 29 0a 20 20 20 20 20 28 66 20 28 73 74 61  )]).     (f (sta
33c0: 74 65 6d 65 6e 74 2d 61 64 64 72 20 73 74 6d 74  tement-addr stmt
33d0: 29 29 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 28  )))).. (define (
33e0: 66 69 6e 61 6c 69 7a 65 2d 73 74 61 74 65 6d 65  finalize-stateme
33f0: 6e 74 21 20 73 74 6d 74 29 0a 20 20 20 28 63 68  nt! stmt).   (ch
3400: 65 63 6b 2d 73 74 61 74 65 6d 65 6e 74 20 27 66  eck-statement 'f
3410: 69 6e 61 6c 69 7a 65 2d 73 74 61 74 65 6d 65 6e  inalize-statemen
3420: 74 21 20 73 74 6d 74 29 0a 20 20 20 28 6c 65 74  t! stmt).   (let
3430: 2a 20 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70  * ([f (foreign-p
3440: 72 6f 63 65 64 75 72 65 20 22 73 71 6c 69 74 65  rocedure "sqlite
3450: 33 5f 66 69 6e 61 6c 69 7a 65 22 20 20 28 73 71  3_finalize"  (sq
3460: 6c 69 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a  lite3:statement*
3470: 29 20 69 6e 74 29 5d 0a 20 20 20 20 20 20 20 20  ) int)].        
3480: 20 20 5b 6e 20 28 66 20 28 73 74 61 74 65 6d 65    [n (f (stateme
3490: 6e 74 2d 61 64 64 72 20 73 74 6d 74 29 29 5d 29  nt-addr stmt))])
34a0: 0a 20 20 20 20 20 28 73 74 61 74 65 6d 65 6e 74  .     (statement
34b0: 2d 70 74 72 2d 73 65 74 21 20 73 74 6d 74 20 23  -ptr-set! stmt #
34c0: 66 29 0a 20 20 20 20 20 6e 29 29 0a 0a 20 3b 3b  f).     n)).. ;;
34d0: 20 52 65 73 65 74 20 61 6e 20 65 78 69 73 74 69   Reset an existi
34e0: 6e 67 20 73 74 61 74 65 6d 65 6e 74 20 74 6f 20  ng statement to 
34f0: 70 72 6f 63 65 73 73 20 69 74 20 61 67 61 69 6e  process it again
3500: 0a 20 28 64 65 66 69 6e 65 20 28 72 65 73 65 74  . (define (reset
3510: 21 20 73 74 6d 74 29 0a 20 20 20 28 63 68 65 63  ! stmt).   (chec
3520: 6b 2d 73 74 61 74 65 6d 65 6e 74 20 27 72 65 73  k-statement 'res
3530: 65 74 21 20 73 74 6d 74 29 0a 20 20 20 28 63 6f  et! stmt).   (co
3540: 6e 64 20 5b 28 28 66 6f 72 65 69 67 6e 2d 70 72  nd [((foreign-pr
3550: 6f 63 65 64 75 72 65 20 20 22 73 71 6c 69 74 65  ocedure  "sqlite
3560: 33 5f 72 65 73 65 74 22 20 28 73 71 6c 69 74 65  3_reset" (sqlite
3570: 33 3a 73 74 61 74 65 6d 65 6e 74 2a 29 20 69 6e  3:statement*) in
3580: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 73  t).           (s
3590: 74 61 74 65 6d 65 6e 74 2d 61 64 64 72 20 73 74  tatement-addr st
35a0: 6d 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 3d  mt)).          =
35b0: 3e 20 28 61 62 6f 72 74 2d 73 71 6c 69 74 65 33  > (abort-sqlite3
35c0: 2d 65 72 72 6f 72 20 27 72 65 73 65 74 21 20 28  -error 'reset! (
35d0: 73 74 61 74 65 6d 65 6e 74 2d 64 61 74 61 62 61  statement-databa
35e0: 73 65 20 73 74 6d 74 29 20 73 74 6d 74 29 5d 29  se stmt) stmt)])
35f0: 29 0a 0a 20 3b 3b 20 47 65 74 20 6e 75 6d 62 65  ).. ;; Get numbe
3600: 72 20 6f 66 20 62 69 6e 64 61 62 6c 65 20 70 61  r of bindable pa
3610: 72 61 6d 65 74 65 72 73 0a 20 28 64 65 66 69 6e  rameters. (defin
3620: 65 20 28 62 69 6e 64 2d 70 61 72 61 6d 65 74 65  e (bind-paramete
3630: 72 2d 63 6f 75 6e 74 20 73 74 6d 74 29 0a 20 20  r-count stmt).  
3640: 20 28 63 68 65 63 6b 2d 73 74 61 74 65 6d 65 6e   (check-statemen
3650: 74 20 27 62 69 6e 64 2d 70 61 72 61 6d 65 74 65  t 'bind-paramete
3660: 72 2d 63 6f 75 6e 74 20 73 74 6d 74 29 0a 20 20  r-count stmt).  
3670: 20 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65   ((foreign-proce
3680: 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 62 69  dure "sqlite3_bi
3690: 6e 64 5f 70 61 72 61 6d 65 74 65 72 5f 63 6f 75  nd_parameter_cou
36a0: 6e 74 22 20 28 73 71 6c 69 74 65 33 3a 73 74 61  nt" (sqlite3:sta
36b0: 74 65 6d 65 6e 74 2a 29 20 69 6e 74 29 0a 20 20  tement*) int).  
36c0: 20 20 28 73 74 61 74 65 6d 65 6e 74 2d 61 64 64    (statement-add
36d0: 72 20 73 74 6d 74 29 29 29 0a 0a 20 3b 3b 20 47  r stmt))).. ;; G
36e0: 65 74 20 69 6e 64 65 78 20 6f 66 20 61 20 62 69  et index of a bi
36f0: 6e 64 61 62 6c 65 20 70 61 72 61 6d 65 74 65 72  ndable parameter
3700: 20 6f 72 20 23 66 20 69 66 20 6e 6f 20 70 61 72   or #f if no par
3710: 61 6d 65 74 65 72 20 77 69 74 68 20 74 68 65 0a  ameter with the.
3720: 20 3b 3b 20 67 69 76 65 6e 20 6e 61 6d 65 20 65   ;; given name e
3730: 78 69 73 74 73 0a 20 28 64 65 66 69 6e 65 20 28  xists. (define (
3740: 62 69 6e 64 2d 70 61 72 61 6d 65 74 65 72 2d 69  bind-parameter-i
3750: 6e 64 65 78 20 73 74 6d 74 20 6e 61 6d 65 29 0a  ndex stmt name).
3760: 20 20 20 28 63 68 65 63 6b 2d 73 74 61 74 65 6d     (check-statem
3770: 65 6e 74 20 27 62 69 6e 64 2d 70 61 72 61 6d 65  ent 'bind-parame
3780: 74 65 72 2d 69 6e 64 65 78 20 73 74 6d 74 29 0a  ter-index stmt).
3790: 20 20 20 28 6c 65 74 20 28 5b 69 20 28 28 66 6f     (let ([i ((fo
37a0: 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20  reign-procedure 
37b0: 22 73 71 6c 69 74 65 33 5f 62 69 6e 64 5f 70 61  "sqlite3_bind_pa
37c0: 72 61 6d 65 74 65 72 5f 69 6e 64 65 78 22 0a 20  rameter_index". 
37d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
37e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
37f0: 73 71 6c 69 74 65 33 3a 73 74 61 74 65 6d 65 6e  sqlite3:statemen
3800: 74 2a 20 73 74 72 69 6e 67 29 20 69 6e 74 29 0a  t* string) int).
3810: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74               (st
3820: 61 74 65 6d 65 6e 74 2d 61 64 64 72 20 73 74 6d  atement-addr stm
3830: 74 29 20 6e 61 6d 65 29 5d 29 0a 20 20 20 20 20  t) name)]).     
3840: 28 69 66 20 28 7a 65 72 6f 3f 20 69 29 0a 20 20  (if (zero? i).  
3850: 20 20 20 20 20 20 20 23 66 0a 20 20 20 20 20 20         #f.      
3860: 20 20 20 28 66 78 2d 20 69 20 31 29 29 29 29 0a     (fx- i 1)))).
3870: 0a 20 3b 3b 20 47 65 74 20 74 68 65 20 6e 61 6d  . ;; Get the nam
3880: 65 20 6f 66 20 61 20 62 69 6e 64 61 62 6c 65 20  e of a bindable 
3890: 70 61 72 61 6d 65 74 65 72 0a 20 28 64 65 66 69  parameter. (defi
38a0: 6e 65 20 28 62 69 6e 64 2d 70 61 72 61 6d 65 74  ne (bind-paramet
38b0: 65 72 2d 6e 61 6d 65 20 73 74 6d 74 20 69 29 0a  er-name stmt i).
38c0: 20 20 20 28 63 68 65 63 6b 2d 73 74 61 74 65 6d     (check-statem
38d0: 65 6e 74 20 27 62 69 6e 64 2d 70 61 72 61 6d 65  ent 'bind-parame
38e0: 74 65 72 2d 6e 61 6d 65 20 73 74 6d 74 29 0a 20  ter-name stmt). 
38f0: 20 20 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63    ((foreign-proc
3900: 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 62  edure "sqlite3_b
3910: 69 6e 64 5f 70 61 72 61 6d 65 74 65 72 5f 6e 61  ind_parameter_na
3920: 6d 65 22 20 28 73 71 6c 69 74 65 33 3a 73 74 61  me" (sqlite3:sta
3930: 74 65 6d 65 6e 74 2a 20 69 6e 74 29 20 73 74 72  tement* int) str
3940: 69 6e 67 29 0a 20 20 20 20 28 73 74 61 74 65 6d  ing).    (statem
3950: 65 6e 74 2d 61 64 64 72 20 73 74 6d 74 29 20 28  ent-addr stmt) (
3960: 66 78 2b 20 69 20 31 29 29 29 0a 0a 20 3b 3b 20  fx+ i 1))).. ;; 
3970: 42 69 6e 64 20 64 61 74 61 20 61 73 20 70 61 72  Bind data as par
3980: 61 6d 65 74 65 72 73 20 74 6f 20 61 6e 20 65 78  ameters to an ex
3990: 69 73 74 69 6e 67 20 73 74 61 74 65 6d 65 6e 74  isting statement
39a0: 0a 0a 20 28 64 65 66 69 6e 65 20 53 51 4c 49 54  .. (define SQLIT
39b0: 45 5f 54 52 41 4e 53 49 45 4e 54 20 2d 31 29 0a  E_TRANSIENT -1).
39c0: 20 28 64 65 66 69 6e 65 20 28 62 69 6e 64 21 20   (define (bind! 
39d0: 73 74 6d 74 20 69 20 76 29 0a 20 20 20 28 63 68  stmt i v).   (ch
39e0: 65 63 6b 2d 73 74 61 74 65 6d 65 6e 74 20 27 62  eck-statement 'b
39f0: 69 6e 64 21 20 73 74 6d 74 29 0a 20 20 20 28 61  ind! stmt).   (a
3a00: 73 73 65 72 74 20 28 61 6e 64 20 62 69 6e 64 21  ssert (and bind!
3a10: 20 28 6e 75 6d 62 65 72 3f 20 69 29 20 28 3e 3d   (number? i) (>=
3a20: 20 69 20 30 29 29 29 0a 20 20 20 28 63 6f 6e 64   i 0))).   (cond
3a30: 0a 20 20 20 20 5b 28 62 79 74 65 76 65 63 74 6f  .    [(bytevecto
3a40: 72 3f 20 76 29 0a 20 20 20 20 20 28 63 6f 6e 64  r? v).     (cond
3a50: 20 5b 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63   [((foreign-proc
3a60: 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 62  edure "sqlite3_b
3a70: 69 6e 64 5f 62 6c 6f 62 22 20 28 73 71 6c 69 74  ind_blob" (sqlit
3a80: 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a 20 69 6e  e3:statement* in
3a90: 74 20 75 38 2a 20 69 6e 74 20 76 6f 69 64 2a 29  t u8* int void*)
3aa0: 20 69 6e 74 29 0a 20 20 20 20 20 20 20 20 20 20   int).          
3ab0: 20 20 20 28 73 74 61 74 65 6d 65 6e 74 2d 61 64     (statement-ad
3ac0: 64 72 20 73 74 6d 74 29 20 28 66 78 2b 20 69 20  dr stmt) (fx+ i 
3ad0: 31 29 20 76 20 28 62 79 74 65 76 65 63 74 6f 72  1) v (bytevector
3ae0: 2d 6c 65 6e 67 74 68 20 76 29 20 53 51 4c 49 54  -length v) SQLIT
3af0: 45 5f 54 52 41 4e 53 49 45 4e 54 29 0a 20 20 20  E_TRANSIENT).   
3b00: 20 20 20 20 20 20 20 20 20 3d 3e 20 28 61 62 6f           => (abo
3b10: 72 74 2d 73 71 6c 69 74 65 33 2d 65 72 72 6f 72  rt-sqlite3-error
3b20: 20 27 62 69 6e 64 21 20 28 73 74 61 74 65 6d 65   'bind! (stateme
3b30: 6e 74 2d 64 61 74 61 62 61 73 65 20 73 74 6d 74  nt-database stmt
3b40: 29 20 73 74 6d 74 20 69 20 76 29 5d 29 5d 0a 20  ) stmt i v)])]. 
3b50: 20 20 20 5b 28 6f 72 20 28 61 6e 64 20 28 66 69     [(or (and (fi
3b60: 78 6e 75 6d 3f 20 76 29 20 76 29 20 28 61 6e 64  xnum? v) v) (and
3b70: 20 28 62 6f 6f 6c 65 61 6e 3f 20 76 29 20 28 69   (boolean? v) (i
3b80: 66 20 76 20 31 20 30 29 29 29 0a 20 20 20 20 20  f v 1 0))).     
3b90: 3d 3e 20 28 6c 61 6d 62 64 61 20 28 76 29 0a 20  => (lambda (v). 
3ba0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 20 5b           (cond [
3bb0: 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64  ((foreign-proced
3bc0: 75 72 65 20 22 73 71 6c 69 74 65 33 5f 62 69 6e  ure "sqlite3_bin
3bd0: 64 5f 69 6e 74 36 34 22 0a 20 20 20 20 20 20 20  d_int64".       
3be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73                (s
3c00: 71 6c 69 74 65 33 3a 73 74 61 74 65 6d 65 6e 74  qlite3:statement
3c10: 2a 20 69 6e 74 20 69 6e 74 65 67 65 72 2d 36 34  * int integer-64
3c20: 29 20 69 6e 74 29 0a 20 20 20 20 20 20 20 20 20  ) int).         
3c30: 20 20 20 20 20 20 20 20 20 28 73 74 61 74 65 6d           (statem
3c40: 65 6e 74 2d 61 64 64 72 20 73 74 6d 74 29 20 28  ent-addr stmt) (
3c50: 66 78 2b 20 69 20 31 29 20 76 29 0a 20 20 20 20  fx+ i 1) v).    
3c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20               => 
3c70: 28 61 62 6f 72 74 2d 73 71 6c 69 74 65 33 2d 65  (abort-sqlite3-e
3c80: 72 72 6f 72 20 27 62 69 6e 64 21 20 28 73 74 61  rror 'bind! (sta
3c90: 74 65 6d 65 6e 74 2d 64 61 74 61 62 61 73 65 20  tement-database 
3ca0: 73 74 6d 74 29 20 73 74 6d 74 20 69 20 76 29 5d  stmt) stmt i v)]
3cb0: 29 29 5d 0a 20 20 20 20 5b 28 66 6c 6f 6e 75 6d  ))].    [(flonum
3cc0: 3f 20 76 29 0a 20 20 20 20 20 28 63 6f 6e 64 20  ? v).     (cond 
3cd0: 5b 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65  [((foreign-proce
3ce0: 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 62 69  dure "sqlite3_bi
3cf0: 6e 64 5f 64 6f 75 62 6c 65 22 0a 20 20 20 20 20  nd_double".     
3d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3d10: 20 20 20 20 20 20 20 20 20 20 20 28 73 71 6c 69             (sqli
3d20: 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a 20 69  te3:statement* i
3d30: 6e 74 20 64 6f 75 62 6c 65 29 20 69 6e 74 29 0a  nt double) int).
3d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74               (st
3d50: 61 74 65 6d 65 6e 74 2d 61 64 64 72 20 73 74 6d  atement-addr stm
3d60: 74 29 20 28 66 78 2b 20 69 20 31 29 20 28 65 78  t) (fx+ i 1) (ex
3d70: 61 63 74 2d 3e 69 6e 65 78 61 63 74 20 76 29 29  act->inexact v))
3d80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20  .            => 
3d90: 28 61 62 6f 72 74 2d 73 71 6c 69 74 65 33 2d 65  (abort-sqlite3-e
3da0: 72 72 6f 72 20 27 62 69 6e 64 21 20 28 73 74 61  rror 'bind! (sta
3db0: 74 65 6d 65 6e 74 2d 64 61 74 61 62 61 73 65 20  tement-database 
3dc0: 73 74 6d 74 29 20 73 74 6d 74 20 69 20 76 29 5d  stmt) stmt i v)]
3dd0: 29 5d 0a 20 20 20 20 5b 28 6f 72 20 28 73 74 72  )].    [(or (str
3de0: 69 6e 67 3f 20 76 29 20 28 6e 75 6d 62 65 72 3f  ing? v) (number?
3df0: 20 76 29 29 0a 20 20 20 20 20 28 6c 65 74 20 28   v)).     (let (
3e00: 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63  [f (foreign-proc
3e10: 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 62  edure "sqlite3_b
3e20: 69 6e 64 5f 74 65 78 74 22 0a 20 20 20 20 20 20  ind_text".      
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3e40: 20 20 20 20 20 20 20 20 20 20 20 28 73 71 6c 69             (sqli
3e50: 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a 20 69  te3:statement* i
3e60: 6e 74 20 75 38 2a 20 69 6e 74 20 76 6f 69 64 2a  nt u8* int void*
3e70: 29 20 69 6e 74 29 5d 0a 20 20 20 20 20 20 20 20  ) int)].        
3e80: 20 20 20 5b 73 20 28 69 66 20 28 73 74 72 69 6e     [s (if (strin
3e90: 67 3f 20 76 29 0a 09 09 20 20 28 73 74 72 69 6e  g? v)...  (strin
3ea0: 67 2d 3e 75 74 66 38 20 76 29 0a 09 09 20 20 28  g->utf8 v)...  (
3eb0: 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 76  number->string v
3ec0: 29 29 5d 29 0a 20 20 20 20 20 20 20 28 63 6f 6e  ))]).       (con
3ed0: 64 20 5b 28 66 20 28 73 74 61 74 65 6d 65 6e 74  d [(f (statement
3ee0: 2d 61 64 64 72 20 73 74 6d 74 29 20 28 66 78 2b  -addr stmt) (fx+
3ef0: 20 69 20 31 29 20 73 20 28 62 79 74 65 76 65 63   i 1) s (bytevec
3f00: 74 6f 72 2d 6c 65 6e 67 74 68 20 73 29 20 53 51  tor-length s) SQ
3f10: 4c 49 54 45 5f 54 52 41 4e 53 49 45 4e 54 29 0a  LITE_TRANSIENT).
3f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d 3e                =>
3f30: 20 28 61 62 6f 72 74 2d 73 71 6c 69 74 65 33 2d   (abort-sqlite3-
3f40: 65 72 72 6f 72 20 27 62 69 6e 64 21 20 28 73 74  error 'bind! (st
3f50: 61 74 65 6d 65 6e 74 2d 64 61 74 61 62 61 73 65  atement-database
3f60: 20 73 74 6d 74 29 20 73 74 6d 74 20 69 20 76 29   stmt) stmt i v)
3f70: 5d 29 29 5d 0a 20 20 20 20 5b 28 73 71 6c 2d 6e  ]))].    [(sql-n
3f80: 75 6c 6c 3f 20 76 29 0a 20 20 20 20 20 28 63 6f  ull? v).     (co
3f90: 6e 64 20 5b 28 28 66 6f 72 65 69 67 6e 2d 70 72  nd [((foreign-pr
3fa0: 6f 63 65 64 75 72 65 20 22 73 71 6c 69 74 65 33  ocedure "sqlite3
3fb0: 5f 62 69 6e 64 5f 6e 75 6c 6c 22 20 28 73 71 6c  _bind_null" (sql
3fc0: 69 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a 20  ite3:statement* 
3fd0: 69 6e 74 29 20 69 6e 74 29 0a 20 20 20 20 20 20  int) int).      
3fe0: 20 20 20 20 20 20 20 28 73 74 61 74 65 6d 65 6e         (statemen
3ff0: 74 2d 61 64 64 72 20 73 74 6d 74 29 20 28 66 78  t-addr stmt) (fx
4000: 2b 20 69 20 31 29 29 0a 20 20 20 20 20 20 20 20  + i 1)).        
4010: 20 20 20 20 3d 3e 20 28 61 62 6f 72 74 2d 73 71      => (abort-sq
4020: 6c 69 74 65 33 2d 65 72 72 6f 72 20 27 62 69 6e  lite3-error 'bin
4030: 64 21 20 28 73 74 61 74 65 6d 65 6e 74 2d 64 61  d! (statement-da
4040: 74 61 62 61 73 65 20 73 74 6d 74 29 20 73 74 6d  tabase stmt) stm
4050: 74 20 69 29 5d 29 5d 0a 20 20 20 20 5b 65 6c 73  t i)])].    [els
4060: 65 0a 20 20 20 20 20 28 65 72 72 6f 72 20 27 62  e.     (error 'b
4070: 69 6e 64 21 20 22 62 6c 6f 62 2c 20 6e 75 6d 62  ind! "blob, numb
4080: 65 72 2c 20 62 6f 6f 6c 65 61 6e 2c 20 73 74 72  er, boolean, str
4090: 69 6e 67 20 6f 72 20 73 71 6c 2d 6e 75 6c 6c 22  ing or sql-null"
40a0: 20 76 29 5d 29 29 0a 0a 20 20 20 20 20 20 20 20   v)]))..        
40b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
40c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
40d0: 3b 20 48 65 6c 70 65 72 0a 0a 20 28 64 65 66 69  ; Helper.. (defi
40e0: 6e 65 20 28 25 62 69 6e 64 2d 70 61 72 61 6d 65  ne (%bind-parame
40f0: 74 65 72 73 21 20 6c 6f 63 20 73 74 6d 74 20 70  ters! loc stmt p
4100: 61 72 61 6d 73 29 0a 20 20 20 28 72 65 73 65 74  arams).   (reset
4110: 21 20 73 74 6d 74 29 0a 20 20 20 28 6c 65 74 20  ! stmt).   (let 
4120: 28 5b 63 6e 74 20 28 62 69 6e 64 2d 70 61 72 61  ([cnt (bind-para
4130: 6d 65 74 65 72 2d 63 6f 75 6e 74 20 73 74 6d 74  meter-count stmt
4140: 29 5d 0a 20 20 20 20 20 20 20 20 20 5b 76 73 20  )].         [vs 
4150: 28 6d 61 6b 65 2d 65 71 2d 68 61 73 68 74 61 62  (make-eq-hashtab
4160: 6c 65 29 5d 29 0a 20 20 20 20 20 28 6c 65 74 20  le)]).     (let 
4170: 6c 6f 6f 70 20 28 5b 69 20 30 5d 20 5b 70 61 72  loop ([i 0] [par
4180: 61 6d 73 20 70 61 72 61 6d 73 5d 29 0a 20 20 20  ams params]).   
4190: 20 20 20 20 28 6d 61 74 63 68 20 70 61 72 61 6d      (match param
41a0: 73 0a 20 20 20 20 20 20 20 20 20 5b 28 28 3f 20  s.         [((? 
41b0: 73 79 6d 62 6f 6c 3f 20 6b 29 20 76 20 2e 20 72  symbol? k) v . r
41c0: 65 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 28  est).          (
41d0: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20  cond.           
41e0: 5b 28 62 69 6e 64 2d 70 61 72 61 6d 65 74 65 72  [(bind-parameter
41f0: 2d 69 6e 64 65 78 20 73 74 6d 74 20 28 73 74 72  -index stmt (str
4200: 69 6e 67 2d 61 70 70 65 6e 64 20 22 3a 22 20 28  ing-append ":" (
4210: 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 6b  symbol->string k
4220: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ))).            
4230: 3d 3e 20 28 6c 61 6d 62 64 61 20 28 6a 29 0a 20  => (lambda (j). 
4240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4250: 28 68 61 73 68 74 61 62 6c 65 2d 73 65 74 21 20  (hashtable-set! 
4260: 76 73 20 6a 20 76 29 0a 20 20 20 20 20 20 20 20  vs j v).        
4270: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 69           (loop i
4280: 20 72 65 73 74 29 29 5d 0a 20 20 20 20 20 20 20   rest))].       
4290: 20 20 20 20 5b 65 6c 73 65 0a 20 20 20 20 20 20      [else.      
42a0: 20 20 20 20 20 20 28 65 72 72 6f 72 20 6c 6f 63        (error loc
42b0: 20 22 76 61 6c 75 65 20 6f 72 20 6b 65 79 77 6f   "value or keywo
42c0: 72 64 20 6d 61 74 63 68 69 6e 67 20 61 20 62 69  rd matching a bi
42d0: 6e 64 20 70 61 72 61 6d 65 74 65 72 20 6e 61 6d  nd parameter nam
42e0: 65 22 20 6b 29 5d 29 5d 0a 20 20 20 20 20 20 20  e" k)])].       
42f0: 20 20 5b 28 76 20 2e 20 72 65 73 74 29 0a 20 20    [(v . rest).  
4300: 20 20 20 20 20 20 20 20 28 68 61 73 68 74 61 62          (hashtab
4310: 6c 65 2d 73 65 74 21 20 76 73 20 69 20 76 29 0a  le-set! vs i v).
4320: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20            (loop 
4330: 28 66 78 2b 20 69 20 31 29 20 72 65 73 74 29 5d  (fx+ i 1) rest)]
4340: 0a 20 20 20 20 20 20 20 20 20 5b 28 29 0a 20 20  .         [().  
4350: 20 20 20 20 20 20 20 20 28 76 6f 69 64 29 5d 29          (void)])
4360: 29 0a 20 20 20 20 20 28 69 66 20 28 3d 20 28 68  ).     (if (= (h
4370: 61 73 68 74 61 62 6c 65 2d 73 69 7a 65 20 76 73  ashtable-size vs
4380: 29 20 63 6e 74 29 0a 20 20 20 20 20 20 20 20 20  ) cnt).         
4390: 28 75 6e 6c 65 73 73 20 28 7a 65 72 6f 3f 20 63  (unless (zero? c
43a0: 6e 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 28  nt).           (
43b0: 68 61 73 68 74 61 62 6c 65 2d 77 61 6c 6b 20 76  hashtable-walk v
43c0: 73 20 28 63 75 74 20 62 69 6e 64 21 20 73 74 6d  s (cut bind! stm
43d0: 74 20 3c 3e 20 3c 3e 29 29 29 0a 20 20 20 20 20  t <> <>))).     
43e0: 20 20 20 20 28 72 61 69 73 65 0a 20 20 20 20 20      (raise.     
43f0: 20 20 20 20 20 28 63 6f 6e 64 69 74 69 6f 6e 0a       (condition.
4400: 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65             (make
4410: 2d 77 68 6f 2d 63 6f 6e 64 69 74 69 6f 6e 20 6c  -who-condition l
4420: 6f 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 28  oc).           (
4430: 6d 61 6b 65 2d 6d 65 73 73 61 67 65 2d 63 6f 6e  make-message-con
4440: 64 69 74 69 6f 6e 20 28 63 6f 6e 63 20 22 62 61  dition (conc "ba
4450: 64 20 70 61 72 61 6d 65 74 65 72 20 63 6f 75 6e  d parameter coun
4460: 74 20 2d 20 72 65 63 65 69 76 65 64 20 22 20 28  t - received " (
4470: 68 61 73 68 74 61 62 6c 65 2d 73 69 7a 65 20 76  hashtable-size v
4480: 73 29 20 22 20 62 75 74 20 65 78 70 65 63 74 65  s) " but expecte
4490: 64 20 22 20 63 6e 74 29 29 0a 20 20 20 20 20 20  d " cnt)).      
44a0: 20 20 20 20 20 28 6d 61 6b 65 2d 73 71 6c 69 74       (make-sqlit
44b0: 65 33 2d 63 6f 6e 64 69 74 69 6f 6e 20 27 65 72  e3-condition 'er
44c0: 72 6f 72 29 29 29 29 29 29 0a 0a 20 28 64 65 66  ror)))))).. (def
44d0: 69 6e 65 20 28 62 69 6e 64 2d 70 61 72 61 6d 65  ine (bind-parame
44e0: 74 65 72 73 21 20 73 74 6d 74 20 2e 20 70 61 72  ters! stmt . par
44f0: 61 6d 73 29 0a 20 20 20 28 25 62 69 6e 64 2d 70  ams).   (%bind-p
4500: 61 72 61 6d 65 74 65 72 73 21 20 27 62 69 6e 64  arameters! 'bind
4510: 2d 70 61 72 61 6d 65 74 65 72 73 21 20 73 74 6d  -parameters! stm
4520: 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 3b 3b 20  t params)).. ;; 
4530: 53 69 6e 67 6c 65 2d 73 74 65 70 20 61 20 70 72  Single-step a pr
4540: 65 70 61 72 65 64 20 73 74 61 74 65 6d 65 6e 74  epared statement
4550: 2c 20 72 65 74 75 72 6e 20 23 74 20 69 66 20 64  , return #t if d
4560: 61 74 61 20 69 73 20 61 76 61 69 6c 61 62 6c 65  ata is available
4570: 2c 0a 20 3b 3b 20 23 66 20 6f 74 68 65 72 77 69  ,. ;; #f otherwi
4580: 73 65 0a 20 28 64 65 66 69 6e 65 20 28 73 74 65  se. (define (ste
4590: 70 21 20 73 74 6d 74 29 0a 20 20 20 28 63 68 65  p! stmt).   (che
45a0: 63 6b 2d 73 74 61 74 65 6d 65 6e 74 20 27 73 74  ck-statement 'st
45b0: 65 70 21 20 73 74 6d 74 29 0a 20 20 20 28 6c 65  ep! stmt).   (le
45c0: 74 20 28 5b 64 62 20 28 73 74 61 74 65 6d 65 6e  t ([db (statemen
45d0: 74 2d 64 61 74 61 62 61 73 65 20 73 74 6d 74 29  t-database stmt)
45e0: 5d 29 0a 20 20 20 20 20 28 6c 65 74 20 72 65 74  ]).     (let ret
45f0: 72 79 20 28 5b 72 65 74 72 69 65 73 20 30 5d 29  ry ([retries 0])
4600: 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 5b 73  .       (let ([s
4610: 20 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65   ((foreign-proce
4620: 64 75 72 65 0a 20 20 20 20 20 20 20 20 20 20 20  dure.           
4630: 20 20 20 20 20 20 20 22 73 71 6c 69 74 65 33 5f         "sqlite3_
4640: 73 74 65 70 22 20 28 73 71 6c 69 74 65 33 3a 73  step" (sqlite3:s
4650: 74 61 74 65 6d 65 6e 74 2a 29 20 69 6e 74 29 20  tatement*) int) 
4660: 28 73 74 61 74 65 6d 65 6e 74 2d 61 64 64 72 20  (statement-addr 
4670: 73 74 6d 74 29 29 5d 29 0a 20 20 20 20 20 20 20  stmt))]).       
4680: 20 20 28 63 61 73 65 20 28 6e 75 6d 62 65 72 2d    (case (number-
4690: 3e 73 71 6c 69 74 65 33 3a 73 74 61 74 75 73 20  >sqlite3:status 
46a0: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 5b 28  s).           [(
46b0: 72 6f 77 29 0a 20 20 20 20 20 20 20 20 20 20 20  row).           
46c0: 20 23 74 5d 0a 20 20 20 20 20 20 20 20 20 20 20   #t].           
46d0: 5b 28 64 6f 6e 65 29 0a 20 20 20 20 20 20 20 20  [(done).        
46e0: 20 20 20 20 23 66 5d 0a 20 20 20 20 20 20 20 20      #f].        
46f0: 20 20 20 5b 28 62 75 73 79 29 0a 20 20 20 20 20     [(busy).     
4700: 20 20 20 20 20 20 20 28 6c 65 74 20 28 5b 68 20         (let ([h 
4710: 28 64 61 74 61 62 61 73 65 2d 62 75 73 79 2d 68  (database-busy-h
4720: 61 6e 64 6c 65 72 20 64 62 29 5d 29 0a 20 20 20  andler db)]).   
4730: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64             (cond
4740: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4750: 5b 28 61 6e 64 20 68 20 28 68 20 64 62 20 72 65  [(and h (h db re
4760: 74 72 69 65 73 29 29 0a 20 20 20 20 20 20 20 20  tries)).        
4770: 20 20 20 20 20 20 20 20 28 72 65 74 72 79 20 28          (retry (
4780: 66 78 2b 20 72 65 74 72 69 65 73 20 31 29 29 5d  fx+ retries 1))]
4790: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
47a0: 5b 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20  [else.          
47b0: 20 20 20 20 20 20 28 28 61 62 6f 72 74 2d 73 71        ((abort-sq
47c0: 6c 69 74 65 33 2d 65 72 72 6f 72 20 27 73 74 65  lite3-error 'ste
47d0: 70 21 20 64 62 20 73 74 6d 74 29 20 73 29 5d 29  p! db stmt) s)])
47e0: 29 5d 0a 20 20 20 20 20 20 20 20 20 20 20 5b 65  )].           [e
47f0: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20  lse.            
4800: 28 28 61 62 6f 72 74 2d 73 71 6c 69 74 65 33 2d  ((abort-sqlite3-
4810: 65 72 72 6f 72 20 27 73 74 65 70 21 20 64 62 20  error 'step! db 
4820: 73 74 6d 74 29 20 73 29 5d 29 29 29 29 29 0a 0a  stmt) s)])))))..
4830: 20 3b 3b 20 52 65 74 72 69 65 76 65 20 69 6e 66   ;; Retrieve inf
4840: 6f 72 6d 61 74 69 6f 6e 20 66 72 6f 6d 20 61 20  ormation from a 
4850: 70 72 65 70 61 72 65 64 2f 73 74 65 70 70 65 64  prepared/stepped
4860: 20 73 74 61 74 65 6d 65 6e 74 0a 20 28 64 65 66   statement. (def
4870: 69 6e 65 20 28 63 6f 6c 75 6d 6e 2d 63 6f 75 6e  ine (column-coun
4880: 74 20 73 74 6d 74 29 0a 20 20 20 28 63 68 65 63  t stmt).   (chec
4890: 6b 2d 73 74 61 74 65 6d 65 6e 74 20 27 63 6f 6c  k-statement 'col
48a0: 75 6d 6e 2d 63 6f 75 6e 74 20 73 74 6d 74 29 0a  umn-count stmt).
48b0: 20 20 20 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f     ((foreign-pro
48c0: 63 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f  cedure "sqlite3_
48d0: 63 6f 6c 75 6d 6e 5f 63 6f 75 6e 74 22 20 28 73  column_count" (s
48e0: 71 6c 69 74 65 33 3a 73 74 61 74 65 6d 65 6e 74  qlite3:statement
48f0: 2a 29 20 69 6e 74 29 20 28 73 74 61 74 65 6d 65  *) int) (stateme
4900: 6e 74 2d 61 64 64 72 20 73 74 6d 74 29 29 29 0a  nt-addr stmt))).
4910: 0a 20 28 64 65 66 69 6e 65 20 28 63 6f 6c 75 6d  . (define (colum
4920: 6e 2d 74 79 70 65 20 73 74 6d 74 20 69 29 0a 20  n-type stmt i). 
4930: 20 20 28 63 68 65 63 6b 2d 73 74 61 74 65 6d 65    (check-stateme
4940: 6e 74 20 27 63 6f 6c 75 6d 6e 2d 74 79 70 65 20  nt 'column-type 
4950: 73 74 6d 74 29 0a 20 20 20 28 73 71 6c 69 74 65  stmt).   (sqlite
4960: 33 3a 74 79 70 65 2d 72 65 66 20 28 28 66 6f 72  3:type-ref ((for
4970: 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 20  eign-procedure  
4980: 22 73 71 6c 69 74 65 33 5f 63 6f 6c 75 6d 6e 5f  "sqlite3_column_
4990: 74 79 70 65 22 20 28 73 71 6c 69 74 65 33 3a 73  type" (sqlite3:s
49a0: 74 61 74 65 6d 65 6e 74 2a 20 69 6e 74 29 20 69  tatement* int) i
49b0: 6e 74 29 20 28 73 74 61 74 65 6d 65 6e 74 2d 61  nt) (statement-a
49c0: 64 64 72 20 73 74 6d 74 29 20 69 29 29 29 0a 0a  ddr stmt) i)))..
49d0: 20 28 64 65 66 69 6e 65 20 28 63 6f 6c 75 6d 6e   (define (column
49e0: 2d 64 65 63 6c 61 72 65 64 2d 74 79 70 65 20 73  -declared-type s
49f0: 74 6d 74 20 69 29 0a 20 20 20 28 63 68 65 63 6b  tmt i).   (check
4a00: 2d 73 74 61 74 65 6d 65 6e 74 20 27 63 6f 6c 75  -statement 'colu
4a10: 6d 6e 2d 64 65 63 6c 61 72 65 64 2d 74 79 70 65  mn-declared-type
4a20: 20 73 74 6d 74 29 0a 20 20 20 28 28 66 6f 72 65   stmt).   ((fore
4a30: 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 73  ign-procedure "s
4a40: 71 6c 69 74 65 33 5f 63 6f 6c 75 6d 6e 5f 64 65  qlite3_column_de
4a50: 63 6c 74 79 70 65 22 20 28 73 71 6c 69 74 65 33  cltype" (sqlite3
4a60: 3a 73 74 61 74 65 6d 65 6e 74 2a 20 69 6e 74 29  :statement* int)
4a70: 20 73 74 72 69 6e 67 29 20 28 73 74 61 74 65 6d   string) (statem
4a80: 65 6e 74 2d 61 64 64 72 20 73 74 6d 74 29 20 69  ent-addr stmt) i
4a90: 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 63 6f  )).. (define (co
4aa0: 6c 75 6d 6e 2d 6e 61 6d 65 20 73 74 6d 74 20 69  lumn-name stmt i
4ab0: 29 0a 20 20 20 28 63 68 65 63 6b 2d 73 74 61 74  ).   (check-stat
4ac0: 65 6d 65 6e 74 20 27 63 6f 6c 75 6d 6e 2d 6e 61  ement 'column-na
4ad0: 6d 65 20 73 74 6d 74 29 0a 20 20 20 28 28 66 6f  me stmt).   ((fo
4ae0: 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20  reign-procedure 
4af0: 22 73 71 6c 69 74 65 33 5f 63 6f 6c 75 6d 6e 5f  "sqlite3_column_
4b00: 6e 61 6d 65 22 20 28 73 71 6c 69 74 65 33 3a 73  name" (sqlite3:s
4b10: 74 61 74 65 6d 65 6e 74 2a 20 69 6e 74 29 20 73  tatement* int) s
4b20: 74 72 69 6e 67 29 20 28 73 74 61 74 65 6d 65 6e  tring) (statemen
4b30: 74 2d 61 64 64 72 20 73 74 6d 74 29 20 69 29 29  t-addr stmt) i))
4b40: 0a 0a 20 28 64 65 66 69 6e 65 20 73 71 6c 69 74  .. (define sqlit
4b50: 65 33 5f 63 6f 6c 75 6d 6e 5f 64 6f 75 62 6c 65  e3_column_double
4b60: 0a 20 20 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f  .   (foreign-pro
4b70: 63 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f  cedure "sqlite3_
4b80: 63 6f 6c 75 6d 6e 5f 64 6f 75 62 6c 65 22 20 28  column_double" (
4b90: 73 71 6c 69 74 65 33 3a 73 74 61 74 65 6d 65 6e  sqlite3:statemen
4ba0: 74 2a 20 69 6e 74 29 20 64 6f 75 62 6c 65 29 29  t* int) double))
4bb0: 0a 0a 20 28 64 65 66 69 6e 65 20 73 71 6c 69 74  .. (define sqlit
4bc0: 65 33 5f 63 6f 6c 75 6d 6e 5f 69 6e 74 36 34 0a  e3_column_int64.
4bd0: 20 20 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63     (foreign-proc
4be0: 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 63  edure "sqlite3_c
4bf0: 6f 6c 75 6d 6e 5f 69 6e 74 36 34 22 20 28 73 71  olumn_int64" (sq
4c00: 6c 69 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a  lite3:statement*
4c10: 20 69 6e 74 29 20 69 6e 74 65 67 65 72 2d 36 34   int) integer-64
4c20: 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 73 71 6c  )).. (define sql
4c30: 69 74 65 33 5f 63 6f 6c 75 6d 6e 5f 62 6f 6f 6c  ite3_column_bool
4c40: 65 61 6e 0a 20 20 20 28 66 6f 72 65 69 67 6e 2d  ean.   (foreign-
4c50: 70 72 6f 63 65 64 75 72 65 20 22 73 71 6c 69 74  procedure "sqlit
4c60: 65 33 5f 63 6f 6c 75 6d 6e 5f 69 6e 74 22 20 28  e3_column_int" (
4c70: 73 71 6c 69 74 65 33 3a 73 74 61 74 65 6d 65 6e  sqlite3:statemen
4c80: 74 2a 20 69 6e 74 29 20 62 6f 6f 6c 65 61 6e 29  t* int) boolean)
4c90: 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 73 71 6c  ).. (define (sql
4ca0: 69 74 65 33 2d 63 6f 6c 75 6d 6e 2d 62 79 74 65  ite3-column-byte
4cb0: 73 20 73 74 6d 74 20 69 29 0a 20 20 20 28 28 66  s stmt i).   ((f
4cc0: 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65  oreign-procedure
4cd0: 20 22 73 71 6c 69 74 65 33 5f 63 6f 6c 75 6d 6e   "sqlite3_column
4ce0: 5f 62 79 74 65 73 22 20 28 73 71 6c 69 74 65 33  _bytes" (sqlite3
4cf0: 3a 73 74 61 74 65 6d 65 6e 74 2a 20 69 6e 74 29  :statement* int)
4d00: 20 69 6e 74 29 0a 20 20 20 20 28 73 74 61 74 65   int).    (state
4d10: 6d 65 6e 74 2d 61 64 64 72 20 73 74 6d 74 29 20  ment-addr stmt) 
4d20: 69 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 76  i)).. (define (v
4d30: 6f 69 64 2a 2d 3e 62 79 74 65 76 65 63 74 6f 72  oid*->bytevector
4d40: 20 70 74 72 20 6c 65 6e 29 0a 20 20 20 28 64 65   ptr len).   (de
4d50: 66 69 6e 65 2d 66 74 79 70 65 20 62 79 74 65 2d  fine-ftype byte-
4d60: 61 72 72 61 79 20 28 61 72 72 61 79 20 30 20 75  array (array 0 u
4d70: 6e 73 69 67 6e 65 64 2d 38 29 29 0a 20 20 20 28  nsigned-8)).   (
4d80: 6c 65 74 20 28 5b 61 72 72 20 28 6d 61 6b 65 2d  let ([arr (make-
4d90: 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 20 62 79  ftype-pointer by
4da0: 74 65 2d 61 72 72 61 79 20 70 74 72 29 5d 0a 20  te-array ptr)]. 
4db0: 20 20 20 20 20 20 20 20 5b 62 76 20 20 28 6d 61          [bv  (ma
4dc0: 6b 65 2d 62 79 74 65 76 65 63 74 6f 72 20 6c 65  ke-bytevector le
4dd0: 6e 29 5d 29 0a 20 20 20 20 20 28 6c 65 74 20 6c  n)]).     (let l
4de0: 6f 6f 70 20 28 28 69 20 30 29 29 0a 20 20 20 20  oop ((i 0)).    
4df0: 20 20 20 28 77 68 65 6e 20 28 3c 20 69 20 6c 65     (when (< i le
4e00: 6e 29 0a 20 20 20 20 20 20 20 20 20 28 62 79 74  n).         (byt
4e10: 65 76 65 63 74 6f 72 2d 75 38 2d 73 65 74 21 20  evector-u8-set! 
4e20: 62 76 20 69 20 28 66 74 79 70 65 2d 72 65 66 20  bv i (ftype-ref 
4e30: 62 79 74 65 2d 61 72 72 61 79 20 28 69 29 20 61  byte-array (i) a
4e40: 72 72 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c  rr)).         (l
4e50: 6f 6f 70 20 28 66 78 2b 20 31 20 69 29 29 29 29  oop (fx+ 1 i))))
4e60: 0a 20 20 20 20 20 62 76 29 29 0a 0a 20 28 64 65  .     bv)).. (de
4e70: 66 69 6e 65 20 28 76 6f 69 64 2a 2d 3e 73 74 72  fine (void*->str
4e80: 69 6e 67 20 70 74 72 20 6c 65 6e 29 0a 20 20 20  ing ptr len).   
4e90: 28 75 74 66 38 2d 3e 73 74 72 69 6e 67 20 28 76  (utf8->string (v
4ea0: 6f 69 64 2a 2d 3e 62 79 74 65 76 65 63 74 6f 72  oid*->bytevector
4eb0: 20 70 74 72 20 6c 65 6e 29 29 29 0a 0a 20 28 64   ptr len))).. (d
4ec0: 65 66 69 6e 65 20 28 73 71 6c 69 74 65 33 2d 63  efine (sqlite3-c
4ed0: 6f 6c 75 6d 6e 2d 74 65 78 74 20 73 74 6d 74 20  olumn-text stmt 
4ee0: 69 29 0a 20 20 20 28 6c 65 74 2a 20 28 5b 70 74  i).   (let* ([pt
4ef0: 72 20 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63  r ((foreign-proc
4f00: 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 63  edure "sqlite3_c
4f10: 6f 6c 75 6d 6e 5f 74 65 78 74 22 20 28 73 71 6c  olumn_text" (sql
4f20: 69 74 65 33 3a 73 74 61 74 65 6d 65 6e 74 2a 20  ite3:statement* 
4f30: 69 6e 74 29 20 76 6f 69 64 2a 29 0a 20 20 20 20  int) void*).    
4f40: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61              (sta
4f50: 74 65 6d 65 6e 74 2d 61 64 64 72 20 73 74 6d 74  tement-addr stmt
4f60: 29 20 69 29 5d 0a 20 20 20 20 20 20 20 20 20 20  ) i)].          
4f70: 5b 6c 65 6e 20 28 73 71 6c 69 74 65 33 2d 63 6f  [len (sqlite3-co
4f80: 6c 75 6d 6e 2d 62 79 74 65 73 20 73 74 6d 74 20  lumn-bytes stmt 
4f90: 69 29 5d 29 0a 20 20 20 20 20 28 76 6f 69 64 2a  i)]).     (void*
4fa0: 2d 3e 73 74 72 69 6e 67 20 70 74 72 20 6c 65 6e  ->string ptr len
4fb0: 29 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 73  ))).. (define (s
4fc0: 71 6c 69 74 65 33 2d 63 6f 6c 75 6d 6e 2d 62 6c  qlite3-column-bl
4fd0: 6f 62 20 73 74 6d 74 20 69 29 0a 20 20 20 28 6c  ob stmt i).   (l
4fe0: 65 74 2a 20 28 5b 70 74 72 20 28 28 66 6f 72 65  et* ([ptr ((fore
4ff0: 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 73  ign-procedure "s
5000: 71 6c 69 74 65 33 5f 63 6f 6c 75 6d 6e 5f 62 6c  qlite3_column_bl
5010: 6f 62 22 20 28 73 71 6c 69 74 65 33 3a 73 74 61  ob" (sqlite3:sta
5020: 74 65 6d 65 6e 74 2a 20 69 6e 74 29 20 76 6f 69  tement* int) voi
5030: 64 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  d*).            
5040: 20 20 20 20 28 73 74 61 74 65 6d 65 6e 74 2d 61      (statement-a
5050: 64 64 72 20 73 74 6d 74 29 20 69 29 5d 0a 20 20  ddr stmt) i)].  
5060: 20 20 20 20 20 20 20 20 5b 6c 65 6e 20 28 73 71          [len (sq
5070: 6c 69 74 65 33 2d 63 6f 6c 75 6d 6e 2d 62 79 74  lite3-column-byt
5080: 65 73 20 73 74 6d 74 20 69 29 5d 29 0a 20 20 20  es stmt i)]).   
5090: 20 20 28 76 6f 69 64 2a 2d 3e 62 79 74 65 76 65    (void*->byteve
50a0: 63 74 6f 72 20 70 74 72 20 6c 65 6e 29 29 29 0a  ctor ptr len))).
50b0: 0a 20 3b 3b 20 52 65 74 72 69 65 76 65 20 64 61  . ;; Retrieve da
50c0: 74 61 20 66 72 6f 6d 20 61 20 73 74 65 70 70 65  ta from a steppe
50d0: 64 20 73 74 61 74 65 6d 65 6e 74 0a 20 28 64 65  d statement. (de
50e0: 66 69 6e 65 20 28 63 6f 6c 75 6d 6e 2d 64 61 74  fine (column-dat
50f0: 61 20 73 74 6d 74 20 69 29 0a 20 20 20 28 63 61  a stmt i).   (ca
5100: 73 65 20 28 63 6f 6c 75 6d 6e 2d 74 79 70 65 20  se (column-type 
5110: 73 74 6d 74 20 69 29 0a 20 20 20 20 20 5b 28 69  stmt i).     [(i
5120: 6e 74 65 67 65 72 29 0a 20 20 20 20 20 20 28 63  nteger).      (c
5130: 6f 6e 64 20 5b 28 61 6e 64 2d 6c 65 74 2a 20 28  ond [(and-let* (
5140: 5b 74 79 70 65 20 28 63 6f 6c 75 6d 6e 2d 64 65  [type (column-de
5150: 63 6c 61 72 65 64 2d 74 79 70 65 20 73 74 6d 74  clared-type stmt
5160: 20 69 29 5d 29 0a 09 20 20 20 20 20 20 20 28 73   i)])..       (s
5170: 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 2d 63  tring-contains-c
5180: 69 20 74 79 70 65 20 22 62 6f 6f 6c 22 29 29 0a  i type "bool")).
5190: 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 5f 63  .     (sqlite3_c
51a0: 6f 6c 75 6d 6e 5f 62 6f 6f 6c 65 61 6e 20 28 73  olumn_boolean (s
51b0: 74 61 74 65 6d 65 6e 74 2d 61 64 64 72 20 73 74  tatement-addr st
51c0: 6d 74 29 20 69 29 5d 0a 09 20 20 20 20 5b 65 6c  mt) i)]..    [el
51d0: 73 65 0a 09 20 20 20 20 20 28 73 71 6c 69 74 65  se..     (sqlite
51e0: 33 5f 63 6f 6c 75 6d 6e 5f 69 6e 74 36 34 20 28  3_column_int64 (
51f0: 73 74 61 74 65 6d 65 6e 74 2d 61 64 64 72 20 73  statement-addr s
5200: 74 6d 74 29 20 69 29 5d 29 5d 0a 20 20 20 20 20  tmt) i)])].     
5210: 5b 28 66 6c 6f 61 74 29 0a 20 20 20 20 20 20 28  [(float).      (
5220: 73 71 6c 69 74 65 33 5f 63 6f 6c 75 6d 6e 5f 64  sqlite3_column_d
5230: 6f 75 62 6c 65 20 28 73 74 61 74 65 6d 65 6e 74  ouble (statement
5240: 2d 61 64 64 72 20 73 74 6d 74 29 20 69 29 5d 0a  -addr stmt) i)].
5250: 20 20 20 20 20 5b 28 74 65 78 74 29 0a 20 20 20       [(text).   
5260: 20 20 20 28 73 71 6c 69 74 65 33 2d 63 6f 6c 75     (sqlite3-colu
5270: 6d 6e 2d 74 65 78 74 20 73 74 6d 74 20 69 29 5d  mn-text stmt i)]
5280: 0a 20 20 20 20 20 5b 28 62 6c 6f 62 29 0a 20 20  .     [(blob).  
5290: 20 20 20 20 28 73 71 6c 69 74 65 33 2d 63 6f 6c      (sqlite3-col
52a0: 75 6d 6e 2d 62 6c 6f 62 20 73 74 6d 74 20 69 29  umn-blob stmt i)
52b0: 5d 0a 20 20 20 20 20 5b 65 6c 73 65 0a 20 20 20  ].     [else.   
52c0: 20 20 20 28 73 71 6c 2d 6e 75 6c 6c 29 5d 29 29     (sql-null)]))
52d0: 0a 0a 3b 3b 3b 20 45 61 73 79 20 73 74 61 74 65  ..;;; Easy state
52e0: 6d 65 6e 74 20 69 6e 74 65 72 66 61 63 65 0a 0a  ment interface..
52f0: 20 3b 3b 20 43 6f 6d 70 69 6c 65 20 61 20 73 74   ;; Compile a st
5300: 61 74 65 6d 65 6e 74 20 61 6e 64 20 63 61 6c 6c  atement and call
5310: 20 61 20 70 72 6f 63 65 64 75 72 65 20 6f 6e 20   a procedure on 
5320: 69 74 2c 20 74 68 65 6e 20 66 69 6e 61 6c 69 7a  it, then finaliz
5330: 65 20 74 68 65 0a 20 3b 3b 20 73 74 61 74 65 6d  e the. ;; statem
5340: 65 6e 74 20 69 6e 20 61 20 64 79 6e 61 6d 69 63  ent in a dynamic
5350: 2d 77 69 6e 64 20 65 78 69 74 20 62 6c 6f 63 6b  -wind exit block
5360: 20 69 66 20 69 74 20 68 61 73 6e 27 74 20 62 65   if it hasn't be
5370: 65 6e 20 66 69 6e 61 6c 69 7a 65 64 20 79 65 74  en finalized yet
5380: 2e 0a 20 28 64 65 66 69 6e 65 20 28 63 61 6c 6c  .. (define (call
5390: 2d 77 69 74 68 2d 74 65 6d 70 6f 72 61 72 79 2d  -with-temporary-
53a0: 73 74 61 74 65 6d 65 6e 74 73 20 70 72 6f 63 20  statements proc 
53b0: 64 62 20 2e 20 73 71 6c 73 29 0a 20 20 20 28 63  db . sqls).   (c
53c0: 68 65 63 6b 2d 64 61 74 61 62 61 73 65 20 27 63  heck-database 'c
53d0: 61 6c 6c 2d 77 69 74 68 2d 74 65 6d 70 6f 72 61  all-with-tempora
53e0: 72 79 2d 73 74 61 74 65 6d 65 6e 74 73 20 64 62  ry-statements db
53f0: 29 0a 20 20 20 28 6c 65 74 20 28 5b 73 74 6d 74  ).   (let ([stmt
5400: 73 20 23 66 5d 20 5b 65 78 6e 20 23 66 5d 29 0a  s #f] [exn #f]).
5410: 20 20 20 20 20 28 64 79 6e 61 6d 69 63 2d 77 69       (dynamic-wi
5420: 6e 64 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64  nd.       (lambd
5430: 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 28 75  a ().         (u
5440: 6e 6c 65 73 73 20 73 74 6d 74 73 0a 20 20 20 20  nless stmts.    
5450: 20 20 20 20 20 20 20 28 73 65 74 21 20 73 74 6d         (set! stm
5460: 74 73 20 28 6d 61 70 20 28 63 75 74 65 20 70 72  ts (map (cute pr
5470: 65 70 61 72 65 20 64 62 20 3c 3e 29 20 73 71 6c  epare db <>) sql
5480: 73 29 29 29 29 0a 20 20 20 20 20 20 20 28 6c 61  s)))).       (la
5490: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20  mbda ().        
54a0: 20 28 67 75 61 72 64 20 28 65 20 5b 65 6c 73 65   (guard (e [else
54b0: 20 28 73 65 74 21 20 65 78 6e 20 65 29 5d 29 0a   (set! exn e)]).
54c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
54d0: 28 61 70 70 6c 79 20 70 72 6f 63 20 73 74 6d 74  (apply proc stmt
54e0: 73 29 29 29 0a 20 20 20 20 20 20 20 28 6c 61 6d  s))).       (lam
54f0: 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20  bda ().         
5500: 28 61 6e 64 2d 6c 65 74 2a 20 28 5b 73 20 73 74  (and-let* ([s st
5510: 6d 74 73 5d 29 0a 20 20 20 20 20 20 20 20 20 20  mts]).          
5520: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 73           (set! s
5530: 74 6d 74 73 20 23 66 29 0a 20 20 20 20 20 20 20  tmts #f).       
5540: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6f 72              (for
5550: 2d 65 61 63 68 20 66 69 6e 61 6c 69 7a 65 21 20  -each finalize! 
5560: 73 29 29 20 3b 3b 20 6c 65 61 6b 73 20 69 66 20  s)) ;; leaks if 
5570: 65 72 72 6f 72 20 6f 63 63 75 72 73 20 62 65 66  error occurs bef
5580: 6f 72 65 20 6c 61 73 74 20 73 74 6d 74 0a 20 20  ore last stmt.  
5590: 20 20 20 20 20 20 20 28 61 6e 64 2d 6c 65 74 2a         (and-let*
55a0: 20 28 5b 65 20 65 78 6e 5d 29 0a 20 20 20 20 20   ([e exn]).     
55b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73                (s
55c0: 65 74 21 20 65 78 6e 20 23 66 29 0a 20 20 20 20  et! exn #f).    
55d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
55e0: 72 61 69 73 65 20 65 29 29 29 29 29 29 0a 0a 20  raise e)))))).. 
55f0: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 25  (define-syntax %
5600: 64 65 66 69 6e 65 2f 73 74 61 74 65 6d 65 6e 74  define/statement
5610: 2b 70 61 72 61 6d 73 0a 20 20 20 28 73 79 6e 74  +params.   (synt
5620: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20  ax-rules ().    
5630: 20 5b 28 25 64 65 66 69 6e 65 2f 73 74 61 74 65   [(%define/state
5640: 6d 65 6e 74 2b 70 61 72 61 6d 73 20 28 28 6e 61  ment+params ((na
5650: 6d 65 20 6c 6f 63 29 20 28 69 6e 69 74 20 2e 2e  me loc) (init ..
5660: 2e 29 20 28 73 74 6d 74 20 70 61 72 61 6d 73 29  .) (stmt params)
5670: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5690: 20 20 62 6f 64 79 20 2e 2e 2e 29 0a 20 20 20 20    body ...).    
56a0: 20 20 28 64 65 66 69 6e 65 20 6e 61 6d 65 0a 20    (define name. 
56b0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 5b 69 6d         (let ([im
56c0: 70 6c 20 28 6c 61 6d 62 64 61 20 28 69 6e 69 74  pl (lambda (init
56d0: 20 2e 2e 2e 20 73 74 6d 74 20 70 61 72 61 6d 73   ... stmt params
56e0: 29 20 62 6f 64 79 20 2e 2e 2e 29 5d 29 0a 20 20  ) body ...)]).  
56f0: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20          (lambda 
5700: 28 69 6e 69 74 20 2e 2e 2e 20 64 62 2d 6f 72 2d  (init ... db-or-
5710: 73 74 6d 74 20 2e 20 70 61 72 61 6d 73 29 0a 20  stmt . params). 
5720: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64             (cond
5730: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 28  .             [(
5740: 64 61 74 61 62 61 73 65 3f 20 64 62 2d 6f 72 2d  database? db-or-
5750: 73 74 6d 74 29 0a 20 20 20 20 20 20 20 20 20 20  stmt).          
5760: 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d 74      (call-with-t
5770: 65 6d 70 6f 72 61 72 79 2d 73 74 61 74 65 6d 65  emporary-stateme
5780: 6e 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20  nts.            
5790: 20 20 20 28 63 75 74 65 20 69 6d 70 6c 20 69 6e     (cute impl in
57a0: 69 74 20 2e 2e 2e 20 3c 3e 20 28 63 64 72 20 70  it ... <> (cdr p
57b0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
57c0: 20 20 20 20 20 20 20 64 62 2d 6f 72 2d 73 74 6d         db-or-stm
57d0: 74 20 28 63 61 72 20 70 61 72 61 6d 73 29 29 5d  t (car params))]
57e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 28  .             [(
57f0: 73 74 61 74 65 6d 65 6e 74 3f 20 64 62 2d 6f 72  statement? db-or
5800: 2d 73 74 6d 74 29 0a 20 20 20 20 20 20 20 20 20  -stmt).         
5810: 20 20 20 20 20 28 69 6d 70 6c 20 69 6e 69 74 20       (impl init 
5820: 2e 2e 2e 20 64 62 2d 6f 72 2d 73 74 6d 74 20 70  ... db-or-stmt p
5830: 61 72 61 6d 73 29 5d 0a 20 20 20 20 20 20 20 20  arams)].        
5840: 20 20 20 20 20 5b 65 6c 73 65 0a 20 20 20 20 20       [else.     
5850: 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20           (error 
5860: 6c 6f 63 20 22 64 61 74 61 62 61 73 65 20 6f 72  loc "database or
5870: 20 73 74 61 74 65 6d 65 6e 74 22 20 64 62 2d 6f   statement" db-o
5880: 72 2d 73 74 6d 74 29 5d 29 29 29 29 5d 0a 20 20  r-stmt)]))))].  
5890: 20 20 20 5b 28 25 64 65 66 69 6e 65 2f 73 74 61     [(%define/sta
58a0: 74 65 6d 65 6e 74 2b 70 61 72 61 6d 73 20 28 6e  tement+params (n
58b0: 61 6d 65 20 28 69 6e 69 74 20 2e 2e 2e 29 20 28  ame (init ...) (
58c0: 73 74 6d 74 20 70 61 72 61 6d 73 29 29 0a 20 20  stmt params)).  
58d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
58e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 62 6f                bo
58f0: 64 79 20 2e 2e 2e 29 0a 20 20 20 20 20 20 28 25  dy ...).      (%
5900: 64 65 66 69 6e 65 2f 73 74 61 74 65 6d 65 6e 74  define/statement
5910: 2b 70 61 72 61 6d 73 20 28 28 6e 61 6d 65 20 27  +params ((name '
5920: 6e 61 6d 65 29 20 28 69 6e 69 74 20 2e 2e 2e 29  name) (init ...)
5930: 20 28 73 74 6d 74 20 70 61 72 61 6d 73 29 29 0a   (stmt params)).
5940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5960: 62 6f 64 79 20 2e 2e 2e 29 5d 0a 20 20 20 20 20  body ...)].     
5970: 5b 28 25 64 65 66 69 6e 65 2f 73 74 61 74 65 6d  [(%define/statem
5980: 65 6e 74 2b 70 61 72 61 6d 73 20 28 6e 61 6d 65  ent+params (name
5990: 20 73 74 6d 74 20 70 61 72 61 6d 73 29 0a 20 20   stmt params).  
59a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
59b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 62 6f                bo
59c0: 64 79 20 2e 2e 2e 29 0a 20 20 20 20 20 20 28 25  dy ...).      (%
59d0: 64 65 66 69 6e 65 2f 73 74 61 74 65 6d 65 6e 74  define/statement
59e0: 2b 70 61 72 61 6d 73 20 28 28 6e 61 6d 65 20 27  +params ((name '
59f0: 6e 61 6d 65 29 20 28 29 20 28 73 74 6d 74 20 70  name) () (stmt p
5a00: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
5a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5a20: 20 20 20 20 20 20 20 20 62 6f 64 79 20 2e 2e 2e          body ...
5a30: 29 5d 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20  )]))..          
5a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 20                ; 
5a60: 66 72 6f 6d 20 63 68 69 63 6b 65 6e 20 6d 69 73  from chicken mis
5a70: 63 6d 61 63 72 6f 73 2e 73 63 6d 0a 20 28 64 65  cmacros.scm. (de
5a80: 66 69 6e 65 2d 73 79 6e 74 61 78 20 77 68 69 6c  fine-syntax whil
5a90: 65 0a 20 20 20 28 73 79 6e 74 61 78 2d 72 75 6c  e.   (syntax-rul
5aa0: 65 73 20 28 29 0a 20 20 20 20 20 28 28 77 68 69  es ().     ((whi
5ab0: 6c 65 20 74 65 73 74 20 62 6f 64 79 20 2e 2e 2e  le test body ...
5ac0: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f  ).      (let loo
5ad0: 70 20 28 29 0a 20 20 20 20 20 20 20 20 28 69 66  p ().        (if
5ae0: 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 20   test.          
5af0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20    (begin.       
5b00: 20 20 20 20 20 20 20 62 6f 64 79 20 2e 2e 2e 0a         body ....
5b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c                (l
5b20: 6f 6f 70 29 29 29 29 29 29 29 0a 0a 20 3b 3b 20  oop))))))).. ;; 
5b30: 53 74 65 70 20 74 68 72 6f 75 67 68 20 61 20 73  Step through a s
5b40: 74 61 74 65 6d 65 6e 74 20 61 6e 64 20 69 67 6e  tatement and ign
5b50: 6f 72 65 20 70 6f 73 73 69 62 6c 65 20 72 65 73  ore possible res
5b60: 75 6c 74 73 0a 20 28 64 65 66 69 6e 65 20 28 25  ults. (define (%
5b70: 65 78 65 63 75 74 65 20 6c 6f 63 20 73 74 6d 74  execute loc stmt
5b80: 20 70 61 72 61 6d 73 29 0a 20 20 20 28 25 62 69   params).   (%bi
5b90: 6e 64 2d 70 61 72 61 6d 65 74 65 72 73 21 20 6c  nd-parameters! l
5ba0: 6f 63 20 73 74 6d 74 20 70 61 72 61 6d 73 29 0a  oc stmt params).
5bb0: 20 20 20 28 77 68 69 6c 65 20 28 73 74 65 70 21     (while (step!
5bc0: 20 73 74 6d 74 29 29 0a 20 20 20 28 76 6f 69 64   stmt)).   (void
5bd0: 29 29 0a 0a 20 28 25 64 65 66 69 6e 65 2f 73 74  )).. (%define/st
5be0: 61 74 65 6d 65 6e 74 2b 70 61 72 61 6d 73 20 28  atement+params (
5bf0: 65 78 65 63 75 74 65 20 73 74 6d 74 20 70 61 72  execute stmt par
5c00: 61 6d 73 29 0a 20 20 20 20 20 20 20 20 20 20 20  ams).           
5c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5c20: 28 25 65 78 65 63 75 74 65 20 27 65 78 65 63 75  (%execute 'execu
5c30: 74 65 20 73 74 6d 74 20 70 61 72 61 6d 73 29 29  te stmt params))
5c40: 0a 0a 20 3b 3b 20 53 74 65 70 20 74 68 72 6f 75  .. ;; Step throu
5c50: 67 68 20 61 20 73 74 61 74 65 6d 65 6e 74 2c 20  gh a statement, 
5c60: 69 67 6e 6f 72 65 20 70 6f 73 73 69 62 6c 65 20  ignore possible 
5c70: 72 65 73 75 6c 74 73 20 61 6e 64 20 72 65 74 75  results and retu
5c80: 72 6e 20 74 68 65 0a 20 3b 3b 20 63 6f 75 6e 74  rn the. ;; count
5c90: 20 6f 66 20 63 68 61 6e 67 65 73 20 70 65 72 66   of changes perf
5ca0: 6f 72 6d 65 64 20 62 79 20 74 68 69 73 20 73 74  ormed by this st
5cb0: 61 74 65 6d 65 6e 74 0a 20 28 25 64 65 66 69 6e  atement. (%defin
5cc0: 65 2f 73 74 61 74 65 6d 65 6e 74 2b 70 61 72 61  e/statement+para
5cd0: 6d 73 20 28 75 70 64 61 74 65 20 73 74 6d 74 20  ms (update stmt 
5ce0: 70 61 72 61 6d 73 29 0a 20 20 20 20 20 20 20 20  params).        
5cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5d00: 20 20 20 28 25 65 78 65 63 75 74 65 20 27 75 70     (%execute 'up
5d10: 64 61 74 65 20 73 74 6d 74 20 70 61 72 61 6d 73  date stmt params
5d20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
5d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68               (ch
5d40: 61 6e 67 65 2d 63 6f 75 6e 74 20 28 73 74 61 74  ange-count (stat
5d50: 65 6d 65 6e 74 2d 64 61 74 61 62 61 73 65 20 73  ement-database s
5d60: 74 6d 74 29 29 29 0a 0a 20 3b 3b 20 52 65 74 75  tmt))).. ;; Retu
5d70: 72 6e 20 6f 6e 6c 79 20 74 68 65 20 66 69 72 73  rn only the firs
5d80: 74 20 63 6f 6c 75 6d 6e 20 6f 66 20 74 68 65 20  t column of the 
5d90: 66 69 72 73 74 20 72 65 73 75 6c 74 20 72 6f 77  first result row
5da0: 20 70 72 6f 64 75 63 65 64 20 62 79 20 74 68 69   produced by thi
5db0: 73 0a 20 3b 3b 20 73 74 61 74 65 6d 65 6e 74 0a  s. ;; statement.
5dc0: 0a 20 28 25 64 65 66 69 6e 65 2f 73 74 61 74 65  . (%define/state
5dd0: 6d 65 6e 74 2b 70 61 72 61 6d 73 20 28 66 69 72  ment+params (fir
5de0: 73 74 2d 72 65 73 75 6c 74 20 73 74 6d 74 20 70  st-result stmt p
5df0: 61 72 61 6d 73 29 0a 20 20 20 20 20 20 20 20 20  arams).         
5e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5e10: 20 20 28 25 62 69 6e 64 2d 70 61 72 61 6d 65 74    (%bind-paramet
5e20: 65 72 73 21 20 27 66 69 72 73 74 2d 72 65 73 75  ers! 'first-resu
5e30: 6c 74 20 73 74 6d 74 20 70 61 72 61 6d 73 29 0a  lt stmt params).
5e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5e50: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28             (if (
5e60: 73 74 65 70 21 20 73 74 6d 74 29 0a 20 20 20 20  step! stmt).    
5e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5e80: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20             (let 
5e90: 28 5b 72 20 28 63 6f 6c 75 6d 6e 2d 64 61 74 61  ([r (column-data
5ea0: 20 73 74 6d 74 20 30 29 5d 29 0a 20 20 20 20 20   stmt 0)]).     
5eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5ec0: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 73              (res
5ed0: 65 74 21 20 73 74 6d 74 29 0a 20 20 20 20 20 20  et! stmt).      
5ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5ef0: 20 20 20 20 20 20 20 20 20 20 20 72 29 0a 20 20             r).  
5f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 61               (ra
5f20: 69 73 65 20 28 6d 61 6b 65 2d 6e 6f 2d 64 61 74  ise (make-no-dat
5f30: 61 2d 63 6f 6e 64 69 74 69 6f 6e 20 27 66 69 72  a-condition 'fir
5f40: 73 74 2d 72 65 73 75 6c 74 20 73 74 6d 74 20 70  st-result stmt p
5f50: 61 72 61 6d 73 29 29 29 29 0a 0a 20 3b 3b 20 52  arams)))).. ;; R
5f60: 65 74 75 72 6e 20 6f 6e 6c 79 20 74 68 65 20 66  eturn only the f
5f70: 69 72 73 74 20 72 65 73 75 6c 74 20 72 6f 77 20  irst result row 
5f80: 70 72 6f 64 75 63 65 64 20 62 79 20 74 68 69 73  produced by this
5f90: 20 73 74 61 74 65 6d 65 6e 74 20 61 73 20 61 20   statement as a 
5fa0: 6c 69 73 74 0a 0a 20 28 25 64 65 66 69 6e 65 2f  list.. (%define/
5fb0: 73 74 61 74 65 6d 65 6e 74 2b 70 61 72 61 6d 73  statement+params
5fc0: 20 28 66 69 72 73 74 2d 72 6f 77 20 73 74 6d 74   (first-row stmt
5fd0: 20 70 61 72 61 6d 73 29 0a 20 20 20 20 20 20 20   params).       
5fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5ff0: 20 20 20 20 28 25 62 69 6e 64 2d 70 61 72 61 6d      (%bind-param
6000: 65 74 65 72 73 21 20 27 66 69 72 73 74 2d 72 6f  eters! 'first-ro
6010: 77 20 73 74 6d 74 20 70 61 72 61 6d 73 29 0a 20  w stmt params). 
6020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6030: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73            (if (s
6040: 74 65 70 21 20 73 74 6d 74 29 0a 20 20 20 20 20  tep! stmt).     
6050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6060: 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 20 28            (map (
6070: 63 75 74 65 20 63 6f 6c 75 6d 6e 2d 64 61 74 61  cute column-data
6080: 20 73 74 6d 74 20 3c 3e 29 0a 20 20 20 20 20 20   stmt <>).      
6090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
60a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69                (i
60b0: 6f 74 61 20 28 63 6f 6c 75 6d 6e 2d 63 6f 75 6e  ota (column-coun
60c0: 74 20 73 74 6d 74 29 29 29 0a 20 20 20 20 20 20  t stmt))).      
60d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
60e0: 20 20 20 20 20 20 20 20 20 28 72 61 69 73 65 20           (raise 
60f0: 28 6d 61 6b 65 2d 6e 6f 2d 64 61 74 61 2d 63 6f  (make-no-data-co
6100: 6e 64 69 74 69 6f 6e 20 27 66 69 72 73 74 2d 72  ndition 'first-r
6110: 6f 77 20 73 74 6d 74 20 70 61 72 61 6d 73 29 29  ow stmt params))
6120: 29 29 0a 0a 20 3b 3b 20 41 70 70 6c 79 20 61 20  )).. ;; Apply a 
6130: 70 72 6f 63 65 64 75 72 65 20 74 6f 20 74 68 65  procedure to the
6140: 20 76 61 6c 75 65 73 20 6f 66 20 74 68 65 20 72   values of the r
6150: 65 73 75 6c 74 20 63 6f 6c 75 6d 6e 73 20 66 6f  esult columns fo
6160: 72 20 65 61 63 68 20 72 65 73 75 6c 74 20 72 6f  r each result ro
6170: 77 0a 20 3b 3b 20 77 68 69 6c 65 20 65 78 65 63  w. ;; while exec
6180: 75 74 69 6e 67 20 74 68 65 20 73 74 61 74 65 6d  uting the statem
6190: 65 6e 74 20 61 6e 64 20 61 63 63 75 6d 75 6c 61  ent and accumula
61a0: 74 69 6e 67 20 72 65 73 75 6c 74 73 2e 0a 0a 20  ting results... 
61b0: 28 25 64 65 66 69 6e 65 2f 73 74 61 74 65 6d 65  (%define/stateme
61c0: 6e 74 2b 70 61 72 61 6d 73 20 28 28 25 66 6f 6c  nt+params ((%fol
61d0: 64 2d 72 6f 77 20 6c 6f 63 29 20 28 6c 6f 63 20  d-row loc) (loc 
61e0: 70 72 6f 63 20 69 6e 69 74 29 20 28 73 74 6d 74  proc init) (stmt
61f0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20   params)).      
6200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6210: 20 20 20 20 20 28 25 62 69 6e 64 2d 70 61 72 61       (%bind-para
6220: 6d 65 74 65 72 73 21 20 6c 6f 63 20 73 74 6d 74  meters! loc stmt
6230: 20 70 61 72 61 6d 73 29 0a 20 20 20 20 20 20 20   params).       
6240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6250: 20 20 20 20 28 6c 65 74 20 28 5b 63 6c 20 28 69      (let ([cl (i
6260: 6f 74 61 20 28 63 6f 6c 75 6d 6e 2d 63 6f 75 6e  ota (column-coun
6270: 74 20 73 74 6d 74 29 29 5d 29 0a 20 20 20 20 20  t stmt))]).     
6280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6290: 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f          (let loo
62a0: 70 20 28 5b 61 63 63 20 69 6e 69 74 5d 29 0a 20  p ([acc init]). 
62b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
62c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69                (i
62d0: 66 20 28 73 74 65 70 21 20 73 74 6d 74 29 0a 20  f (step! stmt). 
62e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
62f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6300: 20 20 28 6c 6f 6f 70 20 28 61 70 70 6c 79 20 70    (loop (apply p
6310: 72 6f 63 20 61 63 63 20 28 6d 61 70 20 28 63 75  roc acc (map (cu
6320: 74 65 20 63 6f 6c 75 6d 6e 2d 64 61 74 61 20 73  te column-data s
6330: 74 6d 74 20 3c 3e 29 20 63 6c 29 29 29 0a 20 20  tmt <>) cl))).  
6340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6360: 20 61 63 63 29 29 29 29 0a 0a 20 28 64 65 66 69   acc)))).. (defi
6370: 6e 65 2d 73 79 6e 74 61 78 20 63 68 65 63 6b 2d  ne-syntax check-
6380: 70 72 6f 63 65 64 75 72 65 0a 20 20 20 28 73 79  procedure.   (sy
6390: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20  ntax-rules ().  
63a0: 20 20 20 5b 28 5f 20 6c 6f 63 20 70 72 6f 63 29     [(_ loc proc)
63b0: 0a 20 20 20 20 20 20 28 61 73 73 65 72 74 20 28  .      (assert (
63c0: 61 6e 64 20 6c 6f 63 20 28 70 72 6f 63 65 64 75  and loc (procedu
63d0: 72 65 3f 20 70 72 6f 63 29 29 29 5d 29 29 0a 0a  re? proc)))]))..
63e0: 20 28 64 65 66 69 6e 65 20 28 66 6f 6c 64 2d 72   (define (fold-r
63f0: 6f 77 20 70 72 6f 63 20 69 6e 69 74 20 64 62 2d  ow proc init db-
6400: 6f 72 2d 73 74 6d 74 20 2e 20 70 61 72 61 6d 73  or-stmt . params
6410: 29 0a 20 20 20 28 61 70 70 6c 79 20 25 66 6f 6c  ).   (apply %fol
6420: 64 2d 72 6f 77 20 27 66 6f 6c 64 2d 72 6f 77 20  d-row 'fold-row 
6430: 70 72 6f 63 20 69 6e 69 74 20 64 62 2d 6f 72 2d  proc init db-or-
6440: 73 74 6d 74 20 70 61 72 61 6d 73 29 29 0a 0a 20  stmt params)).. 
6450: 3b 3b 20 41 70 70 6c 79 20 61 20 70 72 6f 63 65  ;; Apply a proce
6460: 64 75 72 65 20 74 6f 20 74 68 65 20 76 61 6c 75  dure to the valu
6470: 65 73 20 6f 66 20 74 68 65 20 72 65 73 75 6c 74  es of the result
6480: 20 63 6f 6c 75 6d 6e 73 20 66 6f 72 20 65 61 63   columns for eac
6490: 68 20 72 65 73 75 6c 74 20 72 6f 77 0a 20 3b 3b  h result row. ;;
64a0: 20 77 68 69 6c 65 20 65 78 65 63 75 74 69 6e 67   while executing
64b0: 20 74 68 65 20 73 74 61 74 65 6d 65 6e 74 20 61   the statement a
64c0: 6e 64 20 64 69 73 63 61 72 64 20 74 68 65 20 72  nd discard the r
64d0: 65 73 75 6c 74 73 0a 0a 20 28 64 65 66 69 6e 65  esults.. (define
64e0: 20 28 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 70   (for-each-row p
64f0: 72 6f 63 20 64 62 2d 6f 72 2d 73 74 6d 74 20 2e  roc db-or-stmt .
6500: 20 70 61 72 61 6d 73 29 0a 20 20 20 28 63 68 65   params).   (che
6510: 63 6b 2d 70 72 6f 63 65 64 75 72 65 20 66 6f 6c  ck-procedure fol
6520: 64 2d 72 6f 77 20 70 72 6f 63 29 0a 20 20 20 28  d-row proc).   (
6530: 61 70 70 6c 79 20 25 66 6f 6c 64 2d 72 6f 77 0a  apply %fold-row.
6540: 20 20 20 20 20 20 20 20 20 20 27 66 6f 72 2d 65            'for-e
6550: 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 20 20 20  ach-row.        
6560: 20 20 28 6c 61 6d 62 64 61 20 28 61 63 63 20 2e    (lambda (acc .
6570: 20 63 6f 6c 75 6d 6e 73 29 0a 20 20 20 20 20 20   columns).      
6580: 20 20 20 20 20 20 28 61 70 70 6c 79 20 70 72 6f        (apply pro
6590: 63 20 63 6f 6c 75 6d 6e 73 29 29 0a 20 20 20 20  c columns)).    
65a0: 20 20 20 20 20 20 28 76 6f 69 64 29 0a 20 20 20        (void).   
65b0: 20 20 20 20 20 20 20 64 62 2d 6f 72 2d 73 74 6d         db-or-stm
65c0: 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 3b 3b 20  t params)).. ;; 
65d0: 41 70 70 6c 79 20 61 20 70 72 6f 63 65 64 75 72  Apply a procedur
65e0: 65 20 74 6f 20 74 68 65 20 76 61 6c 75 65 73 20  e to the values 
65f0: 6f 66 20 74 68 65 20 72 65 73 75 6c 74 20 63 6f  of the result co
6600: 6c 75 6d 6e 73 20 66 6f 72 20 65 61 63 68 20 72  lumns for each r
6610: 65 73 75 6c 74 20 72 6f 77 0a 20 3b 3b 20 77 68  esult row. ;; wh
6620: 69 6c 65 20 65 78 65 63 75 74 69 6e 67 20 74 68  ile executing th
6630: 65 20 73 74 61 74 65 6d 65 6e 74 20 61 6e 64 20  e statement and 
6640: 61 63 63 75 6d 75 6c 61 74 65 20 74 68 65 20 72  accumulate the r
6650: 65 73 75 6c 74 73 20 69 6e 20 61 20 6c 69 73 74  esults in a list
6660: 0a 0a 20 28 64 65 66 69 6e 65 20 28 6d 61 70 2d  .. (define (map-
6670: 72 6f 77 20 70 72 6f 63 20 64 62 2d 6f 72 2d 73  row proc db-or-s
6680: 74 6d 74 20 2e 20 70 61 72 61 6d 73 29 0a 20 20  tmt . params).  
6690: 20 28 63 68 65 63 6b 2d 70 72 6f 63 65 64 75 72   (check-procedur
66a0: 65 20 27 6d 61 70 2d 72 6f 77 20 70 72 6f 63 29  e 'map-row proc)
66b0: 0a 20 20 20 28 72 65 76 65 72 73 65 21 0a 20 20  .   (reverse!.  
66c0: 20 20 28 61 70 70 6c 79 20 25 66 6f 6c 64 2d 72    (apply %fold-r
66d0: 6f 77 0a 20 20 20 20 20 20 20 20 20 20 20 27 6d  ow.           'm
66e0: 61 70 2d 72 6f 77 0a 20 20 20 20 20 20 20 20 20  ap-row.         
66f0: 20 20 28 6c 61 6d 62 64 61 20 28 61 63 63 20 2e    (lambda (acc .
6700: 20 63 6f 6c 75 6d 6e 73 29 0a 20 20 20 20 20 20   columns).      
6710: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 61 70         (cons (ap
6720: 70 6c 79 20 70 72 6f 63 20 63 6f 6c 75 6d 6e 73  ply proc columns
6730: 29 20 61 63 63 29 29 0a 20 20 20 20 20 20 20 20  ) acc)).        
6740: 20 20 20 27 28 29 0a 20 20 20 20 20 20 20 20 20     '().         
6750: 20 20 64 62 2d 6f 72 2d 73 74 6d 74 20 70 61 72    db-or-stmt par
6760: 61 6d 73 29 29 29 0a 0a 3b 3b 3b 20 55 74 69 6c  ams)))..;;; Util
6770: 69 74 79 20 70 72 6f 63 65 64 75 72 65 73 0a 0a  ity procedures..
6780: 20 3b 3b 20 52 75 6e 20 61 20 74 68 75 6e 6b 20   ;; Run a thunk 
6790: 77 69 74 68 69 6e 20 61 20 64 61 74 61 62 61 73  within a databas
67a0: 65 20 74 72 61 6e 73 61 63 74 69 6f 6e 2c 20 63  e transaction, c
67b0: 6f 6d 6d 69 74 20 69 66 20 72 65 74 75 72 6e 20  ommit if return 
67c0: 76 61 6c 75 65 20 69 73 0a 20 3b 3b 20 74 72 75  value is. ;; tru
67d0: 65 2c 20 72 6f 6c 6c 62 61 63 6b 20 69 66 20 72  e, rollback if r
67e0: 65 74 75 72 6e 20 76 61 6c 75 65 20 69 73 20 66  eturn value is f
67f0: 61 6c 73 65 20 6f 72 20 74 68 65 20 74 68 75 6e  alse or the thun
6800: 6b 20 69 73 20 69 6e 74 65 72 72 75 70 74 65 64  k is interrupted
6810: 20 62 79 0a 20 3b 3b 20 61 6e 20 65 78 63 65 70   by. ;; an excep
6820: 74 69 6f 6e 0a 20 28 64 65 66 69 6e 65 20 77 69  tion. (define wi
6830: 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e 0a 20  th-transaction. 
6840: 20 20 28 63 61 73 65 2d 6c 61 6d 62 64 61 0a 20    (case-lambda. 
6850: 20 20 20 20 28 28 64 62 20 74 68 75 6e 6b 29 20      ((db thunk) 
6860: 28 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f  (with-transactio
6870: 6e 20 64 62 20 74 68 75 6e 6b 20 27 64 65 66 65  n db thunk 'defe
6880: 72 72 65 64 29 29 0a 20 20 20 20 20 28 28 64 62  rred)).     ((db
6890: 20 74 68 75 6e 6b 20 74 79 70 65 29 0a 20 20 20   thunk type).   
68a0: 20 20 20 28 63 68 65 63 6b 2d 64 61 74 61 62 61     (check-databa
68b0: 73 65 20 27 77 69 74 68 2d 74 72 61 6e 73 61 63  se 'with-transac
68c0: 74 69 6f 6e 20 64 62 29 0a 20 20 20 20 20 20 28  tion db).      (
68d0: 63 68 65 63 6b 2d 70 72 6f 63 65 64 75 72 65 20  check-procedure 
68e0: 27 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f  'with-transactio
68f0: 6e 20 74 68 75 6e 6b 29 0a 20 20 20 20 20 20 28  n thunk).      (
6900: 75 6e 6c 65 73 73 20 28 6d 65 6d 71 20 74 79 70  unless (memq typ
6910: 65 20 27 28 64 65 66 65 72 72 65 64 20 69 6d 6d  e '(deferred imm
6920: 65 64 69 61 74 65 20 65 78 63 6c 75 73 69 76 65  ediate exclusive
6930: 29 29 0a 20 20 20 20 20 20 20 20 28 65 72 72 6f  )).        (erro
6940: 72 20 27 77 69 74 68 2d 74 72 61 6e 73 61 63 74  r 'with-transact
6950: 69 6f 6e 20 20 22 62 61 64 20 61 72 67 75 6d 65  ion  "bad argume
6960: 6e 74 3a 20 65 78 70 65 63 74 65 64 20 64 65 66  nt: expected def
6970: 65 72 72 65 64 2c 20 69 6d 6d 65 64 69 61 74 65  erred, immediate
6980: 20 6f 72 20 65 78 63 6c 75 73 69 76 65 22 29 0a   or exclusive").
6990: 20 20 20 20 20 20 20 20 74 79 70 65 29 0a 20 20          type).  
69a0: 20 20 20 20 28 6c 65 74 20 28 5b 73 75 63 63 65      (let ([succe
69b0: 73 73 3f 20 23 66 5d 20 5b 65 78 6e 20 23 66 5d  ss? #f] [exn #f]
69c0: 29 0a 20 20 20 20 20 20 20 20 28 64 79 6e 61 6d  ).        (dynam
69d0: 69 63 2d 77 69 6e 64 0a 20 20 20 20 20 20 20 20  ic-wind.        
69e0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20    (lambda ().   
69f0: 20 20 20 20 20 20 20 20 20 28 65 78 65 63 75 74           (execut
6a00: 65 20 64 62 0a 20 20 20 20 20 20 20 20 20 20 20  e db.           
6a10: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e            (strin
6a20: 67 2d 61 70 70 65 6e 64 20 22 42 45 47 49 4e 20  g-append "BEGIN 
6a30: 22 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e  " (symbol->strin
6a40: 67 20 74 79 70 65 29 20 22 20 54 52 41 4e 53 41  g type) " TRANSA
6a50: 43 54 49 4f 4e 3b 22 29 29 29 0a 20 20 20 20 20  CTION;"))).     
6a60: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a       (lambda ().
6a70: 20 20 20 20 20 20 20 20 20 20 20 20 28 67 75 61              (gua
6a80: 72 64 20 28 65 20 5b 65 6c 73 65 20 28 62 65 67  rd (e [else (beg
6a90: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  in.             
6aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6ab0: 20 28 70 72 69 6e 74 2d 65 72 72 6f 72 20 22 77   (print-error "w
6ac0: 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e 22  ith-transaction"
6ad0: 20 65 78 6e 29 0a 20 20 20 20 20 20 20 20 20 20   exn).          
6ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6af0: 20 20 20 20 28 73 65 74 21 20 65 78 6e 20 65 29      (set! exn e)
6b00: 29 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  )]).            
6b10: 20 20 20 20 20 20 20 28 73 65 74 21 20 73 75 63         (set! suc
6b20: 63 65 73 73 3f 20 28 74 68 75 6e 6b 29 29 0a 20  cess? (thunk)). 
6b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6b40: 20 20 73 75 63 63 65 73 73 3f 29 29 0a 20 20 20    success?)).   
6b50: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28         (lambda (
6b60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 65  ).            (e
6b70: 78 65 63 75 74 65 20 64 62 0a 20 20 20 20 20 20  xecute db.      
6b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
6b90: 69 66 20 73 75 63 63 65 73 73 3f 0a 20 20 20 20  if success?.    
6ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6bb0: 20 20 20 20 20 22 43 4f 4d 4d 49 54 20 54 52 41       "COMMIT TRA
6bc0: 4e 53 41 43 54 49 4f 4e 3b 22 0a 20 20 20 20 20  NSACTION;".     
6bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6be0: 20 20 20 20 22 52 4f 4c 4c 42 41 43 4b 20 54 52      "ROLLBACK TR
6bf0: 41 4e 53 41 43 54 49 4f 4e 3b 22 29 29 0a 20 20  ANSACTION;")).  
6c00: 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 2d 6c            (and-l
6c10: 65 74 2a 20 28 5b 65 20 65 78 6e 5d 29 0a 20 20  et* ([e exn]).  
6c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6c30: 20 20 20 20 28 73 65 74 21 20 65 78 6e 20 23 66      (set! exn #f
6c40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
6c50: 20 20 20 20 20 20 20 20 28 72 61 69 73 65 20 65          (raise e
6c60: 29 29 29 29 29 29 29 29 0a 0a 20 3b 3b 20 43 68  )))))))).. ;; Ch
6c70: 65 63 6b 20 69 66 20 74 68 65 20 67 69 76 65 6e  eck if the given
6c80: 20 73 74 72 69 6e 67 20 69 73 20 61 20 76 61 6c   string is a val
6c90: 69 64 20 53 51 4c 20 73 74 61 74 65 6d 65 6e 74  id SQL statement
6ca0: 0a 20 28 64 65 66 69 6e 65 20 73 71 6c 2d 63 6f  . (define sql-co
6cb0: 6d 70 6c 65 74 65 3f 0a 20 20 20 28 66 6f 72 65  mplete?.   (fore
6cc0: 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 73  ign-procedure "s
6cd0: 71 6c 69 74 65 33 5f 63 6f 6d 70 6c 65 74 65 22  qlite3_complete"
6ce0: 20 28 73 74 72 69 6e 67 29 20 62 6f 6f 6c 65 61   (string) boolea
6cf0: 6e 29 29 0a 0a 20 3b 3b 20 52 65 74 75 72 6e 20  n)).. ;; Return 
6d00: 61 20 64 65 73 63 72 69 70 74 69 76 65 20 76 65  a descriptive ve
6d10: 72 73 69 6f 6e 20 73 74 72 69 6e 67 0a 20 28 64  rsion string. (d
6d20: 65 66 69 6e 65 20 64 61 74 61 62 61 73 65 2d 76  efine database-v
6d30: 65 72 73 69 6f 6e 0a 20 20 20 28 66 6f 72 65 69  ersion.   (forei
6d40: 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 73 71  gn-procedure "sq
6d50: 6c 69 74 65 33 5f 6c 69 62 76 65 72 73 69 6f 6e  lite3_libversion
6d60: 22 20 28 29 20 73 74 72 69 6e 67 29 29 0a 0a 20  " () string)).. 
6d70: 3b 3b 20 52 65 74 75 72 6e 20 74 68 65 20 61 6d  ;; Return the am
6d80: 6f 75 6e 74 20 6f 66 20 6d 65 6d 6f 72 79 20 63  ount of memory c
6d90: 75 72 72 65 6e 74 6c 79 20 61 6c 6c 6f 63 61 74  urrently allocat
6da0: 65 64 20 62 79 20 74 68 65 20 64 61 74 61 62 61  ed by the databa
6db0: 73 65 0a 20 28 64 65 66 69 6e 65 20 64 61 74 61  se. (define data
6dc0: 62 61 73 65 2d 6d 65 6d 6f 72 79 2d 75 73 65 64  base-memory-used
6dd0: 0a 20 20 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f  .   (foreign-pro
6de0: 63 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f  cedure "sqlite3_
6df0: 6d 65 6d 6f 72 79 5f 75 73 65 64 22 20 28 29 20  memory_used" () 
6e00: 69 6e 74 29 29 0a 0a 20 3b 3b 20 52 65 74 75 72  int)).. ;; Retur
6e10: 6e 20 74 68 65 20 6d 61 78 69 6d 75 6d 20 61 6d  n the maximum am
6e20: 6f 75 6e 74 20 6f 66 20 6d 65 6d 6f 72 79 20 61  ount of memory a
6e30: 6c 6c 6f 63 61 74 65 64 20 62 79 20 74 68 65 20  llocated by the 
6e40: 64 61 74 61 62 61 73 65 20 73 69 6e 63 65 0a 20  database since. 
6e50: 3b 3b 20 74 68 65 20 63 6f 75 6e 74 65 72 20 77  ;; the counter w
6e60: 61 73 20 6c 61 73 74 20 72 65 73 65 74 0a 20 28  as last reset. (
6e70: 64 65 66 69 6e 65 20 64 61 74 61 62 61 73 65 2d  define database-
6e80: 6d 65 6d 6f 72 79 2d 68 69 67 68 77 61 74 65 72  memory-highwater
6e90: 0a 20 20 20 28 63 61 73 65 2d 6c 61 6d 62 64 61  .   (case-lambda
6ea0: 0a 20 20 20 20 20 28 28 29 20 28 64 61 74 61 62  .     (() (datab
6eb0: 61 73 65 2d 6d 65 6d 6f 72 79 2d 68 69 67 68 77  ase-memory-highw
6ec0: 61 74 65 72 20 23 66 29 29 0a 20 20 20 20 20 28  ater #f)).     (
6ed0: 28 72 65 73 65 74 3f 29 20 28 28 66 6f 72 65 69  (reset?) ((forei
6ee0: 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 73 71  gn-procedure "sq
6ef0: 6c 69 74 65 33 5f 6d 65 6d 6f 72 79 5f 68 69 67  lite3_memory_hig
6f00: 68 77 61 74 65 72 22 20 28 62 6f 6f 6c 65 61 6e  hwater" (boolean
6f10: 29 20 69 6e 74 29 20 72 65 73 65 74 3f 29 29 29  ) int) reset?)))
6f20: 29 0a 0a 20 3b 3b 20 45 6e 61 62 6c 65 73 20 28  ).. ;; Enables (
6f30: 64 69 73 61 62 6c 65 73 29 20 74 68 65 20 73 68  disables) the sh
6f40: 61 72 69 6e 67 20 6f 66 20 74 68 65 20 64 61 74  aring of the dat
6f50: 61 62 61 73 65 20 63 61 63 68 65 20 61 6e 64 20  abase cache and 
6f60: 73 63 68 65 6d 61 20 64 61 74 61 0a 20 3b 3b 20  schema data. ;; 
6f70: 73 74 72 75 63 74 75 72 65 73 20 62 65 74 77 65  structures betwe
6f80: 65 6e 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 74  en connections t
6f90: 6f 20 74 68 65 20 73 61 6d 65 20 64 61 74 61 62  o the same datab
6fa0: 61 73 65 2e 0a 20 28 64 65 66 69 6e 65 20 28 65  ase.. (define (e
6fb0: 6e 61 62 6c 65 2d 73 68 61 72 65 64 2d 63 61 63  nable-shared-cac
6fc0: 68 65 21 20 65 6e 61 62 6c 65 3f 29 0a 20 20 20  he! enable?).   
6fd0: 28 63 6f 6e 64 2d 65 78 70 61 6e 64 0a 20 20 20  (cond-expand.   
6fe0: 20 5b 64 69 73 61 62 6c 65 2d 73 68 61 72 65 64   [disable-shared
6ff0: 2d 63 61 63 68 65 0a 20 20 20 20 20 23 66 5d 0a  -cache.     #f].
7000: 20 20 20 20 5b 65 6c 73 65 0a 20 20 20 20 20 28      [else.     (
7010: 63 6f 6e 64 0a 20 20 20 20 20 20 5b 28 28 66 6f  cond.      [((fo
7020: 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20  reign-procedure 
7030: 22 73 71 6c 69 74 65 33 5f 65 6e 61 62 6c 65 5f  "sqlite3_enable_
7040: 73 68 61 72 65 64 5f 63 61 63 68 65 22 20 28 62  shared_cache" (b
7050: 6f 6f 6c 65 61 6e 29 20 69 6e 74 29 20 65 6e 61  oolean) int) ena
7060: 62 6c 65 3f 29 0a 20 20 20 20 20 20 20 3d 3e 20  ble?).       => 
7070: 28 61 62 6f 72 74 2d 73 71 6c 69 74 65 33 2d 65  (abort-sqlite3-e
7080: 72 72 6f 72 20 27 65 6e 61 62 6c 65 2d 73 68 61  rror 'enable-sha
7090: 72 65 64 2d 63 61 63 68 65 21 20 23 66 29 5d 0a  red-cache! #f)].
70a0: 20 20 20 20 20 20 5b 65 6c 73 65 0a 20 20 20 20        [else.    
70b0: 20 20 20 65 6e 61 62 6c 65 3f 5d 29 5d 29 29 0a     enable?])])).
70c0: 0a 20 3b 3b 20 45 6e 61 62 6c 65 73 20 28 64 69  . ;; Enables (di
70d0: 73 61 62 6c 65 73 29 20 74 68 65 20 6c 6f 61 64  sables) the load
70e0: 69 6e 67 20 6f 66 20 6e 61 74 69 76 65 20 65 78  ing of native ex
70f0: 74 65 6e 73 69 6f 6e 73 20 75 73 69 6e 67 20 53  tensions using S
7100: 51 4c 20 73 74 61 74 65 6d 65 6e 74 73 2e 0a 20  QL statements.. 
7110: 28 64 65 66 69 6e 65 20 28 65 6e 61 62 6c 65 2d  (define (enable-
7120: 6c 6f 61 64 2d 65 78 74 65 6e 73 69 6f 6e 21 20  load-extension! 
7130: 64 62 20 65 6e 61 62 6c 65 3f 29 0a 20 20 20 28  db enable?).   (
7140: 63 6f 6e 64 2d 65 78 70 61 6e 64 0a 20 20 20 20  cond-expand.    
7150: 5b 64 69 73 61 62 6c 65 2d 6c 6f 61 64 2d 65 78  [disable-load-ex
7160: 74 65 6e 73 69 6f 6e 0a 20 20 20 20 20 23 66 5d  tension.     #f]
7170: 0a 20 20 20 20 5b 65 6c 73 65 0a 20 20 20 20 20  .    [else.     
7180: 28 63 6f 6e 64 0a 20 20 20 20 20 20 5b 28 28 66  (cond.      [((f
7190: 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65  oreign-procedure
71a0: 20 22 73 71 6c 69 74 65 33 5f 65 6e 61 62 6c 65   "sqlite3_enable
71b0: 5f 6c 6f 61 64 5f 65 78 74 65 6e 73 69 6f 6e 22  _load_extension"
71c0: 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 61   (sqlite3:databa
71d0: 73 65 2a 20 62 6f 6f 6c 65 61 6e 29 20 69 6e 74  se* boolean) int
71e0: 29 20 28 64 61 74 61 62 61 73 65 2d 61 64 64 72  ) (database-addr
71f0: 20 64 62 29 20 65 6e 61 62 6c 65 3f 29 0a 20 20   db) enable?).  
7200: 20 20 20 20 20 3d 3e 20 28 61 62 6f 72 74 2d 73       => (abort-s
7210: 71 6c 69 74 65 33 2d 65 72 72 6f 72 20 27 65 6e  qlite3-error 'en
7220: 61 62 6c 65 2d 6c 6f 61 64 2d 65 78 74 65 6e 73  able-load-extens
7230: 69 6f 6e 21 20 64 62 29 5d 0a 20 20 20 20 20 20  ion! db)].      
7240: 5b 65 6c 73 65 0a 20 20 20 20 20 20 20 65 6e 61  [else.       ena
7250: 62 6c 65 3f 5d 29 5d 29 29 0a 0a 20 28 64 65 66  ble?])])).. (def
7260: 69 6e 65 20 28 73 71 6c 69 74 65 33 2d 74 72 61  ine (sqlite3-tra
7270: 63 65 20 64 62 20 66 75 6e 63 20 64 61 74 61 29  ce db func data)
7280: 0a 20 20 20 28 63 68 65 63 6b 2d 64 61 74 61 62  .   (check-datab
7290: 61 73 65 20 27 73 71 6c 69 74 65 33 2d 74 72 61  ase 'sqlite3-tra
72a0: 63 65 20 64 62 29 0a 20 20 20 28 6c 65 74 20 28  ce db).   (let (
72b0: 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63  [f (foreign-proc
72c0: 65 64 75 72 65 20 22 73 71 6c 69 74 65 33 5f 74  edure "sqlite3_t
72d0: 72 61 63 65 22 20 28 73 71 6c 69 74 65 33 3a 64  race" (sqlite3:d
72e0: 61 74 61 62 61 73 65 2a 20 76 6f 69 64 2a 20 76  atabase* void* v
72f0: 6f 69 64 2a 29 20 76 6f 69 64 29 5d 29 0a 20 20  oid*) void)]).  
7300: 20 20 20 28 66 20 28 64 61 74 61 62 61 73 65 2d     (f (database-
7310: 61 64 64 72 20 64 62 29 20 66 75 6e 63 20 64 61  addr db) func da
7320: 74 61 29 29 29 0a 0a 20 28 64 65 66 69 6e 65 20  ta))).. (define 
7330: 28 73 71 6c 69 74 65 33 2d 63 6f 6e 66 69 67 2d  (sqlite3-config-
7340: 6c 6f 67 20 66 75 6e 63 20 64 61 74 61 29 0a 20  log func data). 
7350: 20 20 3b 28 63 68 65 63 6b 2d 64 61 74 61 62 61    ;(check-databa
7360: 73 65 20 27 73 71 6c 69 74 65 33 2d 63 6f 6e 66  se 'sqlite3-conf
7370: 69 67 2d 6c 6f 67 20 64 62 29 0a 20 20 20 28 6c  ig-log db).   (l
7380: 65 74 20 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d  et ([f (foreign-
7390: 70 72 6f 63 65 64 75 72 65 20 22 73 71 6c 69 74  procedure "sqlit
73a0: 65 33 5f 63 6f 6e 66 69 67 22 20 28 69 6e 74 20  e3_config" (int 
73b0: 76 6f 69 64 2a 20 76 6f 69 64 2a 29 20 76 6f 69  void* void*) voi
73c0: 64 29 5d 29 0a 20 20 20 20 20 28 66 20 31 36 20  d)]).     (f 16 
73d0: 66 75 6e 63 20 64 61 74 61 29 29 29 0a 0a 20 28  func data))).. (
73e0: 72 65 63 6f 72 64 2d 77 72 69 74 65 72 0a 20 20  record-writer.  
73f0: 28 74 79 70 65 2d 64 65 73 63 72 69 70 74 6f 72  (type-descriptor
7400: 20 64 61 74 61 62 61 73 65 29 0a 20 20 28 6c 61   database).  (la
7410: 6d 62 64 61 20 28 72 20 70 20 77 72 29 0a 20 20  mbda (r p wr).  
7420: 20 20 28 77 72 0a 20 20 20 20 20 28 69 66 20 28    (wr.     (if (
7430: 64 61 74 61 62 61 73 65 2d 70 74 72 20 72 29 0a  database-ptr r).
7440: 20 20 20 20 20 20 20 20 20 22 23 3c 73 71 6c 69           "#<sqli
7450: 74 65 33 3a 64 61 74 61 62 61 73 65 3e 22 0a 20  te3:database>". 
7460: 20 20 20 20 20 20 20 20 22 23 3c 73 71 6c 69 74          "#<sqlit
7470: 65 33 3a 64 61 74 61 62 61 73 65 20 7a 6f 6d 62  e3:database zomb
7480: 69 65 3e 22 29 0a 20 20 20 20 20 70 29 29 29 0a  ie>").     p))).
7490: 20 28 72 65 63 6f 72 64 2d 77 72 69 74 65 72 0a   (record-writer.
74a0: 20 20 28 74 79 70 65 2d 64 65 73 63 72 69 70 74    (type-descript
74b0: 6f 72 20 73 74 61 74 65 6d 65 6e 74 29 0a 20 20  or statement).  
74c0: 28 6c 61 6d 62 64 61 20 28 72 20 70 20 77 72 29  (lambda (r p wr)
74d0: 0a 20 20 20 20 28 77 72 0a 20 20 20 20 20 28 69  .    (wr.     (i
74e0: 66 20 28 73 74 61 74 65 6d 65 6e 74 2d 70 74 72  f (statement-ptr
74f0: 20 72 29 0a 20 20 20 20 20 20 20 20 20 28 66 6f   r).         (fo
7500: 72 6d 61 74 20 22 23 3c 73 71 6c 69 74 65 33 3a  rmat "#<sqlite3:
7510: 73 74 61 74 65 6d 65 6e 74 20 73 71 6c 3d 7e 73  statement sql=~s
7520: 3e 22 20 28 73 74 61 74 65 6d 65 6e 74 2d 73 71  >" (statement-sq
7530: 6c 20 72 29 29 0a 20 20 20 20 20 20 20 20 20 22  l r)).         "
7540: 23 3c 73 71 6c 69 74 65 33 3a 73 74 61 74 65 6d  #<sqlite3:statem
7550: 65 6e 74 20 7a 6f 6d 62 69 65 3e 22 29 0a 20 20  ent zombie>").  
7560: 20 20 20 70 29 29 29 0a 0a 0a 20 29 20 3b 20 6c     p)))... ) ; l
7570: 69 62 72 61 72 79 20 73 71 6c 69 74 65 33 0a 0a  ibrary sqlite3..