-
Notifications
You must be signed in to change notification settings - Fork 0
/
main.rkt
184 lines (167 loc) · 8.85 KB
/
main.rkt
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
#lang racket
(require racket/cmdline)
(require "lib.rkt")
(define benchmark-output-format (make-parameter 'plain))
(define benchmark-output-transposed (make-parameter #f)) ; one type checker per row by default, set to #t to have one type checker per column
(define typechecker-parameters-alist
`((typedracket (comment-char #\;)
(extension ".rkt")
(file-base-path ,(build-path (current-directory) "TypedRacket"))
(arguments ,(list (build-path "main.rkt")))
(command "racket"))
(typescript (comment-char #\/)
(extension ".ts")
(file-base-path ,(build-path (current-directory) "TypeScript"))
(arguments ,(list (build-path "main.ts") "tsc" "--noEmit" "--target" "es2023"))
(command "npx"))
(flow (comment-char #\/)
(extension ".js")
(file-base-path ,(build-path (current-directory) "Flow"))
(arguments ,(list (build-path "src/index.js") "flow" "focus-check"))
(command "npx")
(pre-benchmark-func ,(lambda () (shell-command "touch" '() ".flowconfig")))
(post-benchmark-func ,(lambda () (shell-command "npx" '("flow" "stop") (build-path "src/index.js"))))
(post-benchmark-func-dir ,(build-path (current-directory) "Flow")))
(mypy (comment-char #\#)
(extension ".py")
(file-base-path ,(build-path (current-directory) "mypy"))
(arguments ,`(,(build-path "main.py")
,(lambda (input-file)
(list "-c"
(string-append-immutable
"source .venv/bin/activate; mypy "
(path->string input-file))))))
(command "bash"))
(pyright (comment-char #\#)
(extension ".py")
(file-base-path ,(build-path (current-directory) "Pyright"))
(arguments ,(list (build-path "main.py") "pyright"))
(command "npx"))))
(define (print-benchmark-row-markdown type-checker benchmark-result)
(display (format "| ~a " type-checker))
(for-each (lambda (test)
(let ([positive-passed (cadr test)]
[negative-passed (caddr test)])
(display (format "| ~a " (if (and positive-passed negative-passed) "V" "X")))))
benchmark-result)
(display "|\n"))
(define (print-benchmark-row-latex program-name benchmark-result)
(display (format "~a & " program-name))
(for-each (lambda (test)
(let ([test-name (car test)]
[positive-passed (cadr test)]
[negative-passed (caddr test)])
(display (format "~a & " (if (and positive-passed negative-passed) "V" "X")))))
benchmark-result)
(display "\\\\ \n"))
(define (print-benchmark-row type-checker benchmark-result)
(case (benchmark-output-format)
[(markdown) (print-benchmark-row-markdown type-checker benchmark-result)]
[(tex) (print-benchmark-row-latex type-checker benchmark-result)]
[(plain) (display (format "~a: ~a\n" type-checker benchmark-result))]))
(define (process-benchmark-row type-checker benchmark-result-row)
(append (list (symbol->string type-checker))
(map (lambda (test)
(let ([positive-passed (cadr test)]
[negative-passed (caddr test)])
(cond
[(and positive-passed negative-passed) "O"]
[(or positive-passed negative-passed) "x"]
[else "X"])))
benchmark-result-row)))
(define (print-row-markdown row)
(display (format "| ~a " (car row)))
(for-each (lambda (test-result)
(display (format "| ~a " test-result)))
(cdr row))
(display "|\n"))
(define (print-row-latex row)
(display (format "~a " (car row)))
(for-each (lambda (test-result)
(display (format "& ~a " test-result)))
(cdr row))
(display "\\\\\n"))
(define (print-row row [output-format 'plain])
(case output-format
[(markdown) (print-row-markdown row)]
[(tex) (print-row-latex row)]
[(plain) (display (format "~a\n" row))]))
(define (transpose l)
(apply map list l))
(define (pad-columns rows)
(define transposed-rows (transpose rows))
(define column-widths (map (lambda (column) (apply max (map string-length column))) transposed-rows))
(define padded-rows
(map (lambda (row)
(map (lambda (column width)
(format "~a~a" column (make-string (- width (string-length column)) #\space)))
row column-widths))
rows))
padded-rows)
(define (print-benchmark benchmark-result-rows [output-format 'plain] [table-header null])
(define transpose-function (if (benchmark-output-transposed) transpose identity))
(define processed-benchmark-result-rows (map (lambda (row) (process-benchmark-row (car row) (cdr row))) benchmark-result-rows))
(define printable-rows-pre (transpose (if (not (null? table-header))
(cons table-header processed-benchmark-result-rows)
processed-benchmark-result-rows)))
(define printable-rows (pad-columns printable-rows-pre))
(for-each (lambda (row) (print-row row output-format)) printable-rows))
(define (get-benchmark-result-row type-checker)
(when (benchmark-verbose)
(displayln (format "Running benchmark for ~a" type-checker)))
(define typechecker-parameters (cdr (assoc type-checker typechecker-parameters-alist)))
(define benchmark-result
(if (not typechecker-parameters)
(error (format "Type checker ~a not found." type-checker))
(let ([comment-char (cadr (assoc 'comment-char typechecker-parameters))]
[extension (cadr (assoc 'extension typechecker-parameters))]
[file-base-path (cadr (assoc 'file-base-path typechecker-parameters))]
[arguments (cadr (assoc 'arguments typechecker-parameters))]
[command (cadr (assoc 'command typechecker-parameters))]
[pre-benchmark-func (cadr (or (assoc 'pre-benchmark-func typechecker-parameters) '(#f #f) ))]
[post-benchmark-func (cadr (or (assoc 'post-benchmark-func typechecker-parameters) '(#f #f)))]
[pre-benchmark-func-dir (cadr (or (assoc 'pre-benchmark-func-dir typechecker-parameters) `(#f ,(find-system-path 'temp-dir))))]
[post-benchmark-func-dir (cadr (or (assoc 'post-benchmark-func-dir typechecker-parameters) `(#f ,(find-system-path 'temp-dir))))])
(run-benchmark-item file-base-path command arguments comment-char extension
#:pre-benchmark-func pre-benchmark-func
#:post-benchmark-func post-benchmark-func
#:pre-benchmark-func-dir pre-benchmark-func-dir
#:post-benchmark-func-dir post-benchmark-func-dir))))
(cons type-checker benchmark-result))
(define (run-benchmarks type-checker-list)
(define benchmark-result-rows
(map get-benchmark-result-row type-checker-list))
(print-benchmark benchmark-result-rows (benchmark-output-format)
(cons "Benchmark" '("positive"
"negative"
"alias"
"connectives"
"nesting_body"
"nesting_condition"
"predicate_2way"
"predicate_1way"
"predicate_checked"
"object_properties"
"tuple_elements"
"tuple_length"
"merge_with_union"))))
(define type-checker
(command-line
#:program "main.rkt"
#:once-each
[("-v" "--verbose") "Print the output of the benchmarks to the console"
(benchmark-verbose #t)]
[("-f" "--format") output-format "Print the output of the benchmarks in the specified format. Options: plain, markdown, tex. Default: plain."
(benchmark-output-format (string->symbol output-format))]
[("-t" "--transpose") "Transpose the output of the benchmarks"
(benchmark-output-transposed #t)]
;; #:once-any
;; [("-m" "--markdown") "Print the output of the benchmarks in markdown format"
;; (benchmark-output-format 'markdown)]
;; [("-t" "--tex") "Print the output of the benchmarks in LaTeX format"
;; (benchmark-output-format 'tex)]
#:args ([type-checker null])
type-checker))
(if (null? type-checker)
(run-benchmarks (map car typechecker-parameters-alist))
(run-benchmarks (list (string->symbol (string-downcase type-checker)))))