suzanne.soy/trivial
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[icfp] add modulegraph benchmark

Browse Source
This commit is contained in:
ben 2016-03-14 11:50:01 -04:00
parent 2b1a0b939c
commit 33f21c7ee5
24 changed files with 2158 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
icfp-2016/benchmark/README.md
View File

@ -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

47
icfp-2016/benchmark/modulegraph/data/acquire.tex Normal file
View File

@ -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}

15
icfp-2016/benchmark/modulegraph/data/echo.tex Normal file
View File

@ -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}

13
icfp-2016/benchmark/modulegraph/data/forth.tex Normal file
View File

@ -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}

27
icfp-2016/benchmark/modulegraph/data/fsm.tex Normal file
View File

@ -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}

19
icfp-2016/benchmark/modulegraph/data/fsmoo.tex Normal file
View File

@ -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}

19
icfp-2016/benchmark/modulegraph/data/fsmv2.tex Normal file
View File

@ -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}

112
icfp-2016/benchmark/modulegraph/data/gregor.tex Normal file
View File

@ -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}

14
icfp-2016/benchmark/modulegraph/data/htdp.tex Normal file
View File

@ -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}

47
icfp-2016/benchmark/modulegraph/data/kcfa.tex Normal file
View File

@ -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}

25
icfp-2016/benchmark/modulegraph/data/lnm.tex Normal file
View File

@ -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}

15
icfp-2016/benchmark/modulegraph/data/mbta.tex Normal file
View File

@ -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}

18
icfp-2016/benchmark/modulegraph/data/morsecode.tex Normal file
View File

@ -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}

85
icfp-2016/benchmark/modulegraph/data/quad.tex Normal file
View File

@ -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}

85
icfp-2016/benchmark/modulegraph/data/quadU.tex Normal file
View File

@ -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}

11
icfp-2016/benchmark/modulegraph/data/sieve.tex Normal file
View File

@ -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}

55
icfp-2016/benchmark/modulegraph/data/snake.tex Normal file
View File

@ -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}

34
icfp-2016/benchmark/modulegraph/data/suffixtree.tex Normal file
View File

@ -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}

67
icfp-2016/benchmark/modulegraph/data/synth.tex Normal file
View File

@ -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}

71
icfp-2016/benchmark/modulegraph/data/tetris.tex Normal file
View File

@ -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}

13
icfp-2016/benchmark/modulegraph/data/zombie.tex Normal file
View File

@ -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}

29
icfp-2016/benchmark/modulegraph/data/zordoz.tex Normal file
View File

@ -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}

665
icfp-2016/benchmark/modulegraph/post/main.rkt Normal file
View File

@ -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 string<? #:key get-key))
(unless (equal? (for/list : (Listof Index)
([x (in-list sorted)])
(caar x))
(sequence->list (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* string<?) acc))]))))
;; Print a modulegraph for a project.
;; The layout should be approximately right
;; (may need to bend edges & permute a row's nodes)
(: directory->tikz (-> 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))

670
icfp-2016/benchmark/modulegraph/pre/main.rkt Normal file
View File

@ -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 string<? #:key get-key))
(unless (equal? (for/list : (Listof Index)
([x (in-list sorted)])
(caar x))
(sequence->list (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* string<?) acc))]))))
;; Print a modulegraph for a project.
;; The layout should be approximately right
;; (may need to bend edges & permute a row's nodes)
(: directory->tikz (-> 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))