1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
#lang racket
(require racket/runtime-path)
(define (read-lines port)
(define line (read port))
(if (eof-object? line)
'()
(cons line (read-lines port))))
;; don't remove any check statements
(define (remove-at n lst)
(define-values (head tail) (split-at lst n))
(define line (car tail))
(if (and (list? line)
(or (equal? (first line) 'check)
(equal? (first line) 'keep)))
lst
(append head (cdr tail))))
(define-runtime-path egglog-binary
"../target/release/egglog")
;; timeout in seconds
(define TIMEOUT 5)
(define ITERATIONS 1)
(define RANDOM-SAMPLE-FACTOR 1)
(define MUST-NOT-STRINGS `())
(define TARGET-STRINGS `("src/lib.rs:250"))
(define (desugar line)
(match line
[`(keep ,body)
body]
[else line]))
(define (desired-error? program)
(displayln (format "Trying program of size ~a" (length program)))
(flush-output)
(define-values (egglog-process egglog-output egglog-in err)
(subprocess (current-output-port) #f #f egglog-binary))
(for ([line program])
(writeln (desugar line) egglog-in))
(close-output-port egglog-in)
(when (not (sync/timeout TIMEOUT egglog-process))
(displayln "Timed out"))
(subprocess-kill egglog-process #t)
(displayln "checking output")
(flush-output)
(define err-str (read-string 10000 err))
(close-input-port err)
(define still-unsound (and (string? err-str)
(for/and ([must-not-string MUST-NOT-STRINGS])
(not (string-contains? err-str must-not-string)))
(for/or ([TARGET-STRING TARGET-STRINGS])
(string-contains? err-str TARGET-STRING))))
(println err-str)
(if still-unsound
(displayln "Reduced program")
(displayln "Did not reduce"))
still-unsound)
(define (min-program program index)
(fprintf (current-output-port) "Trying to remove index ~a out of ~a\n" index (length program))
(flush-output)
(cond
[(>= index (length program)) program]
[else
(define removed (remove-at index program))
(cond
[(equal? (length removed) (length program))
(min-program removed (+ index 1))]
[(desired-error? removed)
(min-program removed index)]
[else (min-program program (+ index 1))])]))
(define (remove-random-lines program n)
(cond
[(<= n 0) program]
[else
(define index (random (length program)))
(define new-program (remove-at index program))
(remove-random-lines new-program (- n 1))]))
(define (min-program-random program iters)
(cond
[(= iters 0) program]
[else
(define index (random (length program)))
(define new-program (remove-at index program))
(if (desired-error? new-program)
(min-program-random new-program (- iters 1))
(min-program-random program (- iters 1)))]))
(define (min-program-greedy program num)
(cond
[(< num 1)
program]
[else
(define prog (remove-random-lines program num))
(if (desired-error? prog)
(min-program-greedy prog num)
(min-program-greedy program (* num 2/3)))]))
(define (random-and-sequential program)
(define binary (min-program-greedy program (/ (length program) 2)))
(define random-prog (min-program-random binary (* (length binary) RANDOM-SAMPLE-FACTOR)))
(min-program random-prog 0))
(define (min-iterations program)
(define programs (for/list ([i (in-range ITERATIONS)])
(random-and-sequential program)))
(first (sort programs (lambda (a b) (< (length a) (length b))))))
(define (minimize port-in port-out)
#;((define-values (process out in err) (subprocess #f #f #f "cargo"))
(define err-str (read-string 800 err))
(when (not (string=? err-str ""))
(error err-str))
(close-input-port out)
(close-output-port in)
(close-input-port err)
(subprocess-wait process))
(define egglog (read-lines port-in))
(pretty-print egglog)
(when (not (desired-error? egglog))
(error "Original program did not have error"))
(define minimized (min-iterations egglog))
(for ([line minimized])
(writeln (desugar line) port-out)))
(module+ main
(command-line
#:args (file-in file-out)
(minimize (open-input-file file-in) (open-output-file file-out #:exists 'replace))))