1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
open Core
module Map = Map.Make (String)
module Gph = Graph.Imperative.Digraph.Concrete (String)
module Topo = Graph.Topological.Make (Gph)
module Tbl = Hashtbl.Make (String)
let build_import_graph (trees : Code.tree Seq.t) =
let import_graph = Gph.create () in
begin
trees |> Seq.iter @@ fun (tree : Code.tree) ->
Gph.add_vertex import_graph tree.addr;
tree.code |> List.iter @@ fun node ->
match Asai.Range.(node.value) with
| Code.Import (_, dep) ->
Gph.add_edge import_graph dep tree.addr
| _ -> ()
end;
import_graph
type analysis =
{transclusion_graph : Gph.t;
link_graph : Gph.t;
contributors : addr Tbl.t;
author_pages : addr Tbl.t;
bibliography : addr Tbl.t}
let new_analysis () =
let size = 100 in
{transclusion_graph = Gph.create ();
link_graph = Gph.create ();
author_pages = Tbl.create size;
contributors = Tbl.create size;
bibliography = Tbl.create size}
let rec analyze_nodes ~analysis scope : Sem.t -> unit =
List.iter @@ fun located ->
match Range.(located.value) with
| Sem.Transclude (opts, addr) ->
analyze_transclusion_opts ~analysis scope opts;
Gph.add_edge analysis.transclusion_graph addr scope
| Sem.Link {title; dest; _} ->
Option.iter (analyze_nodes ~analysis scope) title;
Gph.add_edge analysis.link_graph dest scope
| Sem.Xml_tag (_, attrs, xs) ->
begin
attrs |> List.iter @@ fun (k, v) ->
analyze_nodes ~analysis scope v
end;
analyze_nodes ~analysis scope xs
| Sem.Math (_, x) ->
analyze_nodes ~analysis scope x
| Sem.Embed_tex {source; _} ->
analyze_nodes ~analysis scope source
| Sem.Block (title, body) ->
analyze_nodes ~analysis scope title;
analyze_nodes ~analysis scope body
| Sem.Query (opts, _) ->
analyze_transclusion_opts ~analysis scope opts
| Sem.If_tex (_, y) ->
analyze_nodes ~analysis scope y
| Sem.Prim (_, x) ->
analyze_nodes ~analysis scope x
| Sem.Object _ | Sem.Unresolved _ | Sem.Img _ | Sem.Text _ ->
()
and analyze_transclusion_opts ~analysis scope : Sem.transclusion_opts -> unit =
function Sem.{title_override; _} ->
title_override |> Option.iter @@ analyze_nodes ~analysis scope
let analyze_doc ~analysis scope (doc : Sem.tree) =
analyze_nodes ~analysis scope doc.body;
doc.title |> Option.iter @@ analyze_nodes ~analysis scope;
begin
doc.authors |> List.iter @@ fun author ->
Tbl.add analysis.author_pages author scope
end;
begin
doc.metas |> List.iter @@ fun (_, meta) ->
analyze_nodes ~analysis scope meta
end
let merge_bibliography ~analysis ~from_addr ~to_addr =
Tbl.find_all analysis.bibliography from_addr |> List.iter @@ fun ref ->
Tbl.add analysis.bibliography to_addr ref
let analyze_trees (trees : Sem.tree Map.t) : analysis =
let analysis = new_analysis () in
begin
trees |> Map.iter @@ fun addr doc ->
Gph.add_vertex analysis.transclusion_graph addr;
Gph.add_vertex analysis.link_graph addr;
analyze_doc ~analysis addr doc;
let task ref =
match Map.find_opt ref trees with
| Some (ref_doc : Sem.tree) when ref_doc.taxon = Some "reference" ->
Tbl.add analysis.bibliography addr ref
| _ -> ()
in
Gph.iter_pred task analysis.link_graph addr;
end;
begin
analysis.transclusion_graph |> Topo.iter @@ fun child_addr ->
let handle_parent parent_addr =
Map.find_opt child_addr trees |> Option.iter @@ fun (parent_doc : Sem.tree) ->
match parent_doc.taxon with
| Some "reference" -> ()
| _ ->
begin
parent_doc.authors @ Tbl.find_all analysis.contributors child_addr |> List.iter @@ fun contributor ->
Tbl.add analysis.contributors parent_addr contributor
end;
merge_bibliography ~analysis ~from_addr:child_addr ~to_addr:parent_addr
in
Gph.iter_succ handle_parent analysis.transclusion_graph child_addr
end;
analysis