Megatest

Hex Artifact Content
Login

Artifact 2795191c23a7f887a7f83baf0e21ef4d35682b54:


0000: 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d  ..(define (make-
0010: 63 61 63 68 65 64 2d 77 72 69 74 65 72 20 74 68  cached-writer th
0020: 65 2d 64 62 29 0a 20 20 28 6c 65 74 20 28 28 64  e-db).  (let ((d
0030: 62 20 20 20 20 74 68 65 2d 64 62 29 0a 09 28 71  b    the-db)..(q
0040: 75 65 75 65 20 27 28 29 29 29 0a 20 20 20 20 28  ueue '())).    (
0050: 6c 61 6d 62 64 61 20 28 63 61 63 68 65 61 62 6c  lambda (cacheabl
0060: 65 20 2e 20 71 72 79 2d 70 61 72 61 6d 73 29 20  e . qry-params) 
0070: 3b 3b 20 66 6e 20 71 72 79 0a 20 20 20 20 20 20  ;; fn qry.      
0080: 28 69 66 20 63 61 63 68 65 61 62 6c 65 0a 09 20  (if cacheable.. 
0090: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65   (begin..    (se
00a0: 74 21 20 71 75 65 75 65 20 28 63 6f 6e 73 20 71  t! queue (cons q
00b0: 72 79 2d 70 61 72 61 6d 73 20 71 75 65 75 65 29  ry-params queue)
00c0: 29 0a 09 20 20 20 20 28 63 61 6c 6c 2f 63 63 29  )..    (call/cc)
00d0: 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20  )..  (begin..   
00e0: 20 28 70 72 69 6e 74 20 22 53 74 61 72 74 69 6e   (print "Startin
00f0: 67 20 74 72 61 6e 73 61 63 74 69 6f 6e 22 29 0a  g transaction").
0100: 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09  .    (for-each..
0110: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 71 75       (lambda (qu
0120: 65 75 65 2d 69 74 65 6d 29 0a 09 20 20 20 20 20  eue-item)..     
0130: 20 20 28 6c 65 74 20 28 28 66 6e 20 20 28 63 61    (let ((fn  (ca
0140: 72 20 71 75 65 75 65 2d 69 74 65 6d 29 29 0a 09  r queue-item))..
0150: 09 20 20 20 20 20 28 71 72 79 20 28 63 64 72 20  .     (qry (cdr 
0160: 71 75 65 75 65 2d 69 74 65 6d 29 29 29 0a 09 09  queue-item)))...
0170: 20 28 70 72 69 6e 74 20 22 57 52 49 54 45 20 74   (print "WRITE t
0180: 6f 20 22 20 64 62 20 22 3a 20 22 20 71 72 79 29  o " db ": " qry)
0190: 0a 09 09 20 29 0a 09 20 20 20 20 20 28 72 65 76  ... )..     (rev
01a0: 65 72 73 65 20 71 75 65 75 65 29 29 0a 09 20 20  erse queue))..  
01b0: 20 20 28 70 72 69 6e 74 20 22 45 6e 64 20 74 72    (print "End tr
01c0: 61 6e 73 61 63 74 69 6f 6e 22 29 0a 09 20 20 20  ansaction")..   
01d0: 20 28 70 72 69 6e 74 20 22 52 45 41 44 20 66 72   (print "READ fr
01e0: 6f 6d 20 22 20 64 62 20 22 3a 20 22 20 71 72 79  om " db ": " qry
01f0: 2d 70 61 72 61 6d 73 29 29 29 29 29 29 0a 0a 28  -params))))))..(
0200: 64 65 66 69 6e 65 20 2a 63 77 2a 20 28 6d 61 6b  define *cw* (mak
0210: 65 2d 63 61 63 68 65 64 2d 77 72 69 74 65 72 20  e-cached-writer 
0220: 22 74 68 65 20 64 62 22 29 29 0a 0a 28 64 65 66  "the db"))..(def
0230: 69 6e 65 20 28 64 62 63 61 6c 6c 20 63 61 63 68  ine (dbcall cach
0240: 65 61 62 6c 65 20 71 75 65 72 79 29 0a 20 20 28  eable query).  (
0250: 2a 63 77 2a 20 63 61 63 68 65 61 62 6c 65 20 71  *cw* cacheable q
0260: 75 65 72 79 29 29 0a 0a 28 64 62 63 61 6c 6c 20  uery))..(dbcall 
0270: 23 74 20 22 69 6e 73 65 72 74 20 61 62 63 22 29  #t "insert abc")
0280: 0a 28 64 62 63 61 6c 6c 20 23 74 20 22 69 6e 73  .(dbcall #t "ins
0290: 65 72 74 20 64 65 66 22 29 0a 28 64 62 63 61 6c  ert def").(dbcal
02a0: 6c 20 23 74 20 22 69 6e 73 65 72 74 20 68 69 6a  l #t "insert hij
02b0: 22 29 0a 28 64 62 63 61 6c 6c 20 23 66 20 22 73  ").(dbcall #f "s
02c0: 65 6c 65 63 74 20 66 6f 6f 22 29 0a              elect foo").