diff --git a/icfp-2016/benchmark/README.md b/icfp-2016/benchmark/README.md index 61fa3cf..f2c9aab 100644 --- a/icfp-2016/benchmark/README.md +++ b/icfp-2016/benchmark/README.md @@ -33,7 +33,8 @@ Changes 52:(define: default-min-left-length 2) 53:(define: default-min-right-length 2) 54:(define: default-joiner #\u00AD) -- suffixtree : 2 set! to set-box!, 6 lines affected +- modulegraph : simplified some regexp matching, no more dev assertions - morse-code : 1 set!, 12 lines (just ignored the import) removed an annotation on regexp-match +- suffixtree : 2 set! to set-box!, 6 lines affected - synth : had to remove racket/vector imports diff --git a/icfp-2016/benchmark/modulegraph/data/acquire.tex b/icfp-2016/benchmark/modulegraph/data/acquire.tex new file mode 100644 index 0000000..085c6bd --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/acquire.tex @@ -0,0 +1,47 @@ +\begin{tikzpicture} + + \node (00) [] {\rkt{1}{aux}}; + \node (01) [below of=00,yshift=0.3cm] {}; + + \node (10) [left of=00] {\rkt{2}{basics}}; + \node (11) [left of=01] {}; + + \node (20) [left of=10] {\rkt{3}{board}}; + \node (21) [left of=11] {}; + + \node (30) [left of=20] {\rkt{7}{strategy}}; + \node (31) [left of=21] {\rkt{6}{state}}; + + \node (40) [left of=30] {\rkt{5}{player}}; + \node (41) [left of=31] {\rkt{0}{admin}}; + + \node (50) [left of=40] {\rkt{4}{main}}; + + %% -- edges + \draw[->] (10) -- (00); + + \draw[->] (20) -- (10); + \draw[->] (20) edge[bend left=20] (00); + + \draw[->] (30) -- (20); + \draw[->] (30) edge[bend right=20] (10); + \draw[->] (30) edge[bend left=20] (00); + + \draw[->] (31) -- (20); + \draw[->] (31) -- (10); + \draw[->] (31) -- (00); + + \draw[->] (40) -- (31); + \draw[->] (40) -- (30); + \draw[->] (40) -- (41); + \draw[->] (40) edge[bend left=20] (10); + + \draw[->] (41) -- (31); + \draw[->] (41) -- (10); + \draw[->] (41) -- (20); + + \draw[->] (50) edge[bend left=20] (00); + \draw[->] (50) -- (40); + \draw[->] (50) -- (41); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/echo.tex b/icfp-2016/benchmark/modulegraph/data/echo.tex new file mode 100644 index 0000000..1ff379f --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/echo.tex @@ -0,0 +1,15 @@ +%% Total contracts = 6 +%% Total checks = 6 +\begin{tikzpicture} + + \node (1) [] {\rkt{1}{constants}}; + \node (0) [left of=1, yshift=-0.5cm] {\rkt{0}{client}}; + \node (2) [left of=1, xshift=-1cm] {\rkt{2}{main}}; + \node (3) [left of=1, yshift=0.5cm] {\rkt{3}{server}}; + + \draw[->,green!48!white, line width=1pt] (0) -- (1); + \draw[->,green!48!white, line width=1pt] (2) -- (0); + \draw[->,green!48!white, line width=1pt] (2) -- (3); + \draw[->,green!48!white, line width=1pt] (3) -- (1); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/forth.tex b/icfp-2016/benchmark/modulegraph/data/forth.tex new file mode 100644 index 0000000..28e22af --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/forth.tex @@ -0,0 +1,13 @@ +\begin{tikzpicture} + + \node (00) [] {\rkt{3}{stack}}; + \node (10) [left of=00] {\rkt{0}{command}}; + \node (20) [left of=10] {\rkt{1}{eval}}; + \node (30) [left of=20] {\rkt{2}{main}}; + + \draw[->] (10) -- (00); + \draw[->] (20) edge[bend left=20] (10); + \draw[->] (20) -- (00); + \draw[->] (30) -- (20); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/fsm.tex b/icfp-2016/benchmark/modulegraph/data/fsm.tex new file mode 100644 index 0000000..bd9bd53 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/fsm.tex @@ -0,0 +1,27 @@ +\begin{tikzpicture} + + \node (00) [] {\rkt{3}{population}}; + \node (01) [below of=00] {}; + \node (02) [below of=01] {\rkt{4}{utilities}}; + + \node (10) [left of=00] {}; + \node (11) [left of=01] {}; + \node (12) [left of=02] {\rkt{0}{automata}}; + + \node (20) [left of=10] {\rkt{1}{evolution}}; + \node (21) [left of=11] {}; + + \node (31) [left of=21] {\rkt{2}{main}}; + + %% -- edges + \draw[->] (31) -- (20); + \draw[->] (31) -- (12); + + \draw[->] (20) -- (12); + \draw[->] (20) -- (02); + \draw[->] (20) -- (00); + + \draw[->] (12) -- (02); + \draw[->] (12) -- (00); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/fsmoo.tex b/icfp-2016/benchmark/modulegraph/data/fsmoo.tex new file mode 100644 index 0000000..348429e --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/fsmoo.tex @@ -0,0 +1,19 @@ +\begin{tikzpicture} + + \node (00) [] {\rkt{0}{automata}}; + \node (01) [below of=00] {\rkt{3}{utilities}}; + + \node (10) [left of=00] {\rkt{2}{population}}; + \node (11) [left of=01] {}; + + \node (21) [left of=11] {\rkt{1}{main}}; + + %% -- edges + \draw[->] (21) -- (00); + \draw[->] (21) -- (01); + \draw[->] (21) -- (10); + + \draw[->] (10) -- (00); + \draw[->] (10) -- (01); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/fsmv2.tex b/icfp-2016/benchmark/modulegraph/data/fsmv2.tex new file mode 100644 index 0000000..348429e --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/fsmv2.tex @@ -0,0 +1,19 @@ +\begin{tikzpicture} + + \node (00) [] {\rkt{0}{automata}}; + \node (01) [below of=00] {\rkt{3}{utilities}}; + + \node (10) [left of=00] {\rkt{2}{population}}; + \node (11) [left of=01] {}; + + \node (21) [left of=11] {\rkt{1}{main}}; + + %% -- edges + \draw[->] (21) -- (00); + \draw[->] (21) -- (01); + \draw[->] (21) -- (10); + + \draw[->] (10) -- (00); + \draw[->] (10) -- (01); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/gregor.tex b/icfp-2016/benchmark/modulegraph/data/gregor.tex new file mode 100644 index 0000000..0c299aa --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/gregor.tex @@ -0,0 +1,112 @@ +%% Total contracts = 138 +%% Total checks = 3708620 +\begin{tikzpicture} + + \node (00) [] {}; + \node (01) [below of=00,xshift=0.8cm] {\rkt{1}{core-structs}}; + \node (02) [below of=01,xshift=0.8cm] {}; + + \node (10) [left of=00] {\rkt{5}{gregor-structs}}; + \node (11) [left of=01] {\rkt{6}{hmsn}}; + \node (12) [left of=02] {\rkt{12}{ymd}}; + + \node (20) [left of=10] {\rkt{11}{time}}; + \node (21) [left of=11] {}; + \node (22) [left of=12] {\rkt{2}{date}}; + + \node (30) [left of=20] {}; + \node (31) [left of=21] {\rkt{3}{datetime}}; + \node (32) [left of=22] {}; + + \node (40) [left of=30] {\rkt{8}{moment-base}}; + \node (41) [left of=31] {}; + \node (42) [left of=32] {\rkt{4}{difference}}; + + \node (50) [left of=40] {\rkt{10}{offset-resolvers}}; + \node (51) [left of=41] {}; + \node (52) [left of=42] {}; + + \node (60) [left of=50] {\rkt{9}{moment}}; + \node (61) [left of=51] {}; + \node (62) [left of=52] {}; + + \node (70) [left of=60] {\rkt{0}{clock}}; + \node (71) [left of=61] {}; + \node (72) [left of=62] {}; + + \node (81) [left of=71] {\rkt{7}{main}}; + + %% -- edges + %% gregor-structs +%% WARNING: no data for boundary 'core-structs.rkt' ==> 'gregor-structs.rkt' + \draw[->] (10) -- (01); + %% hmsn +%% WARNING: no data for boundary 'core-structs.rkt' ==> 'hmsn.rkt' + \draw[->] (11) -- (01); + %% ymd +%% WARNING: no data for boundary 'core-structs.rkt' ==> 'ymd.rkt' + \draw[->] (12) -- (01); + %% date +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'date.rkt' + \draw[->] (22) -- (10); +%% WARNING: no data for boundary 'core-structs.rkt' ==> 'date.rkt' + \draw[->] (22) -- (01); + \draw[->,blue!43!white, line width=2.5pt] (22) -- (12); + %% time +%% WARNING: no data for boundary 'core-structs.rkt' ==> 'time.rkt' + \draw[->] (20) -- (01); +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'time.rkt' + \draw[->] (20) -- (10); + \draw[->,blue!43!white, line width=2.5pt] (20) -- (11); + %% datetime + \draw[->,purple!64!white, line width=3pt] (31) -- (20); + \draw[->,purple!64!white, line width=3pt] (31) -- (22); + \draw[->,green!48!white, line width=1pt] (31) -- (11); +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'datetime.rkt' + \draw[->] (31) -- (10); +%% WARNING: no data for boundary 'core-structs.rkt' ==> 'datetime.rkt' + \draw[->] (31) -- (01); + %% diff +%% WARNING: no data for boundary 'core-structs.rkt' ==> 'difference.rkt' + \draw[->] (42) -- (01); +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'difference.rkt' + \draw[->] (42) -- (10); + \draw[->,green!48!white, line width=1pt] (42) -- (11); + \draw[->,green!48!white, line width=1pt] (42) edge[bend right=35] (12); + \draw[->,blue!43!white, line width=2.5pt] (42) -- (22); + \draw[->,purple!64!white, line width=3pt] (42) -- (31); + %% moment-base +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'moment-base.rkt' + \draw[->] (40) edge[bend left=35] (10); + \draw[->,yellow!45!orange, line width=2pt] (40) -- (31); + %% offset-resolvers +%% WARNING: no data for boundary 'core-structs.rkt' ==> 'offset-resolvers.rkt' + \draw[->] (50) -- (01); +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'offset-resolvers.rkt' + \draw[->] (50) edge[bend left=35] (10); + \draw[->,green!48!white, line width=1pt] (50) -- (11); + \draw[->,green!48!white, line width=1pt] (50) -- (31); + \draw[->,green!48!white, line width=1pt] (50) -- (40); + %% moment +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'moment.rkt' + \draw[->] (60) edge[bend left=35] (10); + \draw[->,green!48!white, line width=1pt] (60) -- (11); + \draw[->,blue!43!white, line width=2.5pt] (60) -- (31); + \draw[->,blue!43!white, line width=2.5pt] (60) edge[bend left=35] (40); + \draw[->,green!48!white, line width=1pt] (60) -- (50); + %% clock +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'clock.rkt' + \draw[->] (70) edge[bend left=35] (10); + \draw[->,yellow!45!orange, line width=2pt] (70) -- (31); + \draw[->,yellow!45!orange, line width=2pt] (70) -- (60); + %% main +%% WARNING: no data for boundary 'gregor-structs.rkt' ==> 'main.rkt' + \draw[->] (81) -- (10); + \draw[->,yellow!45!orange, line width=2pt] (81) -- (20); + \draw[->,yellow!45!orange, line width=2pt] (81) -- (22); + \draw[->,blue!43!white, line width=2.5pt] (81) -- (31); + \draw[->,blue!43!white, line width=2.5pt] (81) -- (60); + \draw[->,yellow!45!orange, line width=2pt] (81) -- (70); + \draw[->,blue!43!white, line width=2.5pt] (81) -- (42); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/htdp.tex b/icfp-2016/benchmark/modulegraph/data/htdp.tex new file mode 100644 index 0000000..92e2e7a --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/htdp.tex @@ -0,0 +1,14 @@ +\begin{tikzpicture} + + \node (0) [] {\rkt{1}{x-info}}; + \node (1) [below of=0] {\rkt{3}{xnotes}}; + \node (2) [below of=1] {\rkt{2}{xhtml}}; + \node (3) [below of=2] {\rkt{0}{main}}; + + %% -- edges + \draw[->] (1) -- (0); + \draw[->] (2) edge[bend right=65] (0); + \draw[->] (2) -- (1); + \draw[->] (3) -- (2); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/kcfa.tex b/icfp-2016/benchmark/modulegraph/data/kcfa.tex new file mode 100644 index 0000000..e14df38 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/kcfa.tex @@ -0,0 +1,47 @@ +%% Total contracts = 50 +%% Total checks = 877929229 +\begin{tikzpicture} + + \node (0) [] {\rkt{4}{structs}}; + \node (1) [left of=0] {\rkt{1}{benv}}; + \node (2) [left of=1] {\rkt{5}{time}}; + \node (3) [left of=2] {\rkt{2}{denotable}}; + \node (4) [left of=3] {\rkt{0}{ai}}; + \node (5) [left of=4] {\rkt{6}{ui}}; + \node (6) [left of=5] {\rkt{3}{main}}; + + %% -- edges +%% WARNING: no data for boundary 'structs.rkt' ==> 'benv.rkt' + \draw[->] (1) -- (0); +%% WARNING: no data for boundary 'benv.rkt' ==> 'time.rkt' + \draw[->] (2) -- (1); +%% WARNING: no data for boundary 'structs.rkt' ==> 'time.rkt' + \draw[->] (2) edge[bend right=35] (0); +%% WARNING: no data for boundary 'time.rkt' ==> 'denotable.rkt' + \draw[->] (3) -- (2); +%% WARNING: no data for boundary 'structs.rkt' ==> 'denotable.rkt' + \draw[->] (3) edge[bend left=35] (0); +%% WARNING: no data for boundary 'benv.rkt' ==> 'denotable.rkt' + \draw[->] (3) edge[bend left=35] (1); +%% WARNING: no data for boundary 'denotable.rkt' ==> 'ai.rkt' + \draw[->] (4) -- (3); +%% WARNING: no data for boundary 'structs.rkt' ==> 'ai.rkt' + \draw[->] (4) edge[bend right=35] (0); +%% WARNING: no data for boundary 'benv.rkt' ==> 'ai.rkt' + \draw[->] (4) edge[bend right=35] (1); +%% WARNING: no data for boundary 'time.rkt' ==> 'ai.rkt' + \draw[->] (4) edge[bend right=35] (2); + \draw[->,green!48!white, line width=1pt] (5) -- (4); +%% WARNING: no data for boundary 'structs.rkt' ==> 'ui.rkt' + \draw[->] (5) edge[bend left=35] (0); +%% WARNING: no data for boundary 'benv.rkt' ==> 'ui.rkt' + \draw[->] (5) edge[bend left=35] (1); +%% WARNING: no data for boundary 'time.rkt' ==> 'ui.rkt' + \draw[->] (5) edge[bend left=35] (2); +%% WARNING: no data for boundary 'denotable.rkt' ==> 'ui.rkt' + \draw[->] (5) edge[bend left=35] (3); + \draw[->,yellow!45!orange, line width=2pt] (6) -- (5); +%% WARNING: no data for boundary 'structs.rkt' ==> 'main.rkt' + \draw[->] (6) edge[bend right=35] (0); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/lnm.tex b/icfp-2016/benchmark/modulegraph/data/lnm.tex new file mode 100644 index 0000000..707156b --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/lnm.tex @@ -0,0 +1,25 @@ +%% Total contracts = 241 +%% Total checks = 25301 +\begin{tikzpicture} + + \node (00) [] {\rkt{0}{bitstring}}; + \node (01) [below of=00] {\rkt{3}{modulegraph}}; + \node (10) [left of=00] {\rkt{4}{spreadsheet}}; + \node (11) [left of=01] {\rkt{5}{summary}}; + \node (20) [left of=11] {\rkt{1}{lnm-plot}}; + \node (21) [left of=10] {}; + \node (30) [left of=21] {\rkt{2}{main}}; + + \draw[->,green!48!white, line width=1pt] (10) -- (00); + \draw[->,blue!43!white, line width=2.5pt] (11) -- (00); +%% WARNING: no data for boundary 'modulegraph.rkt' ==> 'summary.rkt' + \draw[->] (11) -- (01); + \draw[->,blue!43!white, line width=2.5pt] (20) -- (00); +%% WARNING: no data for boundary 'summary.rkt' ==> 'lnm-plot.rkt' + \draw[->] (20) -- (11); + \draw[->,green!48!white, line width=1pt] (30) -- (10); +%% WARNING: no data for boundary 'summary.rkt' ==> 'main.rkt' + \draw[->] (30) -- (11); + \draw[->,green!48!white, line width=1pt] (30) -- (20); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/mbta.tex b/icfp-2016/benchmark/modulegraph/data/mbta.tex new file mode 100644 index 0000000..99c4aa5 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/mbta.tex @@ -0,0 +1,15 @@ +%% Total contracts = 159 +%% Total checks = 448 +\begin{tikzpicture} + + \node (0) [] {\rkt{2}{t-graph}}; + \node (1) [left of=0] {\rkt{3}{t-view}}; + \node (2) [left of=1] {\rkt{1}{run-t}}; + \node (3) [left of=2] {\rkt{0}{main}}; + + %% -- edges + \draw[->,green!48!white, line width=1pt] (1) -- (0); + \draw[->,green!48!white, line width=1pt] (2) -- (1); + \draw[->,yellow!45!orange, line width=2pt] (3) -- (2); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/morsecode.tex b/icfp-2016/benchmark/modulegraph/data/morsecode.tex new file mode 100644 index 0000000..06f782d --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/morsecode.tex @@ -0,0 +1,18 @@ +%% Total contracts = 3 +%% Total checks = 2014220 +\begin{tikzpicture} + + \node (00) [] {\rkt{3}{morse-code-table}}; + \node (01) [above of=00] {\rkt{0}{levenshtein}}; + + \node (10) [left of=00] {\rkt{2}{morse-code-strings}}; + \node (11) [left of=01] {}; + + \node (21) [left of=11] {\rkt{1}{main}}; + + %% -- edges + \draw[->,red!87!black, line width=3.5pt] (10) -- (00); + \draw[->,purple!64!white, line width=3pt] (21) -- (10); + \draw[->,purple!64!white, line width=3pt] (21) -- (01); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/quad.tex b/icfp-2016/benchmark/modulegraph/data/quad.tex new file mode 100644 index 0000000..e0f71ab --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/quad.tex @@ -0,0 +1,85 @@ +%% Total contracts = 367 +%% Total checks = 181182 +\begin{tikzpicture} + + \node (00) [] {\rkt{14}{world}}; + \node (01) [below of=00,yshift=0.2cm] {\rkt{9}{quads}}; + \node (02) [below of=01,yshift=0.2cm] {\rkt{12}{sugar}}; + \node (03) [below of=02,yshift=0.2cm] {\rkt{7}{penalty}}; + \node (04) [below of=03,yshift=0.2cm] {\rkt{4}{ocm-struct}}; + \node (05) [below of=04,yshift=0.2cm] {\rkt{3}{measure}}; + \node (06) [below of=05,yshift=0.2cm] {\rkt{0}{exceptions}}; + \node (07) [below of=06,yshift=0.2cm] {\rkt{6}{patterns-hashed}}; + + \node (10) [left of=00] {\rkt{10}{quick-sample}}; + \node (11) [left of=01] {}; + \node (12) [left of=02] {}; + \node (13) [left of=03] {}; + \node (14) [left of=04] {\rkt{5}{ocm}}; + \node (15) [left of=05] {}; + \node (16) [left of=06] {\rkt{1}{hyphenate}}; + + \node (20) [left of=10] {}; + \node (21) [left of=11] {}; + \node (22) [left of=12] {}; + \node (23) [left of=13] {}; + \node (24) [left of=14] {}; + \node (25) [left of=15] {\rkt{13}{utils}}; + + \node (30) [left of=20] {}; + \node (31) [left of=21] {\rkt{11}{render}}; + \node (32) [left of=22] {}; + \node (33) [left of=23] {\rkt{15}{wrap}}; + \node (35) [left of=25] {}; + + \node (40) [left of=30] {}; + \node (42) [left of=32] {\rkt{8}{quad-main}}; + \node (45) [left of=35] {}; + + \node (50) [left of=40] {\rkt{2}{main}}; + + %% -- edges + %% hyphenate + \draw[->,yellow!45!orange, line width=2pt] (16) -- (06); + \draw[->,blue!43!white, line width=2.5pt] (16) -- (07); + %% quick-sample + \draw[->,yellow!45!orange, line width=2pt] (10) -- (01); + %% ocm +%% WARNING: no data for boundary 'ocm-struct.rkt' ==> 'ocm.rkt' + \draw[->] (14) -- (04); + %% utils + \draw[->,yellow!45!orange, line width=2pt] (25) -- (16); + \draw[->,yellow!45!orange, line width=2pt] (25) -- (05); + \draw[->,blue!43!white, line width=2.5pt] (25) -- (01); + \draw[->,yellow!45!orange, line width=2pt] (25) -- (00); + %% render + \draw[->,yellow!45!orange, line width=2pt] (31) -- (00); + \draw[->,blue!43!white, line width=2.5pt] (31) -- (01); + \draw[->,green!48!white, line width=1pt] (31) -- (25); + %% wrap + \draw[->,yellow!45!orange, line width=2pt] (33) -- (00); + \draw[->,blue!43!white, line width=2.5pt] (33) -- (01); +%% WARNING: no data for boundary 'sugar.rkt' ==> 'wrap.rkt' + \draw[->] (33) -- (02); +%% WARNING: no data for boundary 'penalty.rkt' ==> 'wrap.rkt' + \draw[->] (33) -- (03); +%% WARNING: no data for boundary 'ocm-struct.rkt' ==> 'wrap.rkt' + \draw[->] (33) -- (04); + \draw[->,blue!43!white, line width=2.5pt] (33) -- (05); + \draw[->,blue!43!white, line width=2.5pt] (33) -- (14); + \draw[->,green!48!white, line width=1pt] (33) -- (25); + %% quad-main + \draw[->,yellow!45!orange, line width=2pt] (42) -- (00); + \draw[->,yellow!45!orange, line width=2pt] (42) -- (01); + \draw[->,yellow!45!orange, line width=2pt] (42) -- (33); + \draw[->,green!48!white, line width=1pt] (42) -- (05); + \draw[->,green!48!white, line width=1pt] (42) -- (25); +%% WARNING: no data for boundary 'sugar.rkt' ==> 'quad-main.rkt' + \draw[->] (42) -- (02); + %% main + \draw[->,green!48!white, line width=1pt] (50) edge[bend left=35] (00); + \draw[->,green!48!white, line width=1pt] (50) -- (42); + \draw[->,green!48!white, line width=1pt] (50) -- (10); + \draw[->,green!48!white, line width=1pt] (50) -- (31); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/quadU.tex b/icfp-2016/benchmark/modulegraph/data/quadU.tex new file mode 100644 index 0000000..c402545 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/quadU.tex @@ -0,0 +1,85 @@ +%% Total contracts = 367 +%% Total checks = 181182 +\begin{tikzpicture} + + \node (00) [] {\rkt{12}{world}}; + \node (01) [below of=00,yshift=0.2cm] {\rkt{7}{quads}}; + \node (02) [below of=01,yshift=0.2cm] {\rkt{10}{sugar}}; + \node (03) [below of=02,yshift=0.2cm] {\rkt{5}{penalty}}; + \node (04) [below of=03,yshift=0.2cm] {\rkt{3}{ocm-struct}}; + \node (05) [below of=04,yshift=0.2cm] {\rkt{2}{measure}}; + \node (06) [below of=05,yshift=0.2cm] {}; + \node (07) [below of=06,yshift=0.2cm] {}; + + \node (10) [left of=00] {\rkt{8}{quick-sample}}; + \node (11) [left of=01] {}; + \node (12) [left of=02] {}; + \node (13) [left of=03] {}; + \node (14) [left of=04] {\rkt{4}{ocm}}; + \node (15) [left of=05] {}; + \node (16) [left of=06] {\rkt{0}{hyphenate}}; + + \node (20) [left of=10] {}; + \node (21) [left of=11] {}; + \node (22) [left of=12] {}; + \node (23) [left of=13] {}; + \node (24) [left of=14] {}; + \node (25) [left of=15] {\rkt{11}{utils}}; + + \node (30) [left of=20] {}; + \node (31) [left of=21] {\rkt{9}{render}}; + \node (32) [left of=22] {}; + \node (33) [left of=23] {\rkt{13}{wrap}}; + \node (35) [left of=25] {}; + + \node (40) [left of=30] {}; + \node (42) [left of=32] {\rkt{6}{quad-main}}; + \node (45) [left of=35] {}; + + \node (50) [left of=40] {\rkt{1}{main}}; + + %% -- edges + %% hyphenate + %\draw[->,yellow!45!orange, line width=2pt] (16) -- (06); + %\draw[->,blue!43!white, line width=2.5pt] (16) -- (07); + %% quick-sample + \draw[->,yellow!45!orange, line width=2pt] (10) -- (01); + %% ocm +%% WARNING: no data for boundary 'ocm-struct.rkt' ==> 'ocm.rkt' + \draw[->] (14) -- (04); + %% utils + \draw[->,yellow!45!orange, line width=2pt] (25) -- (16); + \draw[->,yellow!45!orange, line width=2pt] (25) -- (05); + \draw[->,blue!43!white, line width=2.5pt] (25) -- (01); + \draw[->,yellow!45!orange, line width=2pt] (25) -- (00); + %% render + \draw[->,yellow!45!orange, line width=2pt] (31) -- (00); + \draw[->,blue!43!white, line width=2.5pt] (31) -- (01); + \draw[->,green!48!white, line width=1pt] (31) -- (25); + %% wrap + \draw[->,yellow!45!orange, line width=2pt] (33) -- (00); + \draw[->,blue!43!white, line width=2.5pt] (33) -- (01); +%% WARNING: no data for boundary 'sugar.rkt' ==> 'wrap.rkt' + \draw[->] (33) -- (02); +%% WARNING: no data for boundary 'penalty.rkt' ==> 'wrap.rkt' + \draw[->] (33) -- (03); +%% WARNING: no data for boundary 'ocm-struct.rkt' ==> 'wrap.rkt' + \draw[->] (33) -- (04); + \draw[->,blue!43!white, line width=2.5pt] (33) -- (05); + \draw[->,blue!43!white, line width=2.5pt] (33) -- (14); + \draw[->,green!48!white, line width=1pt] (33) -- (25); + %% quad-main + \draw[->,yellow!45!orange, line width=2pt] (42) -- (00); + \draw[->,yellow!45!orange, line width=2pt] (42) -- (01); + \draw[->,yellow!45!orange, line width=2pt] (42) -- (33); + \draw[->,green!48!white, line width=1pt] (42) -- (05); + \draw[->,green!48!white, line width=1pt] (42) -- (25); +%% WARNING: no data for boundary 'sugar.rkt' ==> 'quad-main.rkt' + \draw[->] (42) -- (02); + %% main + \draw[->,green!48!white, line width=1pt] (50) edge[bend left=35] (00); + \draw[->,green!48!white, line width=1pt] (50) -- (42); + \draw[->,green!48!white, line width=1pt] (50) -- (10); + \draw[->,green!48!white, line width=1pt] (50) -- (31); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/sieve.tex b/icfp-2016/benchmark/modulegraph/data/sieve.tex new file mode 100644 index 0000000..2d07cc9 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/sieve.tex @@ -0,0 +1,11 @@ +%% Total contracts = 8 +%% Total checks = 504220800 +\begin{tikzpicture} + + \node (0) [] {\rkt{1}{streams}}; + \node (1) [left of=0] {\rkt{0}{main}}; + + %% -- edges + \draw[->,red!87!black, line width=3.5pt] (1) -- (0); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/snake.tex b/icfp-2016/benchmark/modulegraph/data/snake.tex new file mode 100644 index 0000000..c46adc0 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/snake.tex @@ -0,0 +1,55 @@ +%% Total contracts = 29 +%% Total checks = 145767614 +\begin{tikzpicture} + + \node (00) [] {}; + \node (01) [below of=00,yshift=0.3cm] {\rkt{3}{data}}; + \node (02) [below of=01,yshift=0.3cm] {}; + + \node (10) [left of=00] {\rkt{1}{const}}; + \node (11) [left of=01] {}; + \node (12) [left of=02] {\rkt{2}{cut-tail}}; + + \node (20) [left of=10] {\rkt{0}{collide}}; + \node (21) [left of=11] {}; + \node (22) [left of=12] {\rkt{6}{motion-help}}; + + \node (30) [left of=20] {}; + \node (31) [left of=21] {}; + \node (32) [left of=22] {\rkt{7}{motion}}; + + \node (40) [left of=30] {\rkt{4}{handlers}}; + \node (41) [left of=31] {}; + \node (42) [left of=32] {}; + + \node (51) [left of=41] {\rkt{5}{main}}; + + %% -- edges +%% WARNING: no data for boundary 'data.rkt' ==> 'const.rkt' + \draw[->] (10) -- (01); +%% WARNING: no data for boundary 'data.rkt' ==> 'cut-tail.rkt' + \draw[->] (12) -- (01); + %% collide + \draw[->,green!48!white, line width=1pt] (20) -- (01); + \draw[->,green!48!white, line width=1pt] (20) -- (10); + %% motion-help +%% WARNING: no data for boundary 'data.rkt' ==> 'motion-help.rkt' + \draw[->] (22) -- (01); + \draw[->,red!87!black, line width=3.5pt] (22) -- (12); + %% motion + \draw[->,green!48!white, line width=1pt] (32) -- (01); + \draw[->,green!48!white, line width=1pt] (32) -- (10); + \draw[->,red!87!black, line width=3.5pt] (32) -- (22); + %% handlers +%% WARNING: no data for boundary 'data.rkt' ==> 'handlers.rkt' + \draw[->] (40) -- (01); + \draw[->,purple!64!white, line width=3pt] (40) -- (32); + \draw[->,green!48!white, line width=1pt] (40) -- (20); + %% main +%% WARNING: no data for boundary 'data.rkt' ==> 'main.rkt' + \draw[->] (51) -- (01); + \draw[->,green!48!white, line width=1pt] (51) -- (10); + \draw[->,purple!64!white, line width=3pt] (51) -- (40); + \draw[->,red!87!black, line width=3.5pt] (51) -- (32); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/suffixtree.tex b/icfp-2016/benchmark/modulegraph/data/suffixtree.tex new file mode 100644 index 0000000..136ebed --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/suffixtree.tex @@ -0,0 +1,34 @@ +%% Total contracts = 66 +%% Total checks = 509650306 +\begin{tikzpicture} + + \node (0) [] {\rkt{0}{data}}; + \node (1) [left of=0] {\rkt{1}{label}}; + \node (2) [left of=1] {\rkt{4}{structs}}; + \node (3) [left of=2] {\rkt{5}{ukkonen}}; + \node (4) [left of=3] {\rkt{2}{lcs}}; + \node (5) [left of=4] {\rkt{3}{main}}; + + %% -- edges + %% label +%% WARNING: no data for boundary 'data.rkt' ==> 'label.rkt' + \draw[->] (1) -- (0); + %% structs +%% WARNING: no data for boundary 'data.rkt' ==> 'structs.rkt' + \draw[->] (2) edge[bend right=35] (0); + \draw[->,red!87!black, line width=3.5pt] (2) -- (1); + %% ukkonen +%% WARNING: no data for boundary 'data.rkt' ==> 'ukkonen.rkt' + \draw[->] (3) edge[bend left=35] (0); + \draw[->,red!87!black, line width=3.5pt] (3) edge[bend left=35] (1); + \draw[->,red!87!black, line width=3.5pt] (3) -- (2); + %% lcs +%% WARNING: no data for boundary 'data.rkt' ==> 'lcs.rkt' + \draw[->] (4) edge[bend right=35] (0); + \draw[->,red!87!black, line width=3.5pt] (4) edge[bend right=35] (1); + \draw[->,blue!43!white, line width=2.5pt] (4) edge[bend right=35] (2); + \draw[->,blue!43!white, line width=2.5pt] (4) -- (3); + %% main + \draw[->,blue!43!white, line width=2.5pt] (5) -- (4); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/synth.tex b/icfp-2016/benchmark/modulegraph/data/synth.tex new file mode 100644 index 0000000..1edeeb5 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/synth.tex @@ -0,0 +1,67 @@ +%% Total contracts = 65 +%% Total checks = 52988839 +\begin{tikzpicture} + + \node (00) [] {\rkt{3}{array-utils}}; + \node (01) [below of=00,yshift=0.3cm] {}; + \node (02) [below of=01,yshift=0.3cm] {\rkt{4}{data}}; + + \node (10) [left of=00] {}; + \node (11) [left of=01] {\rkt{1}{array-struct}}; + \node (12) [left of=02] {}; + + \node (20) [left of=10] {\rkt{0}{array-broadcast}}; + \node (21) [left of=11] {}; + \node (22) [left of=12] {\rkt{9}{synth}}; + + \node (30) [left of=20] {\rkt{2}{array-transform}}; + \node (31) [left of=21] {}; + \node (32) [left of=22] {\rkt{7}{mixer}}; + + \node (40) [left of=30] {\rkt{8}{sequencer}}; + \node (41) [left of=31] {}; + \node (42) [left of=32] {\rkt{5}{drum}}; + + \node (51) [left of=41] {\rkt{6}{main}}; + + %% -- edges + %% array broadcast + \draw[->,yellow!45!orange, line width=2pt] (20) -- (11); + \draw[->,green!48!white, line width=1pt] (20) -- (00); +%% WARNING: no data for boundary 'data.rkt' ==> 'array-broadcast.rkt' + \draw[->] (20) edge[bend left=15] (02); + %% array-struct + \draw[->,blue!43!white, line width=2.5pt] (11) -- (00); +%% WARNING: no data for boundary 'data.rkt' ==> 'array-struct.rkt' + \draw[->] (11) -- (02); + %% array-transform + \draw[->,yellow!45!orange, line width=2pt] (30) -- (20); + \draw[->,red!87!black, line width=3.5pt] (30) -- (11); + \draw[->,purple!64!white, line width=3pt] (30) edge[bend left=35] (00); +%% WARNING: no data for boundary 'data.rkt' ==> 'array-transform.rkt' + \draw[->] (30) -- (02); + %% drum + \draw[->,blue!43!white, line width=2.5pt] (42) -- (11); + \draw[->,green!48!white, line width=1pt] (42) -- (30); + \draw[->,blue!43!white, line width=2.5pt] (42) -- (00); +%% WARNING: no data for boundary 'data.rkt' ==> 'drum.rkt' + \draw[->] (42) edge[bend right=35] (02); + \draw[->,green!48!white, line width=1pt] (42) edge[bend right=35] (22); + %% main + \draw[->,green!48!white, line width=1pt] (51) -- (42); + \draw[->,green!48!white, line width=1pt] (51) -- (32); + \draw[->,purple!64!white, line width=3pt] (51) -- (40); + \draw[->,purple!64!white, line width=3pt] (51) -- (22); + %% mixer + \draw[->,purple!64!white, line width=3pt] (32) -- (20); + \draw[->,red!87!black, line width=3.5pt] (32) -- (11); + %% sequencer + \draw[->,purple!64!white, line width=3pt] (40) -- (11); + \draw[->,green!48!white, line width=1pt] (40) -- (30); + \draw[->,green!48!white, line width=1pt] (40) -- (32); + \draw[->,green!48!white, line width=1pt] (40) -- (22); + %% synth + \draw[->,red!87!black, line width=3.5pt] (22) -- (11); + \draw[->,red!87!black, line width=3.5pt] (22) -- (00); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/tetris.tex b/icfp-2016/benchmark/modulegraph/data/tetris.tex new file mode 100644 index 0000000..44b0450 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/tetris.tex @@ -0,0 +1,71 @@ +%% Total contracts = 55 +%% Total checks = 171340108 +\begin{tikzpicture} + + \node (00) [] {\rkt{3}{consts}}; + \node (01) [below of=00,yshift=0.3cm] {}; + \node (02) [below of=01,yshift=0.3cm] {\rkt{4}{data}}; + + \node (10) [left of=00] {}; + \node (11) [left of=01] {}; + \node (12) [left of=02] {\rkt{1}{block}}; + + \node (20) [left of=10] {\rkt{2}{bset}}; + \node (21) [left of=11] {}; + \node (22) [left of=12] {}; + + \node (30) [left of=20] {\rkt{5}{elim}}; + \node (31) [left of=21] {}; + \node (32) [left of=22] {\rkt{7}{tetras}}; + + \node (40) [left of=30] {}; + \node (41) [left of=31] {}; + \node (42) [left of=32] {\rkt{0}{aux}}; + + \node (50) [left of=40] {\rkt{8}{world}}; + \node (51) [left of=41] {}; + \node (52) [left of=42] {}; + + \node (61) [left of=51] {\rkt{6}{main}}; + + %% -- edges + %% block + \draw[->,green!48!white, line width=1pt] (12) -- (02); + %% bset + \draw[->,green!48!white, line width=1pt] (20) -- (00); +%% WARNING: no data for boundary 'data.rkt' ==> 'bset.rkt' + \draw[->] (20) -- (02); + \draw[->,purple!64!white, line width=3pt] (20) -- (12); + %% elim + \draw[->,green!48!white, line width=1pt] (30) edge[bend left=35] (00); +%% WARNING: no data for boundary 'data.rkt' ==> 'elim.rkt' + \draw[->] (30) -- (02); + \draw[->,red!87!black, line width=3.5pt] (30) -- (20); + %% tetras +%% WARNING: no data for boundary 'consts.rkt' ==> 'tetras.rkt' + \draw[->] (32) -- (00); +%% WARNING: no data for boundary 'data.rkt' ==> 'tetras.rkt' + \draw[->] (32) edge[bend right=35] (02); +%% WARNING: no data for boundary 'block.rkt' ==> 'tetras.rkt' + \draw[->] (32) -- (12); + \draw[->,blue!43!white, line width=2.5pt] (32) -- (20); + %% aux +%% WARNING: no data for boundary 'data.rkt' ==> 'aux.rkt' + \draw[->] (42) edge[bend right=35] (02); + \draw[->,green!48!white, line width=1pt] (42) -- (32); + %% world + \draw[->,green!48!white, line width=1pt] (50) edge[bend left=35] (00); +%% WARNING: no data for boundary 'data.rkt' ==> 'world.rkt' + \draw[->] (50) -- (02); + \draw[->,purple!64!white, line width=3pt] (50) edge[bend left=35] (20); + \draw[->,blue!43!white, line width=2.5pt] (50) -- (30); + \draw[->,blue!43!white, line width=2.5pt] (50) -- (32); + \draw[->,blue!43!white, line width=2.5pt] (50) -- (42); + %% main +%% WARNING: no data for boundary 'data.rkt' ==> 'main.rkt' + \draw[->] (61) -- (02); + \draw[->,green!48!white, line width=1pt] (61) -- (20); + \draw[->,green!48!white, line width=1pt] (61) -- (42); + \draw[->,blue!43!white, line width=2.5pt] (61) -- (50); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/zombie.tex b/icfp-2016/benchmark/modulegraph/data/zombie.tex new file mode 100644 index 0000000..cd699e0 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/zombie.tex @@ -0,0 +1,13 @@ +\begin{tikzpicture} + + \node (00) [] {\rkt{0}{image}}; + \node (01) [below of=00] {\rkt{2}{math}}; + \node (10) [left of=00] {\rkt{3}{zombie}}; + \node (20) [left of=10] {\rkt{1}{main}}; + + \draw[->] (10) -- (00); + \draw[->] (10) -- (01); + \draw[->] (20) -- (00); + \draw[->] (20) -- (10); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/data/zordoz.tex b/icfp-2016/benchmark/modulegraph/data/zordoz.tex new file mode 100644 index 0000000..bab1768 --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/data/zordoz.tex @@ -0,0 +1,29 @@ +%% Total contracts = 277 +%% Total checks = 584186 +\begin{tikzpicture} + + \node (00) [] {\rkt{3}{zo-string}}; + \node (01) [below of=00,yshift=0.3cm] {}; + \node (02) [below of=01,yshift=0.3cm] {\rkt{4}{zo-transition}}; + + \node (10) [left of=00] {}; + \node (11) [left of=01] {\rkt{1}{zo-find}}; + \node (12) [left of=02] {}; + + \node (20) [left of=10] {}; + \node (21) [left of=11] {\rkt{2}{zo-shell}}; + \node (22) [left of=12] {}; + + \node (30) [left of=20] {}; + \node (31) [left of=21] {\rkt{0}{main}}; + \node (32) [left of=22] {}; + + %% -- edges + \draw[->,green!48!white, line width=1pt] (11) -- (00); + \draw[->,green!48!white, line width=1pt] (11) -- (02); + \draw[->,green!48!white, line width=1pt] (21) edge[bend left=35] (00); + \draw[->,green!48!white, line width=1pt] (21) edge[bend right=35] (02); + \draw[->,yellow!45!orange, line width=2pt] (21) -- (11); + \draw[->,green!48!white, line width=1pt] (31) -- (21); + +\end{tikzpicture} diff --git a/icfp-2016/benchmark/modulegraph/post/main.rkt b/icfp-2016/benchmark/modulegraph/post/main.rkt new file mode 100644 index 0000000..6a6950e --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/post/main.rkt @@ -0,0 +1,665 @@ +#lang typed/racket/base +(require trivial/no-colon) + +;; Utilities for working with modules graphs. +;; +;; The source of truth are TiKZ'd module graphs +;; (because their layout requires human intervention) +;; so this file provides a (brittle) parser. + +(provide: + (project-name->modulegraph (-> String ModuleGraph)) + (directory->modulegraph (-> Path-String ModuleGraph)) + ;; Parse a directory into a module graph. + ;; Does not collect module dependency information. + + (tex->modulegraph (-> Path-String ModuleGraph)) + ;; Parse a tex file into a module graph + + (modulegraph->tex (-> ModuleGraph Output-Port Void)) + ;; Print a modulegraph to .tex + + (boundaries (-> ModuleGraph (Listof Boundary))) + ;; Return a list of identifier-annotated edges in the program + ;; Each boundary is a list (TO FROM PROVIDED) + ;; where PROVIDED is a list of type Provided (see the data definition below for 'struct provided') + + (boundary-to (-> Boundary String)) + (boundary-from (-> Boundary String)) + (boundary-provided* (-> Boundary (Listof Provided))) + + (in-edges (-> ModuleGraph (Sequenceof (Pairof String String)))) + ;; Iterate through the edges in a module graph. + ;; Each edges is a pair of (TO . FROM) + ;; the idea is, each edges is a "require" from TO to FROM + ;; Order of edges is unspecified. + + (module-names (-> ModuleGraph (Listof String))) + ;; Return a list of all module names in the project + + (path->project-name (-> Path-String String)) + ;; Parse a project's name from a filename. + + (project-name (-> ModuleGraph String)) + ;; Get the project name direct from the modulegraph + + (name->index (-> ModuleGraph String Natural)) + ;; Get the module's index into bitstrings + + (index->name (-> ModuleGraph Natural String)) + + (provides (-> ModuleGraph String (Listof String))) + ;; List of modules that require the given one; i.e., modules the current provides to + + (requires (-> ModuleGraph String (Listof String))) + ;; (-> ModuleGraph String (Listof String)) + ;; List of modules required by the given one + + (strip-suffix (-> Path-String String)) + ;; Remove the file extension from a path string + + (infer-project-dir (-> String Path-String)) + ;; Guess where the project is located in the GTP repo +) +(provide + Boundary + (struct-out modulegraph) + ModuleGraph + (struct-out provided) + Provided +) + +;; ----------------------------------------------------------------------------- + +(require + glob/typed + racket/match + (only-in racket/system system) + (only-in racket/port with-output-to-string) + (only-in racket/list make-list last drop-right) + (only-in racket/path file-name-from-path filename-extension) + (only-in racket/sequence sequence->list) + (only-in racket/string string-split string-contains? string-trim string-join) +) +(require/typed syntax/modcode + (get-module-code + (-> Path Any))) +(require/typed racket/string + (string-contains? (-> String String Any))) + +;; ============================================================================= +;; --- data definition: modulegraph + +;; A module graph is represented as an adjacency list (all graphs are DAGs) +;; Invariant: names in the adjlist are kept in alphabetical order. +(struct modulegraph ( + [project-name : String] + [adjlist : AdjList] + [src : (U #f Path-String)] +) #:transparent) +(define-type AdjList (Listof (Listof String))) +(define-type ModuleGraph modulegraph) + +(: adjlist-add-edge (-> AdjList String String AdjList)) +(define (adjlist-add-edge A* from to) + (define found? : (Boxof Boolean) (box #f)) + (define res : AdjList + (for/list : AdjList + ([src+dst* (in-list A*)]) + (define src (car src+dst*)) + (define dst* (cdr src+dst*)) + (if (string=? from src) + (begin + (when (unbox found?) + (raise-user-error 'adjlist-add-edge + (format "Malformed adjacency list, node '~a' appears twice" from))) + (set-box! found? #t) + (if (member to dst*) + ;; Already exists? That's fine + src+dst* + (list* src to dst*))) + src+dst*))) + (if (unbox found?) + res + (cons (list from to) res))) + +(: in-edges (-> ModuleGraph (Listof (Pairof String String)))) +(define (in-edges G) + (for*/list : (Listof (Pairof String String)) + ([src+dst* (in-list (modulegraph-adjlist G))] + [dst (in-list (cdr src+dst*))]) + (cons (car src+dst*) dst))) + +;; Get the name of the project represented by a module graph +(: project-name (-> ModuleGraph String)) +(define (project-name mg) + (modulegraph-project-name mg)) + +;; Get the names of all modules in this graph's project +(: module-names (-> ModuleGraph (Listof String))) +(define (module-names mg) + (for/list ([node+neighbors (in-list (modulegraph-adjlist mg))]) + (car node+neighbors))) + +(: name->index (-> ModuleGraph String Natural)) +(define (name->index mg name) + (: maybe-i (U #f Natural)) + (define maybe-i + ;; Simulated for/first + (let loop ([i : Natural 0] [n+n (modulegraph-adjlist mg)]) + (if (string=? name (caar n+n)) + i + (loop (add1 i) (cdr n+n))))) + (or maybe-i + (error 'name->index (format "Invalid module name ~a" name)))) + +(: index->name (-> ModuleGraph Natural String)) +(define (index->name mg i) + (car (list-ref (modulegraph-adjlist mg) i))) + +(: requires (-> ModuleGraph String (Listof String))) +(define (requires mg name) + (or + (adjlist->dst* (modulegraph-adjlist mg) name) + (raise-user-error 'modulegraph (format "Module '~a' is not part of graph '~a'" name mg)))) + +(: adjlist->dst* (-> AdjList String (U #f (Listof String)))) +(define (adjlist->dst* adj name) + (for/or : (U #f (Listof String)) + ([src+dst* (in-list adj)]) + (and + (string=? name (car src+dst*)) + (cdr src+dst*)))) + +(: provides (-> ModuleGraph String (Listof String))) +(define (provides mg name) + (adjlist->src* (modulegraph-adjlist mg) name)) + +(: adjlist->src* (-> AdjList String (Listof String))) +(define (adjlist->src* adj name) + (for/list : (Listof String) + ([node+neighbors : (Listof String) (in-list adj)] + #:when (member name (cdr node+neighbors))) + (car node+neighbors))) + +;; ============================================================================= +;; --- data definition: provided / required + +(struct provided ( + [>symbol : Symbol] ;; Name of provided identifier + [syntax? : Boolean] ;; If #t, identifier is exported syntax or renamed + [history : (U #f (Listof Any))] + ;; If #f, means id was defined in the module + ;; Otherwise, is a flat list of id's history +) #:transparent ) +(define-type Provided provided) + +;; TODO should to/from by symbols? +(define-type Boundary (List String String (Listof Provided))) +(define boundary-to car) +(define boundary-from cadr) +(define boundary-provided* caddr) +;; For now, I guess we don't need a struct + +;; Return a list of: +;; (TO FROM PROVIDED) +;; corresponding to the edges of modulegraph `G`. +;; This decorates each edges with the identifiers provided from a module +;; and required into another. +(: boundaries (-> ModuleGraph (Listof Boundary))) +(define (boundaries G) + ;; Reclaim source directory + (define src (infer-untyped-dir + (or (modulegraph-src G) (infer-project-dir (modulegraph-project-name G))))) + (define name* (module-names G)) + (define from+provided** + (for/list : (Listof (Pairof String (Listof Provided))) + ([name (in-list name*)]) + ((inst cons String (Listof Provided)) + name + (absolute-path->provided* (build-path src (string-append name ".rkt")))))) + (for/list : (Listof Boundary) + ([to+from (in-edges G)]) + (define to (car to+from)) + (define from (cdr to+from)) + (define maybe-provided* (assoc from from+provided**)) + (if maybe-provided* + (list to from (cdr maybe-provided*)) + (raise-user-error 'boundaries (format "Failed to get provides for module '~a'" from))))) + +(: absolute-path->provided* (-> Path (Listof Provided))) +(define (absolute-path->provided* p) + (define cm (cast (compile (get-module-code p)) Compiled-Module-Expression)) + (define-values (p* s*) (module-compiled-exports cm)) + (append + (parse-provided p*) + (parse-provided s* #:syntax? #t))) + +(define-type RawProvided + (Pairof (U #f Integer) + (Listof (List Symbol History)))) +(define-type History (Listof Any)) ;; Lazy + +(: parse-provided (->* [(Listof RawProvided)] [#:syntax? Boolean] (Listof Provided))) +(define (parse-provided p* #:syntax? [syntax? #f]) + (define p0 + (apply append + (for/list : (Listof (Listof (List Symbol History))) + ([p (in-list p*)] #:when (and (car p) (zero? (car p)))) + (define p+ (cdr p)) + (if (and (not (null? p+)) + (symbol? (car p+))) + (list p+) + p+)))) + (for/list : (Listof Provided) + ([p : (List Symbol History) (in-list p0)]) + (define name (car p)) + (define history (cadr p)) + (provided name syntax? (and (not (null? history)) history)))) + +;; ----------------------------------------------------------------------------- +;; --- parsing TiKZ + +(struct texnode ( + [id : Index] + [index : Index] + [name : String] +) #:transparent) +;; A `texedge` is a (Pairof Index Index) +(define-type texedge (Pairof Index Index)) + +(define-syntax-rule (parse-error msg arg* ...) + (error 'modulegraph (format msg arg* ...))) + +(: rkt-file? (-> Path-String Boolean)) +(define (rkt-file? p) + (regexp-match? #rx"\\.rkt$" (if (string? p) p (path->string p)))) + +(: project-name->modulegraph (-> String ModuleGraph)) +(define (project-name->modulegraph name) + (directory->modulegraph (infer-project-dir name))) + +(: directory->modulegraph (-> Path-String ModuleGraph)) +(define (directory->modulegraph dir) + (define u-dir (infer-untyped-dir dir)) + ;; No edges, just nodes + (: adjlist AdjList) + (define adjlist (directory->adjlist u-dir)) + (modulegraph (path->project-name dir) adjlist dir)) + +(: get-git-root (-> String)) +(define (get-git-root) + (define ok? : (Boxof Boolean) (box #t)) + (define outs + (with-output-to-string + (lambda () + (set-box! ok? (system "git rev-parse --show-toplevel"))))) + (if (and (unbox ok?) (string-contains? outs "gradual-typing-performance")) + (string-trim outs) + (raise-user-error 'modulegraph "Must be in `gradual-typing-performance` repo to use script"))) + +;; Blindly search for a directory called `name`. +(: infer-project-dir (-> String Path)) +(define (infer-project-dir name) + (define p-dir (build-path (get-git-root) "benchmarks" name)) + (if (directory-exists? p-dir) + p-dir + (raise-user-error 'modulegraph "Failed to find project directory for '~a', cannot summarize data" name))) + +(: infer-untyped-dir (-> Path-String Path)) +(define (infer-untyped-dir dir) + (define u-dir (build-path dir "untyped")) + (if (directory-exists? u-dir) + u-dir + (raise-user-error 'modulegraph "Failed to find untyped code for '~a', cannot summarize data" dir))) + +;; Interpret a .tex file containing a TiKZ picture as a module graph +(: tex->modulegraph (-> Path-String ModuleGraph)) +(define (tex->modulegraph filename) + (define-values (path project-name) (ensure-tex filename)) + (call-with-input-file* filename + (lambda ([port : Input-Port]) + (ensure-tikz port) + (define-values (edge1 tex-nodes) (parse-nodes port)) + (define tex-edges (cons edge1 (parse-edges port))) + (texnode->modulegraph project-name tex-nodes tex-edges)))) + +;; Verify that `filename` is a tex file, return the name of +;; the project it describes. +(: ensure-tex (-> Path-String (Values Path String))) +(define (ensure-tex filename) + (define path (or (and (path? filename) filename) + (string->path filename))) + (unless (bytes=? #"tex" (or (filename-extension path) #"")) + (parse-error "Cannot parse module graph from non-tex file '~a'" filename)) + ;; Remove anything past the first hyphen in the project name + (define project-name (path->project-name path)) + (values path project-name)) + +;; Parse the project's name from a path +(: path->project-name (-> Path-String String)) +(define (path->project-name ps) + (define p : Path + (cond + [(path? ps) ps] + [(string? ps) (string->path ps)] + [else (raise-user-error 'path->project-name ps)])) + (define s : String + (path->string + (or (file-name-from-path p) + (raise-user-error 'path->project-name (format "Could not get filename from path '~a'" p))))) + (define without-dir + (last (string-split s "/"))) + (define without-ext + (strip-suffix without-dir)) + (define without-hyphen + (car (string-split without-ext "-"))) + without-hyphen) + +;; Verify that the lines contained in `port` contain a TiKZ picture +;; Advance the port +(: ensure-tikz (-> Input-Port Void)) +(define (ensure-tikz port) + (define line (read-line port)) + (cond [(eof-object? line) + ;; No more input = failed to read a module graph + (parse-error "Input is not a TiKZ picture")] + [(string=? "\\begin{tikzpicture}" (string-trim line)) + ;; Success! We have id'd this file as a TiKZ picture + (void)] + [else + ;; Try again with what's left + (ensure-tikz port)])) + +;; Parse consecutive `\node` declarations in a TiKZ file, +;; ignoring blank spaces and comments. +(: parse-nodes (->* [Input-Port] [(Listof texnode)] (Values texedge (Listof texnode)))) +(define (parse-nodes port [nodes-acc '()]) + (define raw-line (read-line port)) + (define line + (if (eof-object? raw-line) + ;; EOF here means there's no edges below + (parse-error "Hit end-of-file while reading nodes. Module graphs must have edges.") + (string-trim raw-line))) + (cond + [(< (string-length line) 4) + ;; Degenerate line, can't contain anything useful + (parse-nodes port nodes-acc)] + [(equal? #\% (string-ref line 0)) + ;; Line is a comment, ignore + (parse-nodes port nodes-acc)] + [(string=? "\\node" (substring line 0 5)) + ;; Found node! Keep if it's a real node (not just for positioning), then continue parsing + (define nodes-acc+ + (if (dummy-node? line) + nodes-acc + (cons (string->texnode line) nodes-acc))) + (parse-nodes port nodes-acc+)] + [(string=? "\\draw" (substring line 0 5)) + ;; Found edge, means this stage of parsing is over + (values (string->texedge line) nodes-acc)] + [else + ;; Invalid input + (parse-error "Cannot parse node from line '~a'" line)])) + +;; Parse consecutive `\edge` declarations, ignore blanks and comments. +(: parse-edges (->* [Input-Port] [(Listof texedge)] (Listof texedge))) +(define (parse-edges port [edges-acc '()]) + (define raw-line (read-line port)) + (define line + (if (eof-object? raw-line) + ;; End of file; should have seen \end{tikzpicture} + (parse-error "Parsing reached end-of-file before reading \end{tikzpicture}. Are you sure the input is valid .tex?") + (string-trim raw-line))) + (cond + [(< (string-length line) 4) + ;; Degenerate line, can't contain anything useful + (parse-edges port edges-acc)] + [(equal? #\% (string-ref line 0)) + ;; Line is a comment, ignore + (parse-edges port edges-acc)] + [(string=? "\\draw" (substring line 0 5)) + ;; Found edge! Parse and recurse + (parse-edges port (cons (string->texedge line) edges-acc))] + [(string=? "\\node" (substring line 0 5)) + ;; Should never see nodes here + (parse-error "Malformed TiKZ file: found node while reading edges.")] + [(string=? "\\end{tikzpicture}" line) + ;; End of picture, we're done! + edges-acc] + [else + ;; Invalid input + (parse-error "Cannot parse edge from line '~a'" line)])) + +;; For parsing nodes: +;; \node (ID) [pos]? {\rkt{ID}{NAME}}; +(define: NODE_REGEXP + #rx"^\\\\node *\\(([0-9]+)\\) *(\\[.*\\]) *\\{\\\\rkt\\{([0-9]+)\\}\\{(.+)\\}\\};$") +;; For parsing edges +;; \draw[style]? (ID) edge (ID); +(define: EDGE_REGEXP + #rx"^\\\\draw\\[.*\\]? *\\(([0-9]+)\\)[^(]*\\(([0-9]+)\\);$") + +;; Parsing +(: string->index (-> String Index)) +(define (string->index str) + (cast (string->number str) Index)) + +;; Check if a line represents a real node, or is just for positioning +(: dummy-node? (-> String Boolean)) +(define (dummy-node? str) + (define N (string-length str)) + (and (>= N 3) + (string=? "{};" (substring str (- N 3) N)))) + +;; Parse a string into a texnode struct. +(: string->texnode (-> String texnode)) +(define (string->texnode str) + (define m (regexp-match NODE_REGEXP str)) + (if m + (texnode (string->index (cadr m)) + (string->index (cadddr m)) + (cadr (cdddr m))) + (parse-error "Cannot parse node declaration '~a'" str))) + +;; Parse a string into a tex edge. +;; Edges are represented as cons pairs of their source and destination. +;; Both source and dest. are represented as indexes. +(: string->texedge (-> String texedge)) +(define (string->texedge str) + (define m (regexp-match EDGE_REGEXP str)) + (if m + (cons + (string->index (cadr m)) + (string->index (caddr m))) + (parse-error "Cannot parse edge declaration '~a'" str))) + +;; Convert nodes & edges parsed from a .tex file to a modulegraph struct +(: texnode->modulegraph (-> String (Listof texnode) (Listof texedge) ModuleGraph)) +(define (texnode->modulegraph project-name nodes edges) + ;; Convert a TiKZ node id to a module name + (: id->name (-> Index String)) + (define (id->name id) + (or (for/or : (U #f String) ([tx (in-list nodes)]) + (and (= id (texnode-id tx)) + (texnode-name tx))) + (error 'texnode->modulegraph (format "Could not convert tikz node id ~a to a module name" id)))) + ;; Create an adjacency list by finding the matching edges for each node + (: adjlist (Listof (Pairof (Pairof Index String) (Listof String)))) + (define adjlist + (for/list + ([tx : texnode (in-list nodes)]) + (: hd (Pairof Index String)) + (define hd (cons (texnode-index tx) (texnode-name tx))) + (: rest (Listof String)) + (define rest + (for/list + ([src+dst : texedge (in-list edges)] + #:when (= (texnode-id tx) (car src+dst))) + (id->name (cdr src+dst)))) + ((inst cons (Pairof Index String) (Listof String)) + hd rest))) + ;; Alphabetically sort the adjlist, check that the indices match the ordering + ;; Need to append .rkt, else things like (string< "a-base" "a") fail. They should pass... + (: get-key (-> (Pairof (Pairof Index String) (Listof String)) String)) + (define (get-key x) + (string-append (cdar x) ".rkt")) + (define sorted ((inst sort (Pairof (Pairof Index String) (Listof String)) String) + adjlist stringlist (in-range (length sorted)))) + (parse-error "Indices do not match alphabetical ordering on module names. Is the TiKZ graph correct?\n Source: '~a'\n" (for/list : (Listof Any) ([x (in-list sorted)]) (car x)))) + ;; Drop the indices + (define untagged : (Listof (Listof String)) + (for/list ([tag+neighbors (in-list sorted)]) + (cons (cdar tag+neighbors) (cdr tag+neighbors)))) + (modulegraph project-name untagged #f)) + +(: directory->adjlist (-> Path AdjList)) +(define (directory->adjlist dir) + (define abs-path* (glob (format "~a/*.rkt" (path->string dir)))) + (define src-name* + (for/list : (Listof String) + ([path-str (in-list abs-path*)]) + (strip-suffix (strip-directory (string->path path-str))))) + ;; Build modulegraph + (for/list : AdjList + ([abs-path (in-list abs-path*)] + [src-name (in-list src-name*)]) + (cons src-name + (for/list : (Listof String) + ([mod-abspath (in-list (absolute-path->imports abs-path))] + #:when (member (strip-suffix mod-abspath) src-name*)) + (strip-suffix mod-abspath))))) + +(: absolute-path->imports (-> Path-String (Listof Path))) +(define (absolute-path->imports ps) + (define p (if (path? ps) ps (string->path ps))) + (define mc (cast (compile (get-module-code p)) Compiled-Module-Expression)) + (for/fold : (Listof Path) + ([acc : (Listof Path) '()]) + ([mpi (in-list (apply append (module-compiled-imports mc)))]) + (if (module-path-index? mpi) + (let-values (((name _2) (module-path-index-split mpi))) + (if (string? name) + (cons (string->path name) acc) + acc)) + acc))) + +(define RX-REQUIRE: #rx"require.*\"(.*)\\.rkt\"") + +;; Sort an adjacency list in order of transitive indegree, increasing. +;; Results are grouped by indegree, i.e. +;; - 1st result = list of 0-indegree nodes +;; - 2nd result = list of 1-indegree nodes +;; - ... +(: topological-sort (-> AdjList (Listof (Listof String)))) +(define (topological-sort adj) + (: indegree-map (HashTable String Integer)) + (define indegree-map + (make-hash (for/list : (Listof (Pairof String Integer)) + ([src+dst* (in-list adj)]) + (cons (car src+dst*) (length (cdr src+dst*)))))) + (reverse + (let loop ([acc : (Listof (Listof String)) '()]) + (cond + [(zero? (hash-count indegree-map)) + acc] + [else + (define zero-indegree* + (for/list : (Listof String) + ([(k v) (in-hash indegree-map)] + #:when (zero? v)) k)) + (for ([k (in-list zero-indegree*)]) + (hash-remove! indegree-map k) + (define src* (adjlist->src* adj k)) + (for ([src (in-list src*)]) + (hash-set! indegree-map src + (- (hash-ref indegree-map src (lambda () -1)) 1)))) + (loop (cons (sort zero-indegree* stringtikz (-> Path Path-String Void)) +(define (directory->tikz p out-file) + (define MG (directory->modulegraph p)) + (with-output-to-file out-file #:exists 'replace + (lambda () (modulegraph->tex MG (current-output-port))))) + +(: modulegraph->tex (-> ModuleGraph Output-Port Void)) +(define (modulegraph->tex MG out) + (define tsort (topological-sort (modulegraph-adjlist MG))) + (parameterize ([current-output-port out]) + (displayln "\\begin{tikzpicture}\n") + ;; -- draw nodes + (: name+tikzid* (Listof (Pairof String String))) + (define name+tikzid* + (apply append + (for/list : (Listof (Listof (Pairof String String))) + ([group (in-list tsort)] + [g-id (in-naturals)]) + (for/list : (Listof (Pairof String String)) + ([name (in-list group)] + [n-id (in-naturals)]) + (define tikzid (format "~a~a" g-id n-id)) + (define pos + (cond + [(and (zero? g-id) (zero? n-id)) ""] + [(zero? n-id) (format "[left of=~a,xshift=-2cm]" (decr-left tikzid))] + [else (format "[below of=~a,yshift=-1cm]" (decr-right tikzid))])) + (printf " \\node (~a) ~a {\\rkt{~a}{~a}};\n" + tikzid pos (name->index MG name) name) + (cons name tikzid))))) + (newline) + ;; -- draw edges + (: get-tikzid (-> String String)) + (define (get-tikzid name) + (cdr (or (assoc name name+tikzid*) (error 'NONAME)))) + (for* ([group (in-list tsort)] + [name (in-list group)] + [req (in-list (requires MG name))]) + (printf " \\draw[->] (~a) -- (~a);\n" + (get-tikzid name) + (get-tikzid req))) + (displayln "\n\\end{tikzpicture}"))) + +(: decr-right (-> String String)) +(define (decr-right str) + (decr-str str #f #t)) + +(: decr-left (-> String String)) +(define (decr-left str) + (decr-str str #t #f)) + +(: decr-str (-> String Boolean Boolean String)) +(define (decr-str str left? right?) + (define left-char (string-ref str 0)) + (define right-char (string-ref str 1)) + (string (if left? (decr-char left-char) left-char) + (if right? (decr-char right-char) right-char))) + +(: decr-char (-> Char Char)) +(define (decr-char c) + (integer->char (sub1 (char->integer c)))) + +(: strip-suffix (-> Path-String String)) +(define (strip-suffix p) + (define p+ (if (path? p) p (string->path p))) + (path->string (path-replace-suffix p+ ""))) + +(: strip-directory (-> Path-String String)) +(define (strip-directory ps) + (define p (if (path? ps) ps (string->path ps))) + (path->string (assert (last (explode-path p)) path?))) + +;; ============================================================================= + +(define (main) + (for ([fname (in-glob "../data/*.tex")]) + (tex->modulegraph fname))) + + +(time (main)) diff --git a/icfp-2016/benchmark/modulegraph/pre/main.rkt b/icfp-2016/benchmark/modulegraph/pre/main.rkt new file mode 100644 index 0000000..758d97e --- /dev/null +++ b/icfp-2016/benchmark/modulegraph/pre/main.rkt @@ -0,0 +1,670 @@ +#lang typed/racket/base + +;; Utilities for working with modules graphs. +;; +;; The source of truth are TiKZ'd module graphs +;; (because their layout requires human intervention) +;; so this file provides a (brittle) parser. + +(provide: + (project-name->modulegraph (-> String ModuleGraph)) + (directory->modulegraph (-> Path-String ModuleGraph)) + ;; Parse a directory into a module graph. + ;; Does not collect module dependency information. + + (tex->modulegraph (-> Path-String ModuleGraph)) + ;; Parse a tex file into a module graph + + (modulegraph->tex (-> ModuleGraph Output-Port Void)) + ;; Print a modulegraph to .tex + + (boundaries (-> ModuleGraph (Listof Boundary))) + ;; Return a list of identifier-annotated edges in the program + ;; Each boundary is a list (TO FROM PROVIDED) + ;; where PROVIDED is a list of type Provided (see the data definition below for 'struct provided') + + (boundary-to (-> Boundary String)) + (boundary-from (-> Boundary String)) + (boundary-provided* (-> Boundary (Listof Provided))) + + (in-edges (-> ModuleGraph (Sequenceof (Pairof String String)))) + ;; Iterate through the edges in a module graph. + ;; Each edges is a pair of (TO . FROM) + ;; the idea is, each edges is a "require" from TO to FROM + ;; Order of edges is unspecified. + + (module-names (-> ModuleGraph (Listof String))) + ;; Return a list of all module names in the project + + (path->project-name (-> Path-String String)) + ;; Parse a project's name from a filename. + + (project-name (-> ModuleGraph String)) + ;; Get the project name direct from the modulegraph + + (name->index (-> ModuleGraph String Natural)) + ;; Get the module's index into bitstrings + + (index->name (-> ModuleGraph Natural String)) + + (provides (-> ModuleGraph String (Listof String))) + ;; List of modules that require the given one; i.e., modules the current provides to + + (requires (-> ModuleGraph String (Listof String))) + ;; (-> ModuleGraph String (Listof String)) + ;; List of modules required by the given one + + (strip-suffix (-> Path-String String)) + ;; Remove the file extension from a path string + + (infer-project-dir (-> String Path-String)) + ;; Guess where the project is located in the GTP repo +) +(provide + Boundary + (struct-out modulegraph) + ModuleGraph + (struct-out provided) + Provided +) + +;; ----------------------------------------------------------------------------- + +(require + glob/typed + racket/match + (only-in racket/system system) + (only-in racket/port with-output-to-string) + (only-in racket/list make-list last drop-right) + (only-in racket/path file-name-from-path filename-extension) + (only-in racket/sequence sequence->list) + (only-in racket/string string-split string-contains? string-trim string-join) +) +(require/typed syntax/modcode + (get-module-code + (-> Path Any))) +(require/typed racket/string + (string-contains? (-> String String Any))) + +;; ============================================================================= +;; --- data definition: modulegraph + +;; A module graph is represented as an adjacency list (all graphs are DAGs) +;; Invariant: names in the adjlist are kept in alphabetical order. +(struct modulegraph ( + [project-name : String] + [adjlist : AdjList] + [src : (U #f Path-String)] +) #:transparent) +(define-type AdjList (Listof (Listof String))) +(define-type ModuleGraph modulegraph) + +(: adjlist-add-edge (-> AdjList String String AdjList)) +(define (adjlist-add-edge A* from to) + (define found? : (Boxof Boolean) (box #f)) + (define res : AdjList + (for/list : AdjList + ([src+dst* (in-list A*)]) + (define src (car src+dst*)) + (define dst* (cdr src+dst*)) + (if (string=? from src) + (begin + (when (unbox found?) + (raise-user-error 'adjlist-add-edge + (format "Malformed adjacency list, node '~a' appears twice" from))) + (set-box! found? #t) + (if (member to dst*) + ;; Already exists? That's fine + src+dst* + (list* src to dst*))) + src+dst*))) + (if (unbox found?) + res + (cons (list from to) res))) + +(: in-edges (-> ModuleGraph (Listof (Pairof String String)))) +(define (in-edges G) + (for*/list : (Listof (Pairof String String)) + ([src+dst* (in-list (modulegraph-adjlist G))] + [dst (in-list (cdr src+dst*))]) + (cons (car src+dst*) dst))) + +;; Get the name of the project represented by a module graph +(: project-name (-> ModuleGraph String)) +(define (project-name mg) + (modulegraph-project-name mg)) + +;; Get the names of all modules in this graph's project +(: module-names (-> ModuleGraph (Listof String))) +(define (module-names mg) + (for/list ([node+neighbors (in-list (modulegraph-adjlist mg))]) + (car node+neighbors))) + +(: name->index (-> ModuleGraph String Natural)) +(define (name->index mg name) + (: maybe-i (U #f Natural)) + (define maybe-i + ;; Simulated for/first + (let loop ([i : Natural 0] [n+n (modulegraph-adjlist mg)]) + (if (string=? name (caar n+n)) + i + (loop (add1 i) (cdr n+n))))) + (or maybe-i + (error 'name->index (format "Invalid module name ~a" name)))) + +(: index->name (-> ModuleGraph Natural String)) +(define (index->name mg i) + (car (list-ref (modulegraph-adjlist mg) i))) + +(: requires (-> ModuleGraph String (Listof String))) +(define (requires mg name) + (or + (adjlist->dst* (modulegraph-adjlist mg) name) + (raise-user-error 'modulegraph (format "Module '~a' is not part of graph '~a'" name mg)))) + +(: adjlist->dst* (-> AdjList String (U #f (Listof String)))) +(define (adjlist->dst* adj name) + (for/or : (U #f (Listof String)) + ([src+dst* (in-list adj)]) + (and + (string=? name (car src+dst*)) + (cdr src+dst*)))) + +(: provides (-> ModuleGraph String (Listof String))) +(define (provides mg name) + (adjlist->src* (modulegraph-adjlist mg) name)) + +(: adjlist->src* (-> AdjList String (Listof String))) +(define (adjlist->src* adj name) + (for/list : (Listof String) + ([node+neighbors : (Listof String) (in-list adj)] + #:when (member name (cdr node+neighbors))) + (car node+neighbors))) + +;; ============================================================================= +;; --- data definition: provided / required + +(struct provided ( + [>symbol : Symbol] ;; Name of provided identifier + [syntax? : Boolean] ;; If #t, identifier is exported syntax or renamed + [history : (U #f (Listof Any))] + ;; If #f, means id was defined in the module + ;; Otherwise, is a flat list of id's history +) #:transparent ) +(define-type Provided provided) + +;; TODO should to/from by symbols? +(define-type Boundary (List String String (Listof Provided))) +(define boundary-to car) +(define boundary-from cadr) +(define boundary-provided* caddr) +;; For now, I guess we don't need a struct + +;; Return a list of: +;; (TO FROM PROVIDED) +;; corresponding to the edges of modulegraph `G`. +;; This decorates each edges with the identifiers provided from a module +;; and required into another. +(: boundaries (-> ModuleGraph (Listof Boundary))) +(define (boundaries G) + ;; Reclaim source directory + (define src (infer-untyped-dir + (or (modulegraph-src G) (infer-project-dir (modulegraph-project-name G))))) + (define name* (module-names G)) + (define from+provided** + (for/list : (Listof (Pairof String (Listof Provided))) + ([name (in-list name*)]) + ((inst cons String (Listof Provided)) + name + (absolute-path->provided* (build-path src (string-append name ".rkt")))))) + (for/list : (Listof Boundary) + ([to+from (in-edges G)]) + (define to (car to+from)) + (define from (cdr to+from)) + (define maybe-provided* (assoc from from+provided**)) + (if maybe-provided* + (list to from (cdr maybe-provided*)) + (raise-user-error 'boundaries (format "Failed to get provides for module '~a'" from))))) + +(: absolute-path->provided* (-> Path (Listof Provided))) +(define (absolute-path->provided* p) + (define cm (cast (compile (get-module-code p)) Compiled-Module-Expression)) + (define-values (p* s*) (module-compiled-exports cm)) + (append + (parse-provided p*) + (parse-provided s* #:syntax? #t))) + +(define-type RawProvided + (Pairof (U #f Integer) + (Listof (List Symbol History)))) +(define-type History (Listof Any)) ;; Lazy + +(: parse-provided (->* [(Listof RawProvided)] [#:syntax? Boolean] (Listof Provided))) +(define (parse-provided p* #:syntax? [syntax? #f]) + (define p0 + (apply append + (for/list : (Listof (Listof (List Symbol History))) + ([p (in-list p*)] #:when (and (car p) (zero? (car p)))) + (define p+ (cdr p)) + (if (and (not (null? p+)) + (symbol? (car p+))) + (list p+) + p+)))) + (for/list : (Listof Provided) + ([p : (List Symbol History) (in-list p0)]) + (define name (car p)) + (define history (cadr p)) + (provided name syntax? (and (not (null? history)) history)))) + +;; ----------------------------------------------------------------------------- +;; --- parsing TiKZ + +(struct texnode ( + [id : Index] + [index : Index] + [name : String] +) #:transparent) +;; A `texedge` is a (Pairof Index Index) +(define-type texedge (Pairof Index Index)) + +(define-syntax-rule (parse-error msg arg* ...) + (error 'modulegraph (format msg arg* ...))) + +(: rkt-file? (-> Path-String Boolean)) +(define (rkt-file? p) + (regexp-match? #rx"\\.rkt$" (if (string? p) p (path->string p)))) + +(: project-name->modulegraph (-> String ModuleGraph)) +(define (project-name->modulegraph name) + (directory->modulegraph (infer-project-dir name))) + +(: directory->modulegraph (-> Path-String ModuleGraph)) +(define (directory->modulegraph dir) + (define u-dir (infer-untyped-dir dir)) + ;; No edges, just nodes + (: adjlist AdjList) + (define adjlist (directory->adjlist u-dir)) + (modulegraph (path->project-name dir) adjlist dir)) + +(: get-git-root (-> String)) +(define (get-git-root) + (define ok? : (Boxof Boolean) (box #t)) + (define outs + (with-output-to-string + (lambda () + (set-box! ok? (system "git rev-parse --show-toplevel"))))) + (if (and (unbox ok?) (string-contains? outs "gradual-typing-performance")) + (string-trim outs) + (raise-user-error 'modulegraph "Must be in `gradual-typing-performance` repo to use script"))) + +;; Blindly search for a directory called `name`. +(: infer-project-dir (-> String Path)) +(define (infer-project-dir name) + (define p-dir (build-path (get-git-root) "benchmarks" name)) + (if (directory-exists? p-dir) + p-dir + (raise-user-error 'modulegraph "Failed to find project directory for '~a', cannot summarize data" name))) + +(: infer-untyped-dir (-> Path-String Path)) +(define (infer-untyped-dir dir) + (define u-dir (build-path dir "untyped")) + (if (directory-exists? u-dir) + u-dir + (raise-user-error 'modulegraph "Failed to find untyped code for '~a', cannot summarize data" dir))) + +;; Interpret a .tex file containing a TiKZ picture as a module graph +(: tex->modulegraph (-> Path-String ModuleGraph)) +(define (tex->modulegraph filename) + (define-values (path project-name) (ensure-tex filename)) + (call-with-input-file* filename + (lambda ([port : Input-Port]) + (ensure-tikz port) + (define-values (edge1 tex-nodes) (parse-nodes port)) + (define tex-edges (cons edge1 (parse-edges port))) + (texnode->modulegraph project-name tex-nodes tex-edges)))) + +;; Verify that `filename` is a tex file, return the name of +;; the project it describes. +(: ensure-tex (-> Path-String (Values Path String))) +(define (ensure-tex filename) + (define path (or (and (path? filename) filename) + (string->path filename))) + (unless (bytes=? #"tex" (or (filename-extension path) #"")) + (parse-error "Cannot parse module graph from non-tex file '~a'" filename)) + ;; Remove anything past the first hyphen in the project name + (define project-name (path->project-name path)) + (values path project-name)) + +;; Parse the project's name from a path +(: path->project-name (-> Path-String String)) +(define (path->project-name ps) + (define p : Path + (cond + [(path? ps) ps] + [(string? ps) (string->path ps)] + [else (raise-user-error 'path->project-name ps)])) + (define s : String + (path->string + (or (file-name-from-path p) + (raise-user-error 'path->project-name (format "Could not get filename from path '~a'" p))))) + (define without-dir + (last (string-split s "/"))) + (define without-ext + (strip-suffix without-dir)) + (define without-hyphen + (car (string-split without-ext "-"))) + without-hyphen) + +;; Verify that the lines contained in `port` contain a TiKZ picture +;; Advance the port +(: ensure-tikz (-> Input-Port Void)) +(define (ensure-tikz port) + (define line (read-line port)) + (cond [(eof-object? line) + ;; No more input = failed to read a module graph + (parse-error "Input is not a TiKZ picture")] + [(string=? "\\begin{tikzpicture}" (string-trim line)) + ;; Success! We have id'd this file as a TiKZ picture + (void)] + [else + ;; Try again with what's left + (ensure-tikz port)])) + +;; Parse consecutive `\node` declarations in a TiKZ file, +;; ignoring blank spaces and comments. +(: parse-nodes (->* [Input-Port] [(Listof texnode)] (Values texedge (Listof texnode)))) +(define (parse-nodes port [nodes-acc '()]) + (define raw-line (read-line port)) + (define line + (if (eof-object? raw-line) + ;; EOF here means there's no edges below + (parse-error "Hit end-of-file while reading nodes. Module graphs must have edges.") + (string-trim raw-line))) + (cond + [(< (string-length line) 4) + ;; Degenerate line, can't contain anything useful + (parse-nodes port nodes-acc)] + [(equal? #\% (string-ref line 0)) + ;; Line is a comment, ignore + (parse-nodes port nodes-acc)] + [(string=? "\\node" (substring line 0 5)) + ;; Found node! Keep if it's a real node (not just for positioning), then continue parsing + (define nodes-acc+ + (if (dummy-node? line) + nodes-acc + (cons (string->texnode line) nodes-acc))) + (parse-nodes port nodes-acc+)] + [(string=? "\\draw" (substring line 0 5)) + ;; Found edge, means this stage of parsing is over + (values (string->texedge line) nodes-acc)] + [else + ;; Invalid input + (parse-error "Cannot parse node from line '~a'" line)])) + +;; Parse consecutive `\edge` declarations, ignore blanks and comments. +(: parse-edges (->* [Input-Port] [(Listof texedge)] (Listof texedge))) +(define (parse-edges port [edges-acc '()]) + (define raw-line (read-line port)) + (define line + (if (eof-object? raw-line) + ;; End of file; should have seen \end{tikzpicture} + (parse-error "Parsing reached end-of-file before reading \end{tikzpicture}. Are you sure the input is valid .tex?") + (string-trim raw-line))) + (cond + [(< (string-length line) 4) + ;; Degenerate line, can't contain anything useful + (parse-edges port edges-acc)] + [(equal? #\% (string-ref line 0)) + ;; Line is a comment, ignore + (parse-edges port edges-acc)] + [(string=? "\\draw" (substring line 0 5)) + ;; Found edge! Parse and recurse + (parse-edges port (cons (string->texedge line) edges-acc))] + [(string=? "\\node" (substring line 0 5)) + ;; Should never see nodes here + (parse-error "Malformed TiKZ file: found node while reading edges.")] + [(string=? "\\end{tikzpicture}" line) + ;; End of picture, we're done! + edges-acc] + [else + ;; Invalid input + (parse-error "Cannot parse edge from line '~a'" line)])) + +;; For parsing nodes: +;; \node (ID) [pos]? {\rkt{ID}{NAME}}; +(define NODE_REGEXP + #rx"^\\\\node *\\(([0-9]+)\\) *(\\[.*\\])? *\\{\\\\rkt\\{([0-9]+)\\}\\{(.+)\\}\\};$") +;; For parsing edges +;; \draw[style]? (ID) edge (ID); +(define EDGE_REGEXP + #rx"^\\\\draw\\[.*\\]? *\\(([0-9]+)\\)[^(]*\\(([0-9]+)\\);$") + +;; Parsing +(: string->index (-> String Index)) +(define (string->index str) + (cast (string->number str) Index)) + +;; Check if a line represents a real node, or is just for positioning +(: dummy-node? (-> String Boolean)) +(define (dummy-node? str) + (define N (string-length str)) + (and (>= N 3) + (string=? "{};" (substring str (- N 3) N)))) + +;; Parse a string into a texnode struct. +(: string->texnode (-> String texnode)) +(define (string->texnode str) + (define m (regexp-match NODE_REGEXP str)) + (match m + [(list _ id _ index name) + #:when (and id index name) + (texnode (or (string->index id) (parse-error "Could not parse integer from node id '~a'" id)) + (or (string->index index) (parse-error "Could not parse integer from node index '~a'" index)) + name)] + [else + (parse-error "Cannot parse node declaration '~a'" str)])) + +;; Parse a string into a tex edge. +;; Edges are represented as cons pairs of their source and destination. +;; Both source and dest. are represented as indexes. +(: string->texedge (-> String texedge)) +(define (string->texedge str) + (define m (regexp-match EDGE_REGEXP str)) + (match m + [(list _ id-src id-dst) + #:when (and id-src id-dst) + ((inst cons Index Index) + (string->index id-src) + (string->index id-dst))] + [else + (parse-error "Cannot parse edge declaration '~a'" str)])) + +;; Convert nodes & edges parsed from a .tex file to a modulegraph struct +(: texnode->modulegraph (-> String (Listof texnode) (Listof texedge) ModuleGraph)) +(define (texnode->modulegraph project-name nodes edges) + ;; Convert a TiKZ node id to a module name + (: id->name (-> Index String)) + (define (id->name id) + (or (for/or : (U #f String) ([tx (in-list nodes)]) + (and (= id (texnode-id tx)) + (texnode-name tx))) + (error 'texnode->modulegraph (format "Could not convert tikz node id ~a to a module name" id)))) + ;; Create an adjacency list by finding the matching edges for each node + (: adjlist (Listof (Pairof (Pairof Index String) (Listof String)))) + (define adjlist + (for/list + ([tx : texnode (in-list nodes)]) + (: hd (Pairof Index String)) + (define hd (cons (texnode-index tx) (texnode-name tx))) + (: rest (Listof String)) + (define rest + (for/list + ([src+dst : texedge (in-list edges)] + #:when (= (texnode-id tx) (car src+dst))) + (id->name (cdr src+dst)))) + ((inst cons (Pairof Index String) (Listof String)) + hd rest))) + ;; Alphabetically sort the adjlist, check that the indices match the ordering + ;; Need to append .rkt, else things like (string< "a-base" "a") fail. They should pass... + (: get-key (-> (Pairof (Pairof Index String) (Listof String)) String)) + (define (get-key x) + (string-append (cdar x) ".rkt")) + (define sorted ((inst sort (Pairof (Pairof Index String) (Listof String)) String) + adjlist stringlist (in-range (length sorted)))) + (parse-error "Indices do not match alphabetical ordering on module names. Is the TiKZ graph correct?\n Source: '~a'\n" (for/list : (Listof Any) ([x (in-list sorted)]) (car x)))) + ;; Drop the indices + (define untagged : (Listof (Listof String)) + (for/list ([tag+neighbors (in-list sorted)]) + (cons (cdar tag+neighbors) (cdr tag+neighbors)))) + (modulegraph project-name untagged #f)) + +(: directory->adjlist (-> Path AdjList)) +(define (directory->adjlist dir) + (define abs-path* (glob (format "~a/*.rkt" (path->string dir)))) + (define src-name* + (for/list : (Listof String) + ([path-str (in-list abs-path*)]) + (strip-suffix (strip-directory (string->path path-str))))) + ;; Build modulegraph + (for/list : AdjList + ([abs-path (in-list abs-path*)] + [src-name (in-list src-name*)]) + (cons src-name + (for/list : (Listof String) + ([mod-abspath (in-list (absolute-path->imports abs-path))] + #:when (member (strip-suffix mod-abspath) src-name*)) + (strip-suffix mod-abspath))))) + +(: absolute-path->imports (-> Path-String (Listof Path))) +(define (absolute-path->imports ps) + (define p (if (path? ps) ps (string->path ps))) + (define mc (cast (compile (get-module-code p)) Compiled-Module-Expression)) + (for/fold : (Listof Path) + ([acc : (Listof Path) '()]) + ([mpi (in-list (apply append (module-compiled-imports mc)))]) + (if (module-path-index? mpi) + (let-values (((name _2) (module-path-index-split mpi))) + (if (string? name) + (cons (string->path name) acc) + acc)) + acc))) + +(define RX-REQUIRE #rx"require.*\"(.*)\\.rkt\"") + +;; Sort an adjacency list in order of transitive indegree, increasing. +;; Results are grouped by indegree, i.e. +;; - 1st result = list of 0-indegree nodes +;; - 2nd result = list of 1-indegree nodes +;; - ... +(: topological-sort (-> AdjList (Listof (Listof String)))) +(define (topological-sort adj) + (: indegree-map (HashTable String Integer)) + (define indegree-map + (make-hash (for/list : (Listof (Pairof String Integer)) + ([src+dst* (in-list adj)]) + (cons (car src+dst*) (length (cdr src+dst*)))))) + (reverse + (let loop ([acc : (Listof (Listof String)) '()]) + (cond + [(zero? (hash-count indegree-map)) + acc] + [else + (define zero-indegree* + (for/list : (Listof String) + ([(k v) (in-hash indegree-map)] + #:when (zero? v)) k)) + (for ([k (in-list zero-indegree*)]) + (hash-remove! indegree-map k) + (define src* (adjlist->src* adj k)) + (for ([src (in-list src*)]) + (hash-set! indegree-map src + (- (hash-ref indegree-map src (lambda () -1)) 1)))) + (loop (cons (sort zero-indegree* stringtikz (-> Path Path-String Void)) +(define (directory->tikz p out-file) + (define MG (directory->modulegraph p)) + (with-output-to-file out-file #:exists 'replace + (lambda () (modulegraph->tex MG (current-output-port))))) + +(: modulegraph->tex (-> ModuleGraph Output-Port Void)) +(define (modulegraph->tex MG out) + (define tsort (topological-sort (modulegraph-adjlist MG))) + (parameterize ([current-output-port out]) + (displayln "\\begin{tikzpicture}\n") + ;; -- draw nodes + (: name+tikzid* (Listof (Pairof String String))) + (define name+tikzid* + (apply append + (for/list : (Listof (Listof (Pairof String String))) + ([group (in-list tsort)] + [g-id (in-naturals)]) + (for/list : (Listof (Pairof String String)) + ([name (in-list group)] + [n-id (in-naturals)]) + (define tikzid (format "~a~a" g-id n-id)) + (define pos + (cond + [(and (zero? g-id) (zero? n-id)) ""] + [(zero? n-id) (format "[left of=~a,xshift=-2cm]" (decr-left tikzid))] + [else (format "[below of=~a,yshift=-1cm]" (decr-right tikzid))])) + (printf " \\node (~a) ~a {\\rkt{~a}{~a}};\n" + tikzid pos (name->index MG name) name) + (cons name tikzid))))) + (newline) + ;; -- draw edges + (: get-tikzid (-> String String)) + (define (get-tikzid name) + (cdr (or (assoc name name+tikzid*) (error 'NONAME)))) + (for* ([group (in-list tsort)] + [name (in-list group)] + [req (in-list (requires MG name))]) + (printf " \\draw[->] (~a) -- (~a);\n" + (get-tikzid name) + (get-tikzid req))) + (displayln "\n\\end{tikzpicture}"))) + +(: decr-right (-> String String)) +(define (decr-right str) + (decr-str str #f #t)) + +(: decr-left (-> String String)) +(define (decr-left str) + (decr-str str #t #f)) + +(: decr-str (-> String Boolean Boolean String)) +(define (decr-str str left? right?) + (define left-char (string-ref str 0)) + (define right-char (string-ref str 1)) + (string (if left? (decr-char left-char) left-char) + (if right? (decr-char right-char) right-char))) + +(: decr-char (-> Char Char)) +(define (decr-char c) + (integer->char (sub1 (char->integer c)))) + +(: strip-suffix (-> Path-String String)) +(define (strip-suffix p) + (define p+ (if (path? p) p (string->path p))) + (path->string (path-replace-suffix p+ ""))) + +(: strip-directory (-> Path-String String)) +(define (strip-directory ps) + (define p (if (path? ps) ps (string->path ps))) + (path->string (assert (last (explode-path p)) path?))) + +;; ============================================================================= + +(define (main) + (for ([fname (in-glob "../data/*.tex")]) + (tex->modulegraph fname))) + + +(time (main))