Artifact 35356fb30cd63cceaa19b28e2e0ff5af6220b055:
- File suspension.scm — part of check-in [c29262e9f4] at 2013-05-30 17:00:20 on branch trunk — Protobuf and suspension based serialization of continuations, request parameter utilities, reader extension loader (user: murphy size: 3134)
0000: 3b 3b 20 2d 2a 2d 20 6d 6f 64 65 3a 20 53 63 68 ;; -*- mode: Sch 0010: 65 6d 65 3b 20 2d 2a 2d 0a 3b 3b 0a 3b 3b 20 54 eme; -*-.;;.;; T 0020: 68 69 73 20 66 69 6c 65 20 69 73 20 64 69 73 74 his file is dist 0030: 72 69 62 75 74 65 64 20 77 69 74 68 20 57 65 62 ributed with Web 0040: 47 61 74 65 20 66 6f 72 20 43 48 49 43 4b 45 4e Gate for CHICKEN 0050: 2e 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 28 ..;; Copyright ( 0060: 63 29 20 32 30 30 36 2d 32 30 31 30 20 62 79 20 c) 2006-2010 by 0070: 46 65 6c 69 78 20 4c 2e 20 57 69 6e 6b 65 6c 6d Felix L. Winkelm 0080: 61 6e 6e 2e 20 20 41 6c 6c 20 72 69 67 68 74 73 ann. All rights 0090: 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b 0a 3b 3b reserved..;;.;; 00a0: 20 52 65 64 69 73 74 72 69 62 75 74 69 6f 6e 20 Redistribution 00b0: 61 6e 64 20 75 73 65 20 69 6e 20 73 6f 75 72 63 and use in sourc 00c0: 65 20 61 6e 64 20 62 69 6e 61 72 79 20 66 6f 72 e and binary for 00d0: 6d 73 2c 20 77 69 74 68 20 6f 72 20 77 69 74 68 ms, with or with 00e0: 6f 75 74 0a 3b 3b 20 6d 6f 64 69 66 69 63 61 74 out.;; modificat 00f0: 69 6f 6e 2c 20 61 72 65 20 70 65 72 6d 69 74 74 ion, are permitt 0100: 65 64 20 70 72 6f 76 69 64 65 64 20 74 68 61 74 ed provided that 0110: 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 63 the following c 0120: 6f 6e 64 69 74 69 6f 6e 73 0a 3b 3b 20 61 72 65 onditions.;; are 0130: 20 6d 65 74 3a 0a 3b 3b 0a 3b 3b 20 31 2e 20 52 met:.;;.;; 1. R 0140: 65 64 69 73 74 72 69 62 75 74 69 6f 6e 73 20 6f edistributions o 0150: 66 20 73 6f 75 72 63 65 20 63 6f 64 65 20 6d 75 f source code mu 0160: 73 74 20 72 65 74 61 69 6e 20 74 68 65 20 61 62 st retain the ab 0170: 6f 76 65 20 63 6f 70 79 72 69 67 68 74 0a 3b 3b ove copyright.;; 0180: 20 20 20 20 6e 6f 74 69 63 65 2c 20 74 68 69 73 notice, this 0190: 20 6c 69 73 74 20 6f 66 20 63 6f 6e 64 69 74 69 list of conditi 01a0: 6f 6e 73 20 61 6e 64 20 74 68 65 20 66 6f 6c 6c ons and the foll 01b0: 6f 77 69 6e 67 20 64 69 73 63 6c 61 69 6d 65 72 owing disclaimer 01c0: 2e 0a 3b 3b 0a 3b 3b 20 32 2e 20 52 65 64 69 73 ..;;.;; 2. Redis 01d0: 74 72 69 62 75 74 69 6f 6e 73 20 69 6e 20 62 69 tributions in bi 01e0: 6e 61 72 79 20 66 6f 72 6d 20 6d 75 73 74 20 72 nary form must r 01f0: 65 70 72 6f 64 75 63 65 20 74 68 65 20 61 62 6f eproduce the abo 0200: 76 65 0a 3b 3b 20 20 20 20 63 6f 70 79 72 69 67 ve.;; copyrig 0210: 68 74 20 6e 6f 74 69 63 65 2c 20 74 68 69 73 20 ht notice, this 0220: 6c 69 73 74 20 6f 66 20 63 6f 6e 64 69 74 69 6f list of conditio 0230: 6e 73 20 61 6e 64 20 74 68 65 20 66 6f 6c 6c 6f ns and the follo 0240: 77 69 6e 67 0a 3b 3b 20 20 20 20 64 69 73 63 6c wing.;; discl 0250: 61 69 6d 65 72 20 69 6e 20 74 68 65 20 64 6f 63 aimer in the doc 0260: 75 6d 65 6e 74 61 74 69 6f 6e 20 61 6e 64 2f 6f umentation and/o 0270: 72 20 6f 74 68 65 72 20 6d 61 74 65 72 69 61 6c r other material 0280: 73 20 70 72 6f 76 69 64 65 64 0a 3b 3b 20 20 20 s provided.;; 0290: 20 77 69 74 68 20 74 68 65 20 64 69 73 74 72 69 with the distri 02a0: 62 75 74 69 6f 6e 2e 0a 3b 3b 0a 3b 3b 20 33 2e bution..;;.;; 3. 02b0: 20 54 68 65 20 6e 61 6d 65 20 6f 66 20 74 68 65 The name of the 02c0: 20 61 75 74 68 6f 72 73 20 6d 61 79 20 6e 6f 74 authors may not 02d0: 20 62 65 20 75 73 65 64 20 74 6f 20 65 6e 64 6f be used to endo 02e0: 72 73 65 20 6f 72 20 70 72 6f 6d 6f 74 65 0a 3b rse or promote.; 02f0: 3b 20 20 20 20 70 72 6f 64 75 63 74 73 20 64 65 ; products de 0300: 72 69 76 65 64 20 66 72 6f 6d 20 74 68 69 73 20 rived from this 0310: 73 6f 66 74 77 61 72 65 20 77 69 74 68 6f 75 74 software without 0320: 20 73 70 65 63 69 66 69 63 20 70 72 69 6f 72 0a specific prior. 0330: 3b 3b 20 20 20 20 77 72 69 74 74 65 6e 20 70 65 ;; written pe 0340: 72 6d 69 73 73 69 6f 6e 2e 0a 3b 3b 20 0a 3b 3b rmission..;; .;; 0350: 20 54 48 49 53 20 53 4f 46 54 57 41 52 45 20 49 THIS SOFTWARE I 0360: 53 20 50 52 4f 56 49 44 45 44 20 42 59 20 54 48 S PROVIDED BY TH 0370: 45 20 41 55 54 48 4f 52 53 20 60 60 41 53 20 49 E AUTHORS ``AS I 0380: 53 27 27 20 41 4e 44 20 41 4e 59 20 45 58 50 52 S'' AND ANY EXPR 0390: 45 53 53 0a 3b 3b 20 4f 52 20 49 4d 50 4c 49 45 ESS.;; OR IMPLIE 03a0: 44 20 57 41 52 52 41 4e 54 49 45 53 2c 20 49 4e D WARRANTIES, IN 03b0: 43 4c 55 44 49 4e 47 2c 20 42 55 54 20 4e 4f 54 CLUDING, BUT NOT 03c0: 20 4c 49 4d 49 54 45 44 20 54 4f 2c 20 54 48 45 LIMITED TO, THE 03d0: 20 49 4d 50 4c 49 45 44 0a 3b 3b 20 57 41 52 52 IMPLIED.;; WARR 03e0: 41 4e 54 49 45 53 20 4f 46 20 4d 45 52 43 48 41 ANTIES OF MERCHA 03f0: 4e 54 41 42 49 4c 49 54 59 20 41 4e 44 20 46 49 NTABILITY AND FI 0400: 54 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 TNESS FOR A PART 0410: 49 43 55 4c 41 52 20 50 55 52 50 4f 53 45 0a 3b ICULAR PURPOSE.; 0420: 3b 20 41 52 45 20 44 49 53 43 4c 41 49 4d 45 44 ; ARE DISCLAIMED 0430: 2e 20 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 53 . IN NO EVENT S 0440: 48 41 4c 4c 20 54 48 45 20 41 55 54 48 4f 52 53 HALL THE AUTHORS 0450: 20 42 45 20 4c 49 41 42 4c 45 20 46 4f 52 20 41 BE LIABLE FOR A 0460: 4e 59 0a 3b 3b 20 44 49 52 45 43 54 2c 20 49 4e NY.;; DIRECT, IN 0470: 44 49 52 45 43 54 2c 20 49 4e 43 49 44 45 4e 54 DIRECT, INCIDENT 0480: 41 4c 2c 20 53 50 45 43 49 41 4c 2c 20 45 58 45 AL, SPECIAL, EXE 0490: 4d 50 4c 41 52 59 2c 20 4f 52 20 43 4f 4e 53 45 MPLARY, OR CONSE 04a0: 51 55 45 4e 54 49 41 4c 0a 3b 3b 20 44 41 4d 41 QUENTIAL.;; DAMA 04b0: 47 45 53 20 28 49 4e 43 4c 55 44 49 4e 47 2c 20 GES (INCLUDING, 04c0: 42 55 54 20 4e 4f 54 20 4c 49 4d 49 54 45 44 20 BUT NOT LIMITED 04d0: 54 4f 2c 20 50 52 4f 43 55 52 45 4d 45 4e 54 20 TO, PROCUREMENT 04e0: 4f 46 20 53 55 42 53 54 49 54 55 54 45 0a 3b 3b OF SUBSTITUTE.;; 04f0: 20 47 4f 4f 44 53 20 4f 52 20 53 45 52 56 49 43 GOODS OR SERVIC 0500: 45 53 3b 20 4c 4f 53 53 20 4f 46 20 55 53 45 2c ES; LOSS OF USE, 0510: 20 44 41 54 41 2c 20 4f 52 20 50 52 4f 46 49 54 DATA, OR PROFIT 0520: 53 3b 20 4f 52 20 42 55 53 49 4e 45 53 53 0a 3b S; OR BUSINESS.; 0530: 3b 20 49 4e 54 45 52 52 55 50 54 49 4f 4e 29 20 ; INTERRUPTION) 0540: 48 4f 57 45 56 45 52 20 43 41 55 53 45 44 20 41 HOWEVER CAUSED A 0550: 4e 44 20 4f 4e 20 41 4e 59 20 54 48 45 4f 52 59 ND ON ANY THEORY 0560: 20 4f 46 20 4c 49 41 42 49 4c 49 54 59 2c 0a 3b OF LIABILITY,.; 0570: 3b 20 57 48 45 54 48 45 52 20 49 4e 20 43 4f 4e ; WHETHER IN CON 0580: 54 52 41 43 54 2c 20 53 54 52 49 43 54 20 4c 49 TRACT, STRICT LI 0590: 41 42 49 4c 49 54 59 2c 20 4f 52 20 54 4f 52 54 ABILITY, OR TORT 05a0: 20 28 49 4e 43 4c 55 44 49 4e 47 0a 3b 3b 20 4e (INCLUDING.;; N 05b0: 45 47 4c 49 47 45 4e 43 45 20 4f 52 20 4f 54 48 EGLIGENCE OR OTH 05c0: 45 52 57 49 53 45 29 20 41 52 49 53 49 4e 47 20 ERWISE) ARISING 05d0: 49 4e 20 41 4e 59 20 57 41 59 20 4f 55 54 20 4f IN ANY WAY OUT O 05e0: 46 20 54 48 45 20 55 53 45 20 4f 46 20 54 48 49 F THE USE OF THI 05f0: 53 0a 3b 3b 20 53 4f 46 54 57 41 52 45 2c 20 45 S.;; SOFTWARE, E 0600: 56 45 4e 20 49 46 20 41 44 56 49 53 45 44 20 4f VEN IF ADVISED O 0610: 46 20 54 48 45 20 50 4f 53 53 49 42 49 4c 49 54 F THE POSSIBILIT 0620: 59 20 4f 46 20 53 55 43 48 20 44 41 4d 41 47 45 Y OF SUCH DAMAGE 0630: 2e 0a 0a 28 64 65 63 6c 61 72 65 20 28 64 69 73 ...(declare (dis 0640: 61 62 6c 65 2d 69 6e 74 65 72 72 75 70 74 73 29 able-interrupts) 0650: 29 0a 0a 28 64 65 66 69 6e 65 20 65 72 72 6f 72 )..(define error 0660: 2d 6f 75 74 70 75 74 20 23 23 73 79 73 23 73 74 -output ##sys#st 0670: 61 6e 64 61 72 64 2d 65 72 72 6f 72 29 0a 28 64 andard-error).(d 0680: 65 66 69 6e 65 20 73 74 61 6e 64 61 72 64 2d 6f efine standard-o 0690: 75 74 70 75 74 20 23 23 73 79 73 23 73 74 61 6e utput ##sys#stan 06a0: 64 61 72 64 2d 6f 75 74 70 75 74 29 0a 28 64 65 dard-output).(de 06b0: 66 69 6e 65 20 73 74 61 6e 64 61 72 64 2d 69 6e fine standard-in 06c0: 70 75 74 20 23 23 73 79 73 23 73 74 61 6e 64 61 put ##sys#standa 06d0: 72 64 2d 69 6e 70 75 74 29 0a 0a 28 64 65 66 69 rd-input)..(defi 06e0: 6e 65 20 28 65 78 63 65 70 74 69 6f 6e 2d 68 61 ne (exception-ha 06f0: 6e 64 6c 65 72 20 65 78 29 0a 20 20 28 74 68 72 ndler ex). (thr 0700: 65 61 64 2d 73 69 67 6e 61 6c 21 20 28 74 68 72 ead-signal! (thr 0710: 65 61 64 2d 73 70 65 63 69 66 69 63 20 23 23 73 ead-specific ##s 0720: 79 73 23 63 75 72 72 65 6e 74 2d 74 68 72 65 61 ys#current-threa 0730: 64 29 20 65 78 29 0a 20 20 28 63 6f 6e 74 69 6e d) ex). (contin 0740: 75 61 74 69 6f 6e 2d 64 72 6f 70 20 23 66 29 20 uation-drop #f) 0750: 29 0a 0a 28 64 65 66 69 6e 65 20 28 77 69 74 68 )..(define (with 0760: 2d 6c 69 6d 69 74 65 64 2d 63 6f 6e 74 69 6e 75 -limited-continu 0770: 61 74 69 6f 6e 20 74 68 75 6e 6b 29 0a 20 20 28 ation thunk). ( 0780: 6c 65 74 2a 20 28 28 74 20 28 6d 61 6b 65 2d 74 let* ((t (make-t 0790: 68 72 65 61 64 20 0a 09 20 20 20 20 20 28 6c 61 hread .. (la 07a0: 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 20 mbda ().. 07b0: 28 23 23 73 79 73 23 63 61 6c 6c 2d 77 69 74 68 (##sys#call-with 07c0: 2d 63 74 68 75 6c 68 75 0a 09 09 28 6c 61 6d 62 -cthulhu...(lamb 07d0: 64 61 20 28 29 20 0a 09 09 20 20 28 23 23 73 79 da () ... (##sy 07e0: 73 23 63 61 6c 6c 2d 77 69 74 68 2d 76 61 6c 75 s#call-with-valu 07f0: 65 73 20 74 68 75 6e 6b 20 63 6f 6e 74 69 6e 75 es thunk continu 0800: 61 74 69 6f 6e 2d 64 72 6f 70 29 20 29 20 29 20 ation-drop) ) ) 0810: 29 20 29 20 29 0a 09 20 28 73 74 61 74 65 20 28 ) ) ).. (state ( 0820: 23 23 73 79 73 23 73 6c 6f 74 20 74 20 35 29 29 ##sys#slot t 5)) 0830: 20 29 0a 20 20 20 20 28 23 23 73 79 73 23 73 65 ). (##sys#se 0840: 74 69 73 6c 6f 74 20 73 74 61 74 65 20 30 20 27 tislot state 0 ' 0850: 28 29 29 0a 20 20 20 20 28 23 23 73 79 73 23 73 ()). (##sys#s 0860: 65 74 73 6c 6f 74 20 73 74 61 74 65 20 31 20 73 etslot state 1 s 0870: 74 61 6e 64 61 72 64 2d 69 6e 70 75 74 29 0a 20 tandard-input). 0880: 20 20 20 28 23 23 73 79 73 23 73 65 74 73 6c 6f (##sys#setslo 0890: 74 20 73 74 61 74 65 20 32 20 73 74 61 6e 64 61 t state 2 standa 08a0: 72 64 2d 6f 75 74 70 75 74 29 0a 20 20 20 20 28 rd-output). ( 08b0: 23 23 73 79 73 23 73 65 74 73 6c 6f 74 20 73 74 ##sys#setslot st 08c0: 61 74 65 20 33 20 65 72 72 6f 72 2d 6f 75 74 70 ate 3 error-outp 08d0: 75 74 29 20 0a 20 20 20 20 28 23 23 73 79 73 23 ut) . (##sys# 08e0: 73 65 74 73 6c 6f 74 20 73 74 61 74 65 20 34 20 setslot state 4 08f0: 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 65 exception-handle 0900: 72 29 0a 20 20 20 20 28 74 68 72 65 61 64 2d 73 r). (thread-s 0910: 70 65 63 69 66 69 63 2d 73 65 74 21 20 74 20 23 pecific-set! t # 0920: 23 73 79 73 23 63 75 72 72 65 6e 74 2d 74 68 72 #sys#current-thr 0930: 65 61 64 29 0a 20 20 20 20 28 74 68 72 65 61 64 ead). (thread 0940: 2d 73 74 61 72 74 21 20 74 29 0a 20 20 20 20 28 -start! t). ( 0950: 74 68 72 65 61 64 2d 73 75 73 70 65 6e 64 21 20 thread-suspend! 0960: 23 23 73 79 73 23 63 75 72 72 65 6e 74 2d 74 68 ##sys#current-th 0970: 72 65 61 64 29 0a 20 20 20 20 28 23 23 73 79 73 read). (##sys 0980: 23 73 65 74 73 6c 6f 74 20 28 23 23 73 79 73 23 #setslot (##sys# 0990: 73 6c 6f 74 20 74 20 35 29 20 35 20 28 23 23 73 slot t 5) 5 (##s 09a0: 79 73 23 73 6c 6f 74 20 73 74 61 74 65 20 35 29 ys#slot state 5) 09b0: 29 0a 20 20 20 20 28 23 23 73 79 73 23 61 70 70 ). (##sys#app 09c0: 6c 79 2d 76 61 6c 75 65 73 20 28 23 23 73 79 73 ly-values (##sys 09d0: 23 73 6c 6f 74 20 74 20 32 29 29 20 29 20 29 0a #slot t 2)) ) ). 09e0: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 74 69 6e .(define (contin 09f0: 75 61 74 69 6f 6e 2d 64 72 6f 70 20 2e 20 72 65 uation-drop . re 0a00: 73 75 6c 74 73 29 0a 20 20 28 23 23 73 79 73 23 sults). (##sys# 0a10: 73 65 74 73 6c 6f 74 20 23 23 73 79 73 23 63 75 setslot ##sys#cu 0a20: 72 72 65 6e 74 2d 74 68 72 65 61 64 20 32 20 72 rrent-thread 2 r 0a30: 65 73 75 6c 74 73 29 0a 20 20 28 74 68 72 65 61 esults). (threa 0a40: 64 2d 72 65 73 75 6d 65 21 20 28 74 68 72 65 61 d-resume! (threa 0a50: 64 2d 73 70 65 63 69 66 69 63 20 23 23 73 79 73 d-specific ##sys 0a60: 23 63 75 72 72 65 6e 74 2d 74 68 72 65 61 64 29 #current-thread) 0a70: 29 0a 20 20 28 23 23 73 79 73 23 74 68 72 65 61 ). (##sys#threa 0a80: 64 2d 6b 69 6c 6c 21 20 23 23 73 79 73 23 63 75 d-kill! ##sys#cu 0a90: 72 72 65 6e 74 2d 74 68 72 65 61 64 20 27 64 65 rrent-thread 'de 0aa0: 61 64 29 20 0a 20 20 28 23 23 73 79 73 23 73 63 ad) . (##sys#sc 0ab0: 68 65 64 75 6c 65 29 20 29 0a 0a 28 64 65 66 69 hedule) )..(defi 0ac0: 6e 65 20 28 63 6f 6e 74 69 6e 75 61 74 69 6f 6e ne (continuation 0ad0: 2d 73 75 73 70 65 6e 64 20 73 74 6f 72 65 29 0a -suspend store). 0ae0: 20 20 28 23 23 73 79 73 23 61 70 70 6c 79 2d 76 (##sys#apply-v 0af0: 61 6c 75 65 73 0a 20 20 20 28 23 23 73 79 73 23 alues. (##sys# 0b00: 63 61 6c 6c 2d 77 69 74 68 2d 64 69 72 65 63 74 call-with-direct 0b10: 2d 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 0a 20 20 -continuation. 0b20: 20 20 28 6c 61 6d 62 64 61 20 28 6b 29 0a 20 20 (lambda (k). 0b30: 20 20 20 20 28 6c 65 74 20 28 28 6f 20 28 6f 70 (let ((o (op 0b40: 65 6e 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 en-output-string 0b50: 29 29 29 0a 09 28 73 65 72 69 61 6c 69 7a 65 20 )))..(serialize 0b60: 6b 20 6f 29 0a 09 28 23 23 73 79 73 23 63 61 6c k o)..(##sys#cal 0b70: 6c 2d 77 69 74 68 2d 76 61 6c 75 65 73 20 0a 09 l-with-values .. 0b80: 20 28 6c 61 6d 62 64 61 20 28 29 20 28 73 74 6f (lambda () (sto 0b90: 72 65 20 28 67 65 74 2d 6f 75 74 70 75 74 2d 73 re (get-output-s 0ba0: 74 72 69 6e 67 20 6f 29 29 29 0a 09 20 63 6f 6e tring o))).. con 0bb0: 74 69 6e 75 61 74 69 6f 6e 2d 64 72 6f 70 29 20 tinuation-drop) 0bc0: 29 20 29 20 29 20 29 20 29 0a 0a 28 64 65 66 69 ) ) ) ) )..(defi 0bd0: 6e 65 20 28 63 6f 6e 74 69 6e 75 61 74 69 6f 6e ne (continuation 0be0: 2d 72 65 73 75 6d 65 20 6b 20 2e 20 72 65 73 75 -resume k . resu 0bf0: 6c 74 73 29 0a 20 20 28 23 23 73 79 73 23 64 69 lts). (##sys#di 0c00: 72 65 63 74 2d 72 65 74 75 72 6e 20 28 77 69 74 rect-return (wit 0c10: 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 h-input-from-str 0c20: 69 6e 67 20 6b 20 64 65 73 65 72 69 61 6c 69 7a ing k deserializ 0c30: 65 29 20 72 65 73 75 6c 74 73 29 20 29 0a e) results) ).