Artifact
c4333570bf5a4c5c05ec5fd17c4e3b37feff6b6f
File
items.scm
— part of check-in
[a1e072dbd2]
at
2011-11-20 23:13:08
on branch reorg-runs-code
— Incrementally putting stuff back in place for re-written runs.
(user:
matt
size: 4766)
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 31 2c 20 4d 61 74 74 68 65 77 06-2011, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 0a 0a 3b 3b 20 28 PURPOSE....;; (
0150: 64 65 66 69 6e 65 20 69 74 65 6d 64 61 74 20 27 define itemdat '
0160: 28 28 72 69 70 65 6e 65 73 73 20 20 20 20 22 67 ((ripeness "g
0170: 72 65 65 6e 20 72 69 70 65 20 6f 76 65 72 72 69 reen ripe overri
0180: 70 65 22 29 0a 3b 3b 20 09 09 20 20 20 20 20 28 pe").;; .. (
0190: 74 65 6d 70 65 72 61 74 75 72 65 20 22 63 6f 6f temperature "coo
01a0: 6c 20 6d 65 64 69 75 6d 20 68 6f 74 22 29 0a 3b l medium hot").;
01b0: 3b 20 09 09 20 20 20 20 20 28 73 65 61 73 6f 6e ; .. (season
01c0: 20 20 20 20 20 20 22 73 75 6d 6d 65 72 20 77 69 "summer wi
01d0: 6e 74 65 72 20 66 61 6c 6c 20 73 70 72 69 6e 67 nter fall spring
01e0: 22 29 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 ")))..(declare (
01f0: 75 6e 69 74 20 69 74 65 6d 73 29 29 0a 28 64 65 unit items)).(de
0200: 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6d 6d clare (uses comm
0210: 6f 6e 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 on))..(include "
0220: 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 common_records.s
0230: 63 6d 22 29 0a 0a 3b 3b 20 4d 6f 73 74 6c 79 20 cm")..;; Mostly
0240: 77 6f 72 6b 65 64 20 3d 20 70 75 74 73 20 6f 75 worked = puts ou
0250: 74 20 61 6c 6c 20 63 6f 6d 62 69 6e 61 74 69 6f t all combinatio
0260: 6e 73 3f 0a 28 64 65 66 69 6e 65 20 28 70 72 6f ns?.(define (pro
0270: 63 65 73 73 2d 69 74 65 6d 6c 69 73 74 2d 74 72 cess-itemlist-tr
0280: 79 31 20 63 75 72 72 69 74 65 6d 6b 65 79 20 69 y1 curritemkey i
0290: 74 65 6d 6c 69 73 74 29 0a 20 20 28 6c 65 74 20 temlist). (let
02a0: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
02b0: 69 74 65 6d 6c 69 73 74 29 29 0a 09 20 20 20 20 itemlist))..
02c0: 20 28 74 61 6c 20 28 63 64 72 20 69 74 65 6d 6c (tal (cdr iteml
02d0: 69 73 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 ist))). (if (
02e0: 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 28 66 6f 72 null? tal)..(for
02f0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 -each (lambda (i
0300: 74 65 6d 29 0a 09 09 20 20 20 20 28 64 65 62 75 tem)... (debu
0310: 67 3a 70 72 69 6e 74 20 36 20 22 63 75 72 72 69 g:print 6 "curri
0320: 74 65 6d 6b 65 79 3a 20 22 20 28 61 70 70 65 6e temkey: " (appen
0330: 64 20 63 75 72 72 69 74 65 6d 6b 65 79 20 28 6c d curritemkey (l
0340: 69 73 74 20 69 74 65 6d 29 29 29 29 0a 09 09 20 ist item))))...
0350: 20 28 63 61 64 72 20 68 65 64 29 29 0a 09 28 62 (cadr hed))..(b
0360: 65 67 69 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 egin.. (for-eac
0370: 68 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 h (lambda (item)
0380: 0a 09 09 20 20 20 20 20 20 28 70 72 6f 63 65 73 ... (proces
0390: 73 2d 69 74 65 6d 6c 69 73 74 20 28 61 70 70 65 s-itemlist (appe
03a0: 6e 64 20 63 75 72 72 69 74 65 6d 6b 65 79 20 28 nd curritemkey (
03b0: 6c 69 73 74 20 69 74 65 6d 29 29 20 74 61 6c 29 list item)) tal)
03c0: 29 0a 09 09 20 20 20 20 28 63 61 64 72 20 68 65 )... (cadr he
03d0: 64 29 29 0a 09 20 20 28 6c 6f 6f 70 20 28 63 61 d)).. (loop (ca
03e0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 r tal)(cdr tal))
03f0: 29 29 29 29 0a 0a 3b 3b 20 4d 6f 73 74 6c 79 20 ))))..;; Mostly
0400: 77 6f 72 6b 65 64 20 3d 20 70 75 74 73 20 6f 75 worked = puts ou
0410: 74 20 61 6c 6c 20 63 6f 6d 62 69 6e 61 74 69 6f t all combinatio
0420: 6e 73 3f 0a 28 64 65 66 69 6e 65 20 28 70 72 6f ns?.(define (pro
0430: 63 65 73 73 2d 69 74 65 6d 6c 69 73 74 20 68 69 cess-itemlist hi
0440: 65 72 64 65 70 74 68 20 63 75 72 72 69 74 65 6d erdepth curritem
0450: 6b 65 79 20 69 74 65 6d 6c 69 73 74 29 0a 20 20 key itemlist).
0460: 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 (let ((res '()))
0470: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 68 69 . (if (not hi
0480: 65 72 64 65 70 74 68 29 0a 09 28 73 65 74 21 20 erdepth)..(set!
0490: 68 69 65 72 64 65 70 74 68 20 28 6c 65 6e 67 74 hierdepth (lengt
04a0: 68 20 69 74 65 6d 6c 69 73 74 29 29 29 0a 20 20 h itemlist))).
04b0: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 (let loop ((he
04c0: 64 20 28 63 61 72 20 69 74 65 6d 6c 69 73 74 29 d (car itemlist)
04d0: 29 0a 09 20 20 20 20 20 20 20 28 74 61 6c 20 28 ).. (tal (
04e0: 63 64 72 20 69 74 65 6d 6c 69 73 74 29 29 29 0a cdr itemlist))).
04f0: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
0500: 20 74 61 6c 29 0a 09 20 20 28 66 6f 72 2d 65 61 tal).. (for-ea
0510: 63 68 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d ch (lambda (item
0520: 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 3e )... (if (>
0530: 20 28 6c 65 6e 67 74 68 20 63 75 72 72 69 74 65 (length currite
0540: 6d 6b 65 79 29 20 28 2d 20 68 69 65 72 64 65 70 mkey) (- hierdep
0550: 74 68 20 32 29 29 0a 09 09 09 20 20 28 73 65 74 th 2)).... (set
0560: 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ! res (append re
0570: 73 20 28 6c 69 73 74 20 28 61 70 70 65 6e 64 20 s (list (append
0580: 63 75 72 72 69 74 65 6d 6b 65 79 20 28 6c 69 73 curritemkey (lis
0590: 74 20 28 6c 69 73 74 20 28 63 61 72 20 68 65 64 t (list (car hed
05a0: 29 20 69 74 65 6d 29 29 29 29 29 29 29 29 0a 09 ) item))))))))..
05b0: 09 20 20 20 20 28 63 61 64 72 20 68 65 64 29 29 . (cadr hed))
05c0: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
05d0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
05e0: 61 20 28 69 74 65 6d 29 0a 09 09 09 28 73 65 74 a (item)....(set
05f0: 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ! res (append re
0600: 73 20 28 70 72 6f 63 65 73 73 2d 69 74 65 6d 6c s (process-iteml
0610: 69 73 74 20 68 69 65 72 64 65 70 74 68 20 28 61 ist hierdepth (a
0620: 70 70 65 6e 64 20 63 75 72 72 69 74 65 6d 6b 65 ppend curritemke
0630: 79 20 28 6c 69 73 74 20 28 6c 69 73 74 20 28 63 y (list (list (c
0640: 61 72 20 68 65 64 29 20 69 74 65 6d 29 29 29 20 ar hed) item)))
0650: 74 61 6c 29 29 29 29 0a 09 09 20 20 20 20 20 20 tal))))...
0660: 28 63 61 64 72 20 68 65 64 29 29 0a 09 20 20 20 (cadr hed))..
0670: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
0680: 28 63 64 72 20 74 61 6c 29 29 29 29 29 0a 20 20 (cdr tal))))).
0690: 20 20 72 65 73 29 29 0a 0a 3b 3b 20 28 69 74 65 res))..;; (ite
06a0: 6d 2d 61 73 73 6f 63 2d 3e 69 74 65 6d 2d 6c 69 m-assoc->item-li
06b0: 73 74 20 27 28 28 22 41 4e 49 4d 41 4c 22 20 22 st '(("ANIMAL" "
06c0: 45 6c 65 70 68 61 6e 74 20 4c 69 6f 6e 22 29 28 Elephant Lion")(
06d0: 22 53 45 41 53 4f 4e 22 20 22 53 70 72 69 6e 67 "SEASON" "Spring
06e0: 20 46 61 6c 6c 22 29 29 29 0a 3b 3b 20 20 20 3d Fall"))).;; =
06f0: 3e 20 28 28 28 22 41 4e 49 4d 41 4c 22 20 22 45 > ((("ANIMAL" "E
0700: 6c 65 70 68 61 6e 74 22 29 20 28 22 53 45 41 53 lephant") ("SEAS
0710: 4f 4e 22 20 22 53 70 72 69 6e 67 22 29 29 20 0a ON" "Spring")) .
0720: 3b 3b 20 20 20 20 20 20 20 28 28 22 41 4e 49 4d ;; (("ANIM
0730: 41 4c 22 20 22 45 6c 65 70 68 61 6e 74 22 29 20 AL" "Elephant")
0740: 28 22 53 45 41 53 4f 4e 22 20 22 46 61 6c 6c 22 ("SEASON" "Fall"
0750: 29 29 20 0a 3b 3b 20 20 20 20 20 20 20 28 28 22 )) .;; (("
0760: 41 4e 49 4d 41 4c 22 20 22 4c 69 6f 6e 22 29 20 ANIMAL" "Lion")
0770: 20 20 20 20 28 22 53 45 41 53 4f 4e 22 20 22 53 ("SEASON" "S
0780: 70 72 69 6e 67 22 29 29 0a 3b 3b 20 20 20 20 20 pring")).;;
0790: 20 20 28 28 22 41 4e 49 4d 41 4c 22 20 22 4c 69 (("ANIMAL" "Li
07a0: 6f 6e 22 29 20 20 20 20 20 28 22 53 45 41 53 4f on") ("SEASO
07b0: 4e 22 20 22 46 61 6c 6c 22 29 29 29 0a 28 64 65 N" "Fall"))).(de
07c0: 66 69 6e 65 20 28 69 74 65 6d 2d 61 73 73 6f 63 fine (item-assoc
07d0: 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 69 74 65 6d ->item-list item
07e0: 73 64 61 74 29 0a 20 20 28 69 66 20 28 61 6e 64 sdat). (if (and
07f0: 20 69 74 65 6d 73 64 61 74 20 28 6e 6f 74 20 28 itemsdat (not (
0800: 6e 75 6c 6c 3f 20 69 74 65 6d 73 64 61 74 29 29 null? itemsdat))
0810: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 ). (let ((i
0820: 74 65 6d 6c 73 74 20 28 66 69 6c 74 65 72 20 28 temlst (filter (
0830: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 lambda (x)....
0840: 20 20 20 20 20 28 6c 69 73 74 3f 20 78 29 29 0a (list? x)).
0850: 09 09 09 20 20 20 20 20 28 6d 61 70 20 28 6c 61 ... (map (la
0860: 6d 62 64 61 20 28 78 29 0a 09 09 09 09 20 20 20 mbda (x).....
0870: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 (debug:print 6
0880: 22 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 74 65 "item-assoc->ite
0890: 6d 2d 6c 69 73 74 20 78 3a 20 22 20 78 29 0a 09 m-list x: " x)..
08a0: 09 09 09 20 20 20 20 28 69 66 20 28 3c 20 28 6c ... (if (< (l
08b0: 65 6e 67 74 68 20 78 29 20 32 29 0a 09 09 09 09 ength x) 2).....
08c0: 09 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 28 .(begin...... (
08d0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
08e0: 52 52 4f 52 3a 20 6d 61 6c 66 6f 72 6d 65 64 20 RROR: malformed
08f0: 69 74 65 6d 73 20 73 70 65 63 20 22 20 28 73 74 items spec " (st
0900: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
0910: 20 78 20 22 20 22 29 29 0a 09 09 09 09 09 20 20 x " "))......
0920: 28 6c 69 73 74 20 28 63 61 72 20 78 29 27 28 29 (list (car x)'()
0930: 29 29 0a 09 09 09 09 09 28 6c 65 74 20 28 28 6e ))......(let ((n
0940: 61 6d 65 20 28 63 61 72 20 78 29 29 0a 09 09 09 ame (car x))....
0950: 09 09 20 20 20 20 20 20 28 69 74 65 6d 73 20 28 .. (items (
0960: 63 61 64 72 20 78 29 29 29 0a 09 09 09 09 09 20 cadr x)))......
0970: 20 28 6c 69 73 74 20 6e 61 6d 65 20 28 73 74 72 (list name (str
0980: 69 6e 67 2d 73 70 6c 69 74 20 69 74 65 6d 73 29 ing-split items)
0990: 29 29 29 29 0a 09 09 09 09 20 20 69 74 65 6d 73 ))))..... items
09a0: 64 61 74 29 29 29 29 0a 09 28 6c 65 74 20 28 28 dat))))..(let ((
09b0: 64 65 62 75 67 6c 65 76 65 6c 20 35 29 29 0a 09 debuglevel 5))..
09c0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 35 (debug:print 5
09d0: 20 22 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 74 "item-assoc->it
09e0: 65 6d 2d 6c 69 73 74 3a 20 69 74 65 6d 73 64 61 em-list: itemsda
09f0: 74 20 3d 3e 20 69 74 65 6d 6c 73 74 20 22 29 0a t => itemlst ").
0a00: 09 20 20 28 69 66 20 28 3e 3d 20 2a 76 65 72 62 . (if (>= *verb
0a10: 6f 73 69 74 79 2a 20 35 29 0a 09 20 20 20 20 20 osity* 5)..
0a20: 20 28 62 65 67 69 6e 0a 09 09 28 70 70 20 69 74 (begin...(pp it
0a30: 65 6d 73 64 61 74 29 0a 09 09 28 70 72 69 6e 74 emsdat)...(print
0a40: 20 22 20 3d 3e 20 22 29 0a 09 09 28 70 70 20 69 " => ")...(pp i
0a50: 74 65 6d 6c 73 74 29 29 29 29 0a 09 28 69 66 20 temlst))))..(if
0a60: 28 3e 20 28 6c 65 6e 67 74 68 20 69 74 65 6d 6c (> (length iteml
0a70: 73 74 29 20 30 29 0a 09 20 20 20 20 28 70 72 6f st) 0).. (pro
0a80: 63 65 73 73 2d 69 74 65 6d 6c 69 73 74 20 23 66 cess-itemlist #f
0a90: 20 27 28 29 20 69 74 65 6d 6c 73 74 29 0a 09 20 '() itemlst)..
0aa0: 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 27 '())). '
0ab0: 28 29 29 29 20 3b 3b 20 72 65 74 75 72 6e 20 61 ())) ;; return a
0ac0: 20 6c 69 73 74 20 63 6f 6e 73 69 73 74 69 6e 67 list consisting
0ad0: 20 6f 6e 20 61 20 73 69 6e 67 6c 65 20 6e 75 6c on a single nul
0ae0: 6c 20 6c 69 73 74 20 66 6f 72 20 6e 6f 6e 2d 69 l list for non-i
0af0: 74 65 6d 20 72 75 6e 73 0a 20 20 20 20 20 20 20 tem runs.
0b00: 20 20 20 20 20 3b 3b 20 4e 6f 70 65 2c 20 6e 6f ;; Nope, no
0b10: 74 20 6e 6f 77 2c 20 72 65 74 75 72 6e 20 6e 75 t now, return nu
0b20: 6c 6c 20 61 73 20 6f 66 20 36 2f 36 2f 32 30 31 ll as of 6/6/201
0b30: 31 0a 0a 3b 3b 20 28 69 74 65 6d 2d 74 61 62 6c 1..;; (item-tabl
0b40: 65 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 27 28 28 e->item-list '((
0b50: 22 41 4e 49 4d 41 4c 22 20 22 45 6c 65 70 68 61 "ANIMAL" "Elepha
0b60: 6e 74 20 4c 69 6f 6e 22 29 28 22 53 45 41 53 4f nt Lion")("SEASO
0b70: 4e 22 20 22 53 70 72 69 6e 67 20 57 69 6e 74 65 N" "Spring Winte
0b80: 72 22 29 29 29 0a 3b 3b 20 20 20 3d 3e 20 28 28 r"))).;; => ((
0b90: 28 22 41 4e 49 4d 41 4c 22 20 22 45 6c 65 70 68 ("ANIMAL" "Eleph
0ba0: 61 6e 74 22 29 28 22 53 45 41 53 4f 4e 22 20 22 ant")("SEASON" "
0bb0: 53 70 72 69 6e 67 22 29 29 0a 3b 3b 20 20 20 20 Spring")).;;
0bc0: 20 20 20 28 28 22 41 4e 49 4d 41 4c 22 20 22 4c (("ANIMAL" "L
0bd0: 69 6f 6e 22 29 20 20 20 20 28 22 53 45 41 53 4f ion") ("SEASO
0be0: 4e 22 20 22 57 69 6e 74 65 72 22 29 29 29 0a 28 N" "Winter"))).(
0bf0: 64 65 66 69 6e 65 20 28 69 74 65 6d 2d 74 61 62 define (item-tab
0c00: 6c 65 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 69 74 le->item-list it
0c10: 65 6d 74 61 62 6c 65 29 0a 20 20 28 6c 65 74 20 emtable). (let
0c20: 28 28 6e 65 77 6c 73 74 20 28 6d 61 70 20 28 6c ((newlst (map (l
0c30: 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 ambda (x)...
0c40: 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
0c50: 68 20 78 29 20 31 29 0a 09 09 09 20 20 20 28 6c h x) 1).... (l
0c60: 69 73 74 20 28 63 61 72 20 78 29 0a 09 09 09 09 ist (car x).....
0c70: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 (string-split (
0c80: 63 61 64 72 20 78 29 29 29 0a 09 09 09 20 20 20 cadr x)))....
0c90: 28 6c 69 73 74 20 78 20 27 28 29 29 29 29 0a 09 (list x '())))..
0ca0: 09 20 20 20 20 20 69 74 65 6d 74 61 62 6c 65 29 . itemtable)
0cb0: 29 0a 09 28 72 65 73 20 20 20 20 20 27 28 29 29 )..(res '())
0cc0: 29 20 3b 3b 20 61 20 6c 69 73 74 20 6f 66 20 69 ) ;; a list of i
0cd0: 74 65 6d 73 0a 20 20 20 20 28 6c 65 74 20 6c 6f tems. (let lo
0ce0: 6f 70 20 28 28 69 6e 64 78 20 20 20 20 30 29 0a op ((indx 0).
0cf0: 09 20 20 20 20 20 20 20 28 69 74 65 6d 20 20 20 . (item
0d00: 27 28 29 29 20 3b 3b 20 61 6e 20 69 74 65 6d 20 '()) ;; an item
0d10: 77 69 6c 6c 20 62 65 20 28 28 4b 45 59 4e 41 4d will be ((KEYNAM
0d20: 45 31 20 56 41 4c 31 29 28 4b 45 59 4e 41 4d 45 E1 VAL1)(KEYNAME
0d30: 32 20 56 41 4c 32 29 20 2e 2e 2e 29 0a 09 20 20 2 VAL2) ...)..
0d40: 20 20 20 20 20 28 65 6c 66 6c 61 67 20 20 23 66 (elflag #f
0d50: 29 29 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 )). (for-ea
0d60: 63 68 20 28 6c 61 6d 62 64 61 20 28 72 6f 77 29 ch (lambda (row)
0d70: 0a 09 09 20 20 28 6c 65 74 20 28 28 72 6f 77 6e ... (let ((rown
0d80: 61 6d 65 20 28 63 61 72 20 72 6f 77 29 29 0a 09 ame (car row))..
0d90: 09 09 28 72 6f 77 64 61 74 20 20 28 63 61 64 72 ..(rowdat (cadr
0da0: 20 72 6f 77 29 29 29 0a 09 09 20 20 20 20 28 73 row)))... (s
0db0: 65 74 21 20 69 74 65 6d 20 28 61 70 70 65 6e 64 et! item (append
0dc0: 20 69 74 65 6d 20 0a 09 09 09 09 20 20 20 20 20 item .....
0dd0: 20 20 28 6c 69 73 74 20 0a 09 09 09 09 09 28 69 (list ......(i
0de0: 66 20 28 3c 20 69 6e 64 78 20 28 6c 65 6e 67 74 f (< indx (lengt
0df0: 68 20 72 6f 77 64 61 74 29 29 0a 09 09 09 09 09 h rowdat))......
0e00: 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 20 28 (let ((new (
0e10: 6c 69 73 74 20 72 6f 77 6e 61 6d 65 20 28 6c 69 list rowname (li
0e20: 73 74 2d 72 65 66 20 72 6f 77 64 61 74 20 69 6e st-ref rowdat in
0e30: 64 78 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 dx))))......
0e40: 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e ;; (debug:prin
0e50: 74 20 30 20 22 4e 65 77 3a 20 22 20 6e 65 77 29 t 0 "New: " new)
0e60: 0a 09 09 09 09 09 20 20 20 20 20 20 28 73 65 74 ...... (set
0e70: 21 20 65 6c 66 6c 61 67 20 23 74 29 0a 09 09 09 ! elflag #t)....
0e80: 09 09 20 20 20 20 20 20 6e 65 77 0a 09 09 09 09 .. new.....
0e90: 09 20 20 20 20 20 20 29 20 3b 3b 20 69 2e 65 2e . ) ;; i.e.
0ea0: 20 68 61 64 20 61 74 20 6c 65 61 73 74 20 6f 6e had at least on
0eb0: 20 6c 65 67 69 74 20 76 61 6c 75 65 20 74 6f 20 legit value to
0ec0: 75 73 65 0a 09 09 09 09 09 20 20 20 20 28 6c 69 use...... (li
0ed0: 73 74 20 72 6f 77 6e 61 6d 65 20 22 2d 22 29 29 st rowname "-"))
0ee0: 29 29 29 29 29 0a 09 09 6e 65 77 6c 73 74 29 0a )))))...newlst).
0ef0: 20 20 20 20 20 20 28 69 66 20 65 6c 66 6c 61 67 (if elflag
0f00: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
0f10: 28 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e (set! res (appen
0f20: 64 20 72 65 73 20 28 6c 69 73 74 20 69 74 65 6d d res (list item
0f30: 29 29 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 28 ))).. (loop (
0f40: 2b 20 69 6e 64 78 20 31 29 0a 09 09 20 20 27 28 + indx 1)... '(
0f50: 29 0a 09 09 20 20 23 66 29 29 29 0a 20 20 20 20 )... #f))).
0f60: 20 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 res))).
0f70: 20 20 20 20 20 3b 3b 20 4e 6f 70 65 2c 20 6e 6f ;; Nope, no
0f80: 74 20 6e 6f 77 2c 20 72 65 74 75 72 6e 20 6e 75 t now, return nu
0f90: 6c 6c 20 61 73 20 6f 66 20 36 2f 36 2f 32 30 31 ll as of 6/6/201
0fa0: 31 0a 09 09 0a 28 64 65 66 69 6e 65 20 28 63 68 1....(define (ch
0fb0: 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 eck-valid-items
0fc0: 63 6c 61 73 73 20 69 74 65 6d 29 0a 20 20 28 6c class item). (l
0fd0: 65 74 20 28 28 76 61 6c 69 64 2d 76 61 6c 75 65 et ((valid-value
0fe0: 73 20 28 6c 65 74 20 28 28 73 20 28 63 6f 6e 66 s (let ((s (conf
0ff0: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
1000: 67 64 61 74 2a 20 22 76 61 6c 69 64 76 61 6c 75 gdat* "validvalu
1010: 65 73 22 20 63 6c 61 73 73 29 29 29 0a 09 09 09 es" class)))....
1020: 28 69 66 20 73 20 28 73 74 72 69 6e 67 2d 73 70 (if s (string-sp
1030: 6c 69 74 20 73 29 20 23 66 29 29 29 29 0a 20 20 lit s) #f)))).
1040: 20 20 28 69 66 20 76 61 6c 69 64 2d 76 61 6c 75 (if valid-valu
1050: 65 73 0a 09 28 69 66 20 28 6d 65 6d 62 65 72 20 es..(if (member
1060: 69 74 65 6d 20 76 61 6c 69 64 2d 76 61 6c 75 65 item valid-value
1070: 73 29 0a 09 20 20 20 20 69 74 65 6d 20 23 66 29 s).. item #f)
1080: 0a 09 69 74 65 6d 29 29 29 0a 0a 28 64 65 66 69 ..item)))..(defi
1090: 6e 65 20 28 69 74 65 6d 73 3a 67 65 74 2d 69 74 ne (items:get-it
10a0: 65 6d 73 2d 66 72 6f 6d 2d 63 6f 6e 66 69 67 20 ems-from-config
10b0: 74 63 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a tconfig). (let*
10c0: 20 28 3b 3b 20 64 62 20 69 73 20 61 6c 77 61 79 (;; db is alway
10d0: 73 20 61 74 20 2a 74 6f 70 70 61 74 68 2a 2f 64 s at *toppath*/d
10e0: 62 2f 6d 65 67 61 74 65 73 74 2e 64 62 0a 09 20 b/megatest.db..
10f0: 28 69 74 65 6d 73 20 20 20 20 20 20 20 28 68 61 (items (ha
1100: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
1110: 61 75 6c 74 20 74 63 6f 6e 66 69 67 20 22 69 74 ault tconfig "it
1120: 65 6d 73 22 20 27 28 29 29 29 0a 09 20 28 69 74 ems" '())).. (it
1130: 65 6d 73 74 61 62 6c 65 20 20 28 68 61 73 68 2d emstable (hash-
1140: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
1150: 74 20 74 63 6f 6e 66 69 67 20 22 69 74 65 6d 73 t tconfig "items
1160: 74 61 62 6c 65 22 20 27 28 29 29 29 29 0a 20 20 table" '()))).
1170: 20 20 28 69 66 20 28 70 72 6f 63 65 64 75 72 65 (if (procedure
1180: 3f 20 69 74 65 6d 73 29 0a 09 28 73 65 74 21 20 ? items)..(set!
1190: 69 74 65 6d 73 20 28 69 74 65 6d 73 29 29 29 0a items (items))).
11a0: 20 20 20 20 28 69 66 20 28 70 72 6f 63 65 64 75 (if (procedu
11b0: 72 65 3f 20 69 74 65 6d 73 74 61 62 6c 65 29 0a re? itemstable).
11c0: 09 28 73 65 74 21 20 69 74 65 6d 73 74 61 62 6c .(set! itemstabl
11d0: 65 20 28 69 74 65 6d 73 74 61 62 6c 65 29 29 29 e (itemstable)))
11e0: 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f . (if (or (no
11f0: 74 20 28 6e 75 6c 6c 3f 20 69 74 65 6d 73 29 29 t (null? items))
1200: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 69 74 65 6d (not (null? item
1210: 73 74 61 62 6c 65 29 29 29 0a 09 28 61 70 70 65 stable)))..(appe
1220: 6e 64 20 28 69 74 65 6d 2d 61 73 73 6f 63 2d 3e nd (item-assoc->
1230: 69 74 65 6d 2d 6c 69 73 74 20 69 74 65 6d 73 29 item-list items)
1240: 0a 09 09 28 69 74 65 6d 2d 74 61 62 6c 65 2d 3e ...(item-table->
1250: 69 74 65 6d 2d 6c 69 73 74 20 69 74 65 6d 73 74 item-list itemst
1260: 61 62 6c 65 29 29 0a 09 27 28 28 29 29 29 29 29 able))..'(()))))
1270: 0a 0a 3b 3b 20 28 70 70 20 28 69 74 65 6d 2d 61 ..;; (pp (item-a
1280: 73 73 6f 63 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 ssoc->item-list
1290: 69 74 65 6d 64 61 74 29 29 0a 0a 0a 09 0a itemdat)).....