Artifact
dcf82d5ea04c6f9d74c4afca15a759e7827fdab3:
0000: 0a 28 75 73 65 20 6a 73 6f 6e 29 0a 28 75 73 65 .(use json).(use
0010: 20 64 75 63 74 74 61 70 65 2d 6c 69 62 29 0a 0a ducttape-lib)..
0020: 28 64 65 66 69 6e 65 20 28 67 65 74 2d 6c 61 73 (define (get-las
0030: 74 2d 72 75 6e 6e 61 6d 65 20 61 72 65 61 2d 70 t-runname area-p
0040: 61 74 68 20 74 61 72 67 65 74 29 0a 20 20 28 6c ath target). (l
0050: 65 74 2a 20 28 28 72 75 6e 2d 64 61 74 61 20 20 et* ((run-data
0060: 20 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 (with-input-f
0070: 72 6f 6d 2d 70 69 70 65 20 28 63 6f 6e 63 20 22 rom-pipe (conc "
0080: 6d 65 67 61 74 65 73 74 20 2d 6c 69 73 74 2d 72 megatest -list-r
0090: 75 6e 73 20 25 20 2d 74 61 72 67 65 74 20 22 20 uns % -target "
00a0: 74 61 72 67 65 74 20 22 20 2d 66 69 65 6c 64 73 target " -fields
00b0: 20 72 75 6e 73 3a 72 75 6e 6e 61 6d 65 2c 65 76 runs:runname,ev
00c0: 65 6e 74 5f 74 69 6d 65 20 2d 64 75 6d 70 6d 6f ent_time -dumpmo
00d0: 64 65 20 73 65 78 70 72 20 2d 73 74 61 72 74 2d de sexpr -start-
00e0: 64 69 72 20 22 20 61 72 65 61 2d 70 61 74 68 29 dir " area-path)
00f0: 0a 09 09 09 20 72 65 61 64 29 29 29 0a 20 20 20 .... read))).
0100: 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 72 75 (if (or (not ru
0110: 6e 2d 64 61 74 61 29 0a 09 20 20 20 20 28 6e 75 n-data).. (nu
0120: 6c 6c 3f 20 72 75 6e 2d 64 61 74 61 29 29 0a 09 ll? run-data))..
0130: 23 66 0a 09 28 6c 65 74 2a 20 28 28 6e 61 6d 65 #f..(let* ((name
0140: 2d 74 69 6d 65 20 20 20 20 28 6c 65 74 20 28 28 -time (let ((
0150: 64 61 74 20 28 6d 61 70 20 63 64 61 64 72 20 28 dat (map cdadr (
0160: 61 6c 69 73 74 2d 72 65 66 20 74 61 72 67 65 74 alist-ref target
0170: 20 72 75 6e 2d 64 61 74 61 20 65 71 75 61 6c 3f run-data equal?
0180: 29 29 29 29 20 3b 3b 20 28 28 22 72 75 6e 6e 61 )))) ;; (("runna
0190: 6d 65 22 20 2e 20 22 32 30 31 37 77 30 37 2e 30 me" . "2017w07.0
01a0: 2d 30 30 34 37 22 29 20 28 22 65 76 65 6e 74 5f -0047") ("event_
01b0: 74 69 6d 65 22 20 2e 20 22 31 34 38 37 34 39 30 time" . "1487490
01c0: 34 32 34 22 29 29 0a 09 09 09 20 20 20 20 20 20 424"))....
01d0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 64 61 74 3d ;; (print "dat=
01e0: 22 20 64 61 74 29 0a 09 09 09 20 20 20 20 20 20 " dat)....
01f0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 69 (map (lambda (i
0200: 74 65 6d 29 0a 09 09 09 09 20 20 20 20 20 20 28 tem)..... (
0210: 63 6f 6e 73 20 28 61 6c 69 73 74 2d 72 65 66 20 cons (alist-ref
0220: 22 72 75 6e 6e 61 6d 65 22 20 69 74 65 6d 20 65 "runname" item e
0230: 71 75 61 6c 3f 29 0a 09 09 09 09 09 20 20 20 20 qual?)......
0240: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
0250: 28 61 6c 69 73 74 2d 72 65 66 20 22 65 76 65 6e (alist-ref "even
0260: 74 5f 74 69 6d 65 22 20 69 74 65 6d 20 65 71 75 t_time" item equ
0270: 61 6c 3f 29 29 29 29 0a 09 09 09 09 20 20 20 20 al?)))).....
0280: 64 61 74 29 29 29 0a 09 20 20 20 20 20 20 20 28 dat))).. (
0290: 73 6f 72 74 65 64 20 20 20 20 20 20 20 28 73 6f sorted (so
02a0: 72 74 20 6e 61 6d 65 2d 74 69 6d 65 20 28 6c 61 rt name-time (la
02b0: 6d 62 64 61 20 28 61 20 62 29 28 3e 20 28 63 64 mbda (a b)(> (cd
02c0: 72 20 61 29 28 63 64 72 20 62 29 29 29 29 29 0a r a)(cdr b))))).
02d0: 09 20 20 20 20 20 20 20 28 6c 61 73 74 2d 6e 61 . (last-na
02e0: 6d 65 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f me (if (null?
02f0: 20 73 6f 72 74 65 64 29 0a 09 09 09 09 20 23 66 sorted)..... #f
0300: 0a 09 09 09 09 20 28 63 61 61 72 20 73 6f 72 74 ..... (caar sort
0310: 65 64 29 29 29 29 0a 09 20 20 6c 61 73 74 2d 6e ed)))).. last-n
0320: 61 6d 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 ame))))..(define
0330: 20 28 73 74 72 2d 66 69 72 73 74 2d 63 68 61 72 (str-first-char
0340: 2d 3e 6e 75 6d 62 65 72 20 73 74 72 29 0a 20 20 ->number str).
0350: 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 28 (char->integer (
0360: 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 30 string-ref str 0
0370: 29 29 29 0a 20 0a 3b 3b 20 65 78 61 6d 70 6c 65 ))). .;; example
0380: 20 6f 66 20 68 6f 77 20 74 6f 20 73 65 74 20 75 of how to set u
0390: 70 20 61 6e 64 20 77 72 69 74 65 20 74 61 72 67 p and write targ
03a0: 65 74 20 6d 61 70 70 65 72 73 0a 3b 3b 0a 28 68 et mappers.;;.(h
03b0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
03c0: 74 61 72 67 65 74 2d 6d 61 70 70 65 72 73 2a 0a target-mappers*.
03d0: 09 09 20 27 70 72 65 66 69 78 2d 63 6f 6e 74 6f .. 'prefix-conto
03e0: 75 72 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 74 ur... (lambda (t
03f0: 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 20 61 arget run-name a
0400: 72 65 61 20 61 72 65 61 2d 70 61 74 68 20 72 65 rea area-path re
0410: 61 73 6f 6e 20 63 6f 6e 74 6f 75 72 20 6d 6f 64 ason contour mod
0420: 65 2d 70 61 74 74 29 0a 09 09 20 20 20 28 63 6f e-patt)... (co
0430: 6e 63 20 63 6f 6e 74 6f 75 72 20 22 2f 22 20 74 nc contour "/" t
0440: 61 72 67 65 74 29 29 29 0a 28 68 61 73 68 2d 74 arget))).(hash-t
0450: 61 62 6c 65 2d 73 65 74 21 20 2a 74 61 72 67 65 able-set! *targe
0460: 74 2d 6d 61 70 70 65 72 73 2a 0a 09 09 20 27 70 t-mappers*... 'p
0470: 72 65 66 69 78 2d 61 72 65 61 2d 63 6f 6e 74 6f refix-area-conto
0480: 75 72 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 74 ur... (lambda (t
0490: 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 20 61 arget run-name a
04a0: 72 65 61 20 61 72 65 61 2d 70 61 74 68 20 72 65 rea area-path re
04b0: 61 73 6f 6e 20 63 6f 6e 74 6f 75 72 20 6d 6f 64 ason contour mod
04c0: 65 2d 70 61 74 74 29 0a 09 09 20 20 20 28 63 6f e-patt)... (co
04d0: 6e 63 20 61 72 65 61 20 22 2f 22 20 63 6f 6e 74 nc area "/" cont
04e0: 6f 75 72 20 22 2f 22 20 74 61 72 67 65 74 29 29 our "/" target))
04f0: 29 0a 20 20 0a 28 68 61 73 68 2d 74 61 62 6c 65 ). .(hash-table
0500: 2d 73 65 74 21 20 2a 72 75 6e 6e 61 6d 65 2d 6d -set! *runname-m
0510: 61 70 70 65 72 73 2a 0a 09 09 20 27 63 6f 72 70 appers*... 'corp
0520: 6f 72 61 74 65 2d 77 77 0a 09 09 20 28 6c 61 6d orate-ww... (lam
0530: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 2d bda (target run-
0540: 6e 61 6d 65 20 61 72 65 61 20 61 72 65 61 2d 70 name area area-p
0550: 61 74 68 20 72 65 61 73 6f 6e 20 63 6f 6e 74 6f ath reason conto
0560: 75 72 20 6d 6f 64 65 2d 70 61 74 74 29 0a 09 09 ur mode-patt)...
0570: 20 20 20 28 70 72 69 6e 74 20 22 63 6f 72 70 6f (print "corpo
0580: 72 61 74 65 2d 77 77 20 63 61 6c 6c 65 64 20 77 rate-ww called w
0590: 69 74 68 3a 20 74 61 72 67 65 74 3d 22 20 74 61 ith: target=" ta
05a0: 72 67 65 74 20 22 20 72 75 6e 2d 6e 61 6d 65 3d rget " run-name=
05b0: 22 20 72 75 6e 2d 6e 61 6d 65 20 22 20 61 72 65 " run-name " are
05c0: 61 3d 22 20 61 72 65 61 20 22 20 61 72 65 61 2d a=" area " area-
05d0: 70 61 74 68 3d 22 20 61 72 65 61 2d 70 61 74 68 path=" area-path
05e0: 20 22 20 72 65 61 73 6f 6e 3d 22 20 72 65 61 73 " reason=" reas
05f0: 6f 6e 20 22 20 63 6f 6e 74 6f 75 72 3d 22 20 63 on " contour=" c
0600: 6f 6e 74 6f 75 72 20 22 20 6d 6f 64 65 2d 70 61 ontour " mode-pa
0610: 74 74 3d 22 20 6d 6f 64 65 2d 70 61 74 74 29 0a tt=" mode-patt).
0620: 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 .. (let* ((las
0630: 74 2d 6e 61 6d 65 20 20 20 28 67 65 74 2d 6c 61 t-name (get-la
0640: 73 74 2d 72 75 6e 6e 61 6d 65 20 61 72 65 61 2d st-runname area-
0650: 70 61 74 68 20 74 61 72 67 65 74 29 29 0a 09 09 path target))...
0660: 09 20 20 28 6c 61 73 74 2d 6c 65 74 74 65 72 20 . (last-letter
0670: 28 6c 65 74 2a 20 28 28 63 68 20 28 69 66 20 28 (let* ((ch (if (
0680: 73 74 72 69 6e 67 3f 20 6c 61 73 74 2d 6e 61 6d string? last-nam
0690: 65 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 e)....... (
06a0: 6c 65 74 20 28 28 6c 65 6e 20 28 73 74 72 69 6e let ((len (strin
06b0: 67 2d 6c 65 6e 67 74 68 20 6c 61 73 74 2d 6e 61 g-length last-na
06c0: 6d 65 29 29 29 0a 09 09 09 09 09 09 09 28 73 75 me)))........(su
06d0: 62 73 74 72 69 6e 67 20 6c 61 73 74 2d 6e 61 6d bstring last-nam
06e0: 65 20 28 2d 20 6c 65 6e 20 31 29 20 6c 65 6e 29 e (- len 1) len)
06f0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 22 61 )....... "a
0700: 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 "))...... (
0710: 63 68 6e 75 6d 20 28 73 74 72 2d 66 69 72 73 74 chnum (str-first
0720: 2d 63 68 61 72 2d 3e 6e 75 6d 62 65 72 20 63 68 -char->number ch
0730: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 61 ))...... (a
0740: 20 20 20 20 20 28 73 74 72 2d 66 69 72 73 74 2d (str-first-
0750: 63 68 61 72 2d 3e 6e 75 6d 62 65 72 20 22 61 22 char->number "a"
0760: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 7a ))...... (z
0770: 20 20 20 20 20 28 73 74 72 2d 66 69 72 73 74 2d (str-first-
0780: 63 68 61 72 2d 3e 6e 75 6d 62 65 72 20 22 7a 22 char->number "z"
0790: 29 29 29 0a 09 09 09 09 09 20 28 69 66 20 28 61 )))...... (if (a
07a0: 6e 64 20 28 3e 3d 20 63 68 6e 75 6d 20 61 29 28 nd (>= chnum a)(
07b0: 3c 3d 20 63 68 6e 75 6d 20 7a 29 29 0a 09 09 09 <= chnum z))....
07c0: 09 09 20 20 20 20 20 63 68 6e 75 6d 0a 09 09 09 .. chnum....
07d0: 09 09 20 20 20 20 20 23 66 29 29 29 0a 09 09 09 .. #f)))....
07e0: 20 20 28 6e 65 78 74 2d 6c 65 74 74 65 72 20 28 (next-letter (
07f0: 69 66 20 6c 61 73 74 2d 6c 65 74 74 65 72 0a 09 if last-letter..
0800: 09 09 09 09 20 20 20 28 6c 69 73 74 2d 3e 73 74 .... (list->st
0810: 72 69 6e 67 0a 09 09 09 09 09 20 20 20 20 28 6c ring...... (l
0820: 69 73 74 0a 09 09 09 09 09 20 20 20 20 20 28 69 ist...... (i
0830: 6e 74 65 67 65 72 2d 3e 63 68 61 72 0a 09 09 09 nteger->char....
0840: 09 09 20 20 20 20 20 20 28 2b 20 6c 61 73 74 2d .. (+ last-
0850: 6c 65 74 74 65 72 20 31 29 29 29 29 20 3b 3b 20 letter 1)))) ;;
0860: 73 75 72 65 6c 79 20 74 68 65 72 65 20 69 73 20 surely there is
0870: 61 6e 20 65 61 73 69 65 72 20 77 61 79 3f 0a 09 an easier way?..
0880: 09 09 09 09 20 20 20 22 61 22 29 29 29 0a 09 09 .... "a")))...
0890: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
08a0: 6c 61 73 74 2d 6e 61 6d 65 3a 20 22 20 6c 61 73 last-name: " las
08b0: 74 2d 6e 61 6d 65 20 22 20 6c 61 73 74 2d 6c 65 t-name " last-le
08c0: 74 74 65 72 3a 20 22 20 6c 61 73 74 2d 6c 65 74 tter: " last-let
08d0: 74 65 72 20 22 20 6e 65 78 74 2d 6c 65 74 74 65 ter " next-lette
08e0: 72 3a 20 22 20 6e 65 78 74 2d 6c 65 74 74 65 72 r: " next-letter
08f0: 29 0a 09 09 20 20 20 20 20 28 63 6f 6e 63 20 28 )... (conc (
0900: 73 65 63 6f 6e 64 73 2d 3e 77 77 64 61 74 65 20 seconds->wwdate
0910: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
0920: 29 29 20 6e 65 78 74 2d 6c 65 74 74 65 72 29 29 )) next-letter))
0930: 29 29 0a 0a 28 68 61 73 68 2d 74 61 62 6c 65 2d ))..(hash-table-
0940: 73 65 74 21 20 2a 72 75 6e 6e 61 6d 65 2d 6d 61 set! *runname-ma
0950: 70 70 65 72 73 2a 0a 09 09 20 27 61 75 74 6f 0a ppers*... 'auto.
0960: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 .. (lambda (targ
0970: 65 74 20 72 75 6e 2d 6e 61 6d 65 20 61 72 65 61 et run-name area
0980: 20 61 72 65 61 2d 70 61 74 68 20 72 65 61 73 6f area-path reaso
0990: 6e 20 63 6f 6e 74 6f 75 72 20 6d 6f 64 65 2d 70 n contour mode-p
09a0: 61 74 74 29 0a 09 09 20 20 20 22 61 75 74 6f 2d att)... "auto-
09b0: 65 68 22 29 29 0a 0a 28 70 72 69 6e 74 20 22 47 eh"))..(print "G
09c0: 6f 74 20 68 65 72 65 21 22 29 0a 0a ot here!")..