Artifact
4ca4bad73e1835085ba7304ad3f2d7e9687fef1c:
0000: 3b 3b 3b 3b 20 69 74 65 6d 73 2e 69 6d 70 6f 72 ;;;; items.impor
0010: 74 2e 73 63 6d 20 2d 20 47 45 4e 45 52 41 54 45 t.scm - GENERATE
0020: 44 20 42 59 20 43 48 49 43 4b 45 4e 20 34 2e 31 D BY CHICKEN 4.1
0030: 33 2e 30 20 2d 2a 2d 20 53 63 68 65 6d 65 20 2d 3.0 -*- Scheme -
0040: 2a 2d 0a 0a 28 65 76 61 6c 20 27 28 69 6d 70 6f *-..(eval '(impo
0050: 72 74 0a 20 20 20 20 20 20 20 20 20 73 63 68 65 rt. sche
0060: 6d 65 0a 20 20 20 20 20 20 20 20 20 63 68 69 63 me. chic
0070: 6b 65 6e 0a 20 20 20 20 20 20 20 20 20 64 61 74 ken. dat
0080: 61 2d 73 74 72 75 63 74 75 72 65 73 0a 20 20 20 a-structures.
0090: 20 20 20 20 20 20 65 78 74 72 61 73 0a 20 20 20 extras.
00a0: 20 20 20 20 20 20 70 6f 72 74 73 0a 20 20 20 20 ports.
00b0: 20 20 20 20 20 63 6f 6d 6d 6f 6e 6d 6f 64 0a 20 commonmod.
00c0: 20 20 20 20 20 20 20 20 64 65 62 75 67 70 72 69 debugpri
00d0: 6e 74 0a 20 20 20 20 20 20 20 20 20 63 6f 6e 66 nt. conf
00e0: 69 67 66 6d 6f 64 0a 20 20 20 20 20 20 20 20 20 igfmod.
00f0: 73 72 66 69 2d 36 39 0a 20 20 20 20 20 20 20 20 srfi-69.
0100: 20 73 72 66 69 2d 31 0a 20 20 20 20 20 20 20 20 srfi-1.
0110: 20 70 6f 73 74 67 72 65 73 71 6c 29 29 0a 28 23 postgresql)).(#
0120: 23 73 79 73 23 72 65 67 69 73 74 65 72 2d 63 6f #sys#register-co
0130: 6d 70 69 6c 65 64 2d 6d 6f 64 75 6c 65 0a 20 20 mpiled-module.
0140: 27 69 74 65 6d 73 0a 20 20 28 6c 69 73 74 29 0a 'items. (list).
0150: 20 20 27 28 28 69 74 65 6d 73 3a 67 65 74 2d 69 '((items:get-i
0160: 74 65 6d 73 2d 66 72 6f 6d 2d 63 6f 6e 66 69 67 tems-from-config
0170: 20 2e 20 69 74 65 6d 73 23 69 74 65 6d 73 3a 67 . items#items:g
0180: 65 74 2d 69 74 65 6d 73 2d 66 72 6f 6d 2d 63 6f et-items-from-co
0190: 6e 66 69 67 29 0a 20 20 20 20 28 69 74 65 6d 73 nfig). (items
01a0: 3a 72 65 61 64 2d 69 74 65 6d 73 2d 66 69 6c 65 :read-items-file
01b0: 20 2e 20 69 74 65 6d 73 23 69 74 65 6d 73 3a 72 . items#items:r
01c0: 65 61 64 2d 69 74 65 6d 73 2d 66 69 6c 65 29 0a ead-items-file).
01d0: 20 20 20 20 28 69 74 65 6d 73 3a 66 69 72 73 74 (items:first
01e0: 2d 72 6f 77 2d 69 6e 74 65 72 73 70 65 72 73 65 -row-intersperse
01f0: 20 2e 20 69 74 65 6d 73 23 69 74 65 6d 73 3a 66 . items#items:f
0200: 69 72 73 74 2d 72 6f 77 2d 69 6e 74 65 72 73 70 irst-row-intersp
0210: 65 72 73 65 29 0a 20 20 20 20 28 69 74 65 6d 73 erse). (items
0220: 3a 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 :check-valid-ite
0230: 6d 73 20 2e 20 69 74 65 6d 73 23 69 74 65 6d 73 ms . items#items
0240: 3a 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 :check-valid-ite
0250: 6d 73 29 0a 20 20 20 20 28 69 74 65 6d 2d 74 61 ms). (item-ta
0260: 62 6c 65 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 2e ble->item-list .
0270: 20 69 74 65 6d 73 23 69 74 65 6d 2d 74 61 62 6c items#item-tabl
0280: 65 2d 3e 69 74 65 6d 2d 6c 69 73 74 29 0a 20 20 e->item-list).
0290: 20 20 28 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 (item-assoc->i
02a0: 74 65 6d 2d 6c 69 73 74 20 2e 20 69 74 65 6d 73 tem-list . items
02b0: 23 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 74 65 #item-assoc->ite
02c0: 6d 2d 6c 69 73 74 29 0a 20 20 20 20 28 70 72 6f m-list). (pro
02d0: 63 65 73 73 2d 69 74 65 6d 6c 69 73 74 20 2e 20 cess-itemlist .
02e0: 69 74 65 6d 73 23 70 72 6f 63 65 73 73 2d 69 74 items#process-it
02f0: 65 6d 6c 69 73 74 29 0a 20 20 20 20 28 2a 61 76 emlist). (*av
0300: 61 69 6c 61 62 6c 65 2d 64 62 2a 20 2e 20 63 6f ailable-db* . co
0310: 6d 6d 6f 6e 6d 6f 64 23 2a 61 76 61 69 6c 61 62 mmonmod#*availab
0320: 6c 65 2d 64 62 2a 29 29 0a 20 20 28 6c 69 73 74 le-db*)). (list
0330: 20 28 63 6f 6e 73 20 27 64 65 62 75 67 3a 63 61 (cons 'debug:ca
0340: 74 63 68 2d 61 6e 64 2d 64 75 6d 70 0a 20 20 20 tch-and-dump.
0350: 20 20 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 (synt
0360: 61 78 2d 72 75 6c 65 73 0a 20 20 20 20 20 20 20 ax-rules.
0370: 20 20 20 20 20 20 20 20 20 28 29 0a 20 20 20 20 ().
0380: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 64 65 ((de
0390: 62 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64 75 bug:catch-and-du
03a0: 6d 70 20 70 72 6f 63 20 70 72 6f 63 6e 61 6d 65 mp proc procname
03b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
03c0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
03d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 61 (ha
03e0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
03f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0400: 20 20 20 20 20 65 78 6e 0a 20 20 20 20 20 20 20 exn.
0410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
0420: 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 egin.
0430: 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 (pri
0440: 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 nt-call-chain (c
0450: 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 urrent-error-por
0460: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
0470: 20 20 20 20 20 20 20 20 20 20 20 28 77 69 74 68 (with
0480: 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 0a -output-to-port.
0490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04a0: 20 20 20 20 20 20 20 20 20 28 63 75 72 72 65 6e (curren
04b0: 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 0a 20 20 t-error-port).
04c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04d0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
04e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
04f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 (pr
0500: 69 6e 74 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d int ((condition-
0510: 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f property-accesso
0520: 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 r 'exn 'message)
0530: 20 65 78 6e 29 29 0a 20 20 20 20 20 20 20 20 20 exn)).
0540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0550: 20 20 28 70 72 69 6e 74 20 22 43 61 6c 6c 62 61 (print "Callba
0560: 63 6b 20 65 72 72 6f 72 20 69 6e 20 22 20 70 72 ck error in " pr
0570: 6f 63 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 ocname).
0580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0590: 20 20 20 28 70 72 69 6e 74 20 22 46 75 6c 6c 20 (print "Full
05a0: 63 6f 6e 64 69 74 69 6f 6e 20 69 6e 66 6f 3a 5c condition info:\
05b0: 6e 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n".
05c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05d0: 20 20 20 20 20 28 63 6f 6e 64 69 74 69 6f 6e 2d (condition-
05e0: 3e 6c 69 73 74 20 65 78 6e 29 29 29 29 29 0a 20 >list exn))))).
05f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0600: 20 20 20 20 28 70 72 6f 63 29 29 29 29 29 29 0a (proc)))))).
0610: 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 27 63 (cons 'c
0620: 6f 6d 6d 6f 6e 3a 68 61 6e 64 6c 65 2d 65 78 63 ommon:handle-exc
0630: 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 20 20 20 eptions.
0640: 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75 (syntax-ru
0650: 6c 65 73 20 28 29 20 28 28 5f 20 65 78 6e 20 65 les () ((_ exn e
0660: 72 72 73 74 6d 74 20 62 6f 64 79 20 2e 2e 2e 29 rrstmt body ...)
0670: 20 28 62 65 67 69 6e 20 62 6f 64 79 20 2e 2e 2e (begin body ...
0680: 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 63 6f )))). (co
0690: 6e 73 20 27 63 6f 6d 6d 6f 6e 3a 64 65 62 75 67 ns 'common:debug
06a0: 2d 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f -handle-exceptio
06b0: 6e 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ns.
06c0: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 0a 20 (syntax-rules.
06d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
06e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
06f0: 20 20 28 28 5f 20 64 65 62 75 67 20 65 78 6e 20 ((_ debug exn
0700: 65 72 72 73 74 6d 74 20 62 6f 64 79 20 2e 2e 2e errstmt body ...
0710: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0720: 20 20 20 28 69 66 20 64 65 62 75 67 0a 20 20 20 (if debug.
0730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0740: 28 62 65 67 69 6e 20 62 6f 64 79 20 2e 2e 2e 29 (begin body ...)
0750: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0760: 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 (handle-exce
0770: 70 74 69 6f 6e 73 20 65 78 6e 20 65 72 72 73 74 ptions exn errst
0780: 6d 74 20 62 6f 64 79 20 2e 2e 2e 29 29 29 29 29 mt body ...)))))
0790: 0a 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 27 . (cons '
07a0: 64 65 66 69 6e 65 2d 73 69 6d 70 6c 65 2d 73 79 define-simple-sy
07b0: 6e 74 61 78 0a 20 20 20 20 20 20 20 20 20 20 20 ntax.
07c0: 20 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 (syntax-rules
07d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
07e0: 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ().
07f0: 20 20 20 20 28 28 5f 20 28 6e 61 6d 65 20 61 72 ((_ (name ar
0800: 67 20 2e 2e 2e 29 20 62 6f 64 79 20 2e 2e 2e 29 g ...) body ...)
0810: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0820: 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 (define-syntax
0830: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0840: 20 20 20 20 6e 61 6d 65 0a 20 20 20 20 20 20 20 name.
0850: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 79 6e (syn
0860: 74 61 78 2d 72 75 6c 65 73 20 28 29 20 28 28 6e tax-rules () ((n
0870: 61 6d 65 20 61 72 67 20 2e 2e 2e 29 20 28 62 65 ame arg ...) (be
0880: 67 69 6e 20 62 6f 64 79 20 2e 2e 2e 29 29 29 29 gin body ...))))
0890: 29 29 29 29 0a 20 20 28 6c 69 73 74 29 29 0a 0a )))). (list))..
08a0: 3b 3b 20 45 4e 44 20 4f 46 20 46 49 4c 45 0a ;; END OF FILE.