forked from
jonmsterling.com/ocaml-forester
ocaml
Further refactoring of tree representations
+131
-116
+2
-2
lib/compiler/Driver.ml
+2
-2
lib/compiler/Driver.ml
···
32
32
let@ tree_dir = List.iter @~ paths in
33
33
assert (Eio.Path.is_directory tree_dir);
34
34
let@ tree = Seq.iter @~ Phases.load tree_dir in
35
-
let lsp_uri = Tree.lsp_uri tree in
35
+
let lsp_uri = Tree.Loaded.uri tree in
36
36
let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in
37
37
URI.Tbl.replace forest.resolver uri (Lsp.Uri.to_path lsp_uri);
38
38
forest.={uri} <- Tree tree
···
117
117
(Done, forest)
118
118
| Load_tree path ->
119
119
let doc = Imports.load_tree path in
120
-
let lsp_uri = Tree.lsp_uri doc in
120
+
let lsp_uri = Tree.Loaded.uri doc in
121
121
let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in
122
122
forest.={uri} <- Tree doc;
123
123
(Parse lsp_uri, forest)
-14
lib/compiler/Error.ml
-14
lib/compiler/Error.ml
···
24
24
25
25
and latex_error = {range: Grace.Range.t; msg: string}
26
26
27
-
(* There are only a couple of situations I can think of where it makes sense to
28
-
have this error without a range:
29
-
- In the server, if the user enters a nonexistent link via the url bar.
30
-
- The case of a typo should actually be covered by the Broken_link error.
31
-
- ... any others?
32
-
*)
33
-
and resource_not_found = {uri: URI.t; range: Range.t option}
34
-
35
27
and unlinked_attribution_warning = {
36
28
role: T.attribution_role;
37
29
range: Range.t option;
···
171
163
let render_parse_error Parse.{range; msg} =
172
164
let labels = [empty_label ~range] in
173
165
Diagnostic.createf Error ~code:`Parse_error ~labels "%s" msg
174
-
175
-
let render_resource_not_found ({range; _} : resource_not_found) =
176
-
let labels =
177
-
Option.fold ~none:[] ~some:(fun range -> [empty_label ~range]) range
178
-
in
179
-
Diagnostic.createf ~labels Error ""
180
166
181
167
let render_io_error _ = Diagnostic.createf Error "io_error"
182
168
+8
-2
lib/compiler/Eval.ml
+8
-2
lib/compiler/Eval.ml
···
796
796
source_path:string option ->
797
797
Tree.(expanded tree) ->
798
798
eval_result option * Error.t list =
799
-
fun ~config ~uri ~source_path {tree = {nodes; _}; source; _} ->
799
+
fun ~config ~uri ~source_path tree ->
800
800
let res = ref None in
801
801
let errors =
802
802
let@ () = Error.collect in
803
803
let fm = T.default_frontmatter ~uri ?source_path () in
804
804
let env = initial_eval_env config (ref fm) in
805
-
let range = Option.map Range.(fun source -> total ~source) source in
805
+
let source = Tree.Expanded.source tree in
806
+
let nodes = Tree.Expanded.nodes tree in
807
+
let range =
808
+
Option.map
809
+
Range.(fun source -> total ~source)
810
+
(source :> Grace.Source.t option)
811
+
in
806
812
match eval_tree_inner ~range ~env ~uri nodes with
807
813
| Error error -> Error.yield_eval_error error
808
814
| Ok main ->
+2
-1
lib/compiler/Expand.ml
+2
-1
lib/compiler/Expand.ml
···
1088
1088
let nodes = expand_eff ~forest Tree.(nodes code) in
1089
1089
let units = Sc.get_export () in
1090
1090
let tree : Tree.expanded = {nodes; code = Tree.nodes code; units} in
1091
-
Tree.{tree; source = code.source; phase = Expanded}
1091
+
let source = Tree.Parsed.source code in
1092
+
Tree.Expanded.create ?source tree
1092
1093
1093
1094
let expand_tree ~(forest : State.t) (code : Tree.(parsed tree)) :
1094
1095
Tree.(expanded tree) * Error.t list =
+1
-1
lib/compiler/Imports.ml
+1
-1
lib/compiler/Imports.ml
···
30
30
{languageId = "forester"; text = content; uri; version = 1};
31
31
}
32
32
in
33
-
{phase = Loaded; tree = doc; source = Some (`File path_str)}
33
+
Tree.Loaded.create ~source:(`File path_str) doc
34
34
35
35
(* Only add edge if both vertices are already present*)
36
36
let add_edge g v w =
+17
-50
lib/compiler/State.ml
+17
-50
lib/compiler/State.ml
···
76
76
| None -> URI.Tbl.replace state.index uri tree
77
77
| Some existing ->
78
78
if
79
-
Option.(compare Grace.Source.compare)
80
-
(Tree.source tree) (Tree.source existing)
81
-
= 0
79
+
(Option.compare compare) (Tree.source tree) (Tree.source existing) = 0
82
80
&& Tree.(equal_phases tree existing)
83
81
then
84
82
let () = state.?{uri} <- [Error.duplicate_tree ~uri] in
···
90
88
let ( ./{} ) state uri =
91
89
Option.bind (URI.Tbl.find_opt state.index uri) Tree.get_units
92
90
93
-
(*
94
-
(* updating units*)
95
-
let ( ./{}<- ) state uri units : _ result =
96
-
match URI.Tbl.find_opt state.index uri with
97
-
| None ->
98
-
error
99
-
@@ Diagnostic.createf Error ~code:`Internal_error
100
-
"Updating units: %a not found" URI.pp uri
101
-
| Some (Document _) | Some (Parsed _) ->
102
-
error
103
-
@@ Diagnostic.createf Error ~code:`Internal_error
104
-
"%a has not been expanded yet" URI.pp uri
105
-
| Some (Expanded expanded) ->
106
-
ok @@ URI.Tbl.replace state.index uri (Expanded {expanded with units})
107
-
| Some (Resource _) -> Ok ()
108
-
*)
109
-
110
91
(* @ for article/resource *)
111
92
let ( .@{} ) state uri =
112
-
match URI.Tbl.find_opt state.index uri with
113
-
| Some (Tree {phase = Evaluated; tree; _}) -> Some tree.resource
114
-
| _ -> None
93
+
Option.bind (URI.Tbl.find_opt state.index uri) Tree.to_resource
115
94
end
116
95
117
96
open Syntax
···
296
275
let@ wrong_variant = List.iter @~ wrong_variants_for_uri uri in
297
276
URI.Tbl.add forest.suggestions wrong_variant uri
298
277
end;
299
-
match forest.={uri} with
300
-
| None ->
301
-
forest.={uri} <-
302
-
Tree
303
-
{
304
-
phase = Evaluated;
305
-
tree = {resource; route_locally; include_in_manifest; expanded = None};
306
-
source = None;
307
-
}
308
-
| Some (Tree {phase; tree; source}) -> begin
309
-
match phase with
310
-
| Expanded ->
311
-
forest.={uri} <-
312
-
Tree
313
-
{
314
-
phase = Evaluated;
315
-
tree =
316
-
{
317
-
resource;
318
-
route_locally;
319
-
include_in_manifest;
320
-
expanded = Some tree;
321
-
};
322
-
source;
323
-
}
324
-
| Loaded | Evaluated | Parsed -> assert false
325
-
end
278
+
let tree =
279
+
Option.fold forest.={uri}
280
+
~some:begin fun tree ->
281
+
let expanded = Tree.to_expanded tree in
282
+
let source = Tree.source tree in
283
+
Tree.Evaluated.create ?source ~route_locally ~include_in_manifest
284
+
?expanded resource
285
+
end
286
+
~none:begin
287
+
let source = (* TODO: *) None in
288
+
Tree.Evaluated.create ?source ~route_locally ~include_in_manifest
289
+
resource
290
+
end
291
+
in
292
+
forest.={uri} <- Tree tree
+98
-35
lib/core/Tree.ml
+98
-35
lib/core/Tree.ml
···
12
12
include Base
13
13
end
14
14
15
+
type source = [`File of string]
16
+
15
17
type exports = (R.P.data, Grace.Range.t option) Trie.t
16
18
17
19
type loaded = Lsp.Text_document.t
18
20
type parsed = Code.t
19
-
20
-
type expanded = {nodes: Syn.t; code: Code.t; units: exports [@opaque]}
21
-
[@@deriving show]
22
-
21
+
type expanded = {nodes: Syn.t; code: Code.t; units: exports}
23
22
type evaluated = {
24
23
resource: T.content T.resource;
25
24
route_locally: bool;
26
25
include_in_manifest: bool;
27
26
expanded: expanded option;
28
27
}
29
-
[@@deriving show]
30
28
31
29
type 'a tag =
32
30
| Loaded : loaded tag
···
34
32
| Expanded : expanded tag
35
33
| Evaluated : evaluated tag
36
34
37
-
type 'a tree = {phase: 'a tag; tree: 'a; source: Grace.Source.t option}
35
+
type 'a tree = {phase: 'a tag; tree: 'a; source: source option}
36
+
37
+
module Loaded = struct
38
+
type t = loaded tree
39
+
let create : ?source:source -> loaded -> t =
40
+
fun ?source tree -> {tree; phase = Loaded; source}
41
+
let source {source; _} = source
42
+
let uri {tree; _} = Lsp.Text_document.documentUri tree
43
+
end
44
+
45
+
module Parsed = struct
46
+
type t = parsed tree
47
+
let create : ?source:source -> parsed -> t =
48
+
fun ?source tree -> {tree; phase = Parsed; source}
49
+
let source {source; _} = source
50
+
end
51
+
52
+
module Expanded = struct
53
+
type t = expanded tree
54
+
let create : ?source:source -> expanded -> t =
55
+
fun ?source tree -> {tree; phase = Expanded; source}
56
+
let source {source; _} = source
57
+
let nodes {tree = {nodes; _}; _} = nodes
58
+
end
59
+
60
+
module Evaluated = struct
61
+
type t = evaluated tree
62
+
let create ~route_locally ~include_in_manifest ?expanded ?source
63
+
(resource : _ T.resource) =
64
+
let tree = {resource; route_locally; include_in_manifest; expanded} in
65
+
{tree; phase = Evaluated; source}
66
+
67
+
let source {source; _} = source
68
+
end
38
69
39
70
type t = Tree : 'a tree -> t
40
71
41
-
let source : t -> Grace.Source.t option = function
42
-
| Tree {phase; tree; source} -> source
72
+
type phase = Phase : 'a tag -> phase
73
+
74
+
let source : t -> _ option = function
75
+
| Tree {source; _} -> begin
76
+
match source with Some s -> Some s | _ -> None
77
+
end
78
+
79
+
let phase : type a. a tree -> phase = function
80
+
| {phase; _} -> begin
81
+
match phase with
82
+
| Loaded -> Phase Loaded
83
+
| Parsed -> Phase Parsed
84
+
| Expanded -> Phase Expanded
85
+
| Evaluated -> Phase Evaluated
86
+
end
43
87
44
88
let equal_phases =
45
89
fun (Tree {phase = phase1; _}) (Tree {phase = phase2; _}) ->
···
50
94
| Evaluated, Evaluated -> true
51
95
| _ -> false
52
96
53
-
let lsp_uri : loaded tree -> Lsp.Uri.t = function
54
-
| {phase; tree; source} -> Lsp.Text_document.documentUri tree
97
+
let lsp_uri : t -> Lsp.Uri.t option = function
98
+
| Tree {tree; phase; source} -> begin
99
+
match phase with
100
+
| Loaded -> Some (Lsp.Text_document.documentUri tree)
101
+
| Parsed | Expanded | Evaluated -> begin
102
+
match source with
103
+
| None -> None
104
+
| Some (`File string) -> Some (Lsp.Uri.of_string string)
105
+
end
106
+
end
55
107
56
108
let to_doc : t -> loaded option = function
57
-
| Tree {phase; tree; source} -> begin
58
-
match phase with
59
-
| Loaded -> Some tree
60
-
| Parsed -> None
61
-
| Expanded -> None
62
-
| Evaluated -> None
109
+
| Tree {phase; tree; _} -> begin
110
+
match phase with Loaded -> Some tree | _ -> None
63
111
end
64
112
65
-
let of_code : source:Grace.Source.t -> Code.t -> Code.t tree =
66
-
fun ~source nodes -> {phase = Parsed; tree = nodes; source = Some source}
113
+
let of_code : path:string -> Code.t -> t =
114
+
fun ~path nodes ->
115
+
Tree {phase = Parsed; tree = nodes; source = Some (`File path)}
67
116
68
-
let of_doc : Lsp.Text_document.t -> loaded tree =
117
+
let of_doc : Lsp.Text_document.t -> t =
69
118
fun doc ->
70
119
let uri = Lsp.Text_document.documentUri doc in
71
120
let path = Lsp.Uri.to_path uri in
72
-
{phase = Loaded; tree = doc; source = Some (`File path)}
121
+
Tree {phase = Loaded; tree = doc; source = Some (`File path)}
73
122
74
-
let of_syn ~source syn = {phase = Expanded; tree = syn; source}
75
-
let of_resource ~source resource = {phase = Evaluated; tree = resource; source}
123
+
let of_syn ~source syn = Tree {phase = Expanded; tree = syn; source}
76
124
77
-
let show_phase = function
78
-
| Loaded -> "loaded"
79
-
| Parsed -> "parsed"
80
-
| Expanded -> "expanded"
81
-
| Evaluated -> "evaluated"
125
+
let syn = function {tree; _} -> tree.nodes
126
+
127
+
let get_syn = function
128
+
| Tree {phase = Expanded; tree; _} -> Some (tree.nodes : Syn.t)
129
+
| Tree {phase = Evaluated; tree; _} -> begin
130
+
match tree.expanded with
131
+
| Some expanded -> Some expanded.nodes
132
+
| None -> None
133
+
end
134
+
| _ -> None
82
135
83
136
let to_resource : t -> T.content T.resource option = function
84
137
| Tree {phase; tree; _} -> begin
···
87
140
| Parsed -> None
88
141
| Expanded -> None
89
142
| Evaluated -> Some tree.resource
143
+
end
144
+
145
+
let to_expanded : t -> expanded option = function
146
+
| Tree {phase; tree; _} -> begin
147
+
match phase with
148
+
| Expanded -> Some (tree : expanded)
149
+
| Evaluated -> tree.expanded
150
+
| _ -> None
90
151
end
91
152
92
153
let to_evaluated : t -> evaluated option = function
···
153
214
match tree.expanded with Some {units; _} -> Some units | None -> None
154
215
end)
155
216
156
-
let is_unparsed = function
157
-
| Tree {phase; _} -> begin match phase with Loaded -> true | _ -> false end
217
+
let is_parsed = function
218
+
| Tree {phase; _} -> begin match phase with Loaded -> false | _ -> true end
158
219
159
-
let is_parsed tree = not @@ is_unparsed tree
220
+
let is_unparsed = is_parsed >>> not
160
221
161
-
let is_unexpanded = function
222
+
let is_expanded = function
162
223
| Tree {phase; _} -> begin
163
-
match phase with Loaded | Parsed -> true | Expanded | Evaluated -> false
224
+
match phase with Loaded | Parsed -> false | Expanded | Evaluated -> true
164
225
end
165
226
166
-
let is_expanded tree = not @@ is_unexpanded tree
227
+
let is_unexpanded = is_expanded >>> not
167
228
168
-
let is_unevaluated = function
229
+
let is_evaluated = function
169
230
| Tree {phase; _} -> begin
170
-
match phase with Loaded | Parsed | Expanded -> true | Evaluated -> false
231
+
match phase with Loaded | Parsed | Expanded -> false | Evaluated -> true
171
232
end
233
+
234
+
let is_unevaluated = is_evaluated >>> not
172
235
173
236
let is_asset : t -> bool = function
174
237
| Tree {phase; tree; _} -> begin
-5
lib/frontend/Legacy_xml_client.ml
-5
lib/frontend/Legacy_xml_client.ml
···
46
46
xmlns: Xmlns.t;
47
47
}
48
48
49
-
let range ~env =
50
-
let@ uri = Option.bind env.uri in
51
-
let@ path = Option.map @~ URI.Tbl.find_opt env.forest.resolver uri in
52
-
Range.initial (`File path)
53
-
54
49
let render_xml_qname qname =
55
50
match qname.prefix with
56
51
| "" -> qname.uname
+1
-1
lib/language_server/Did_change.ml
+1
-1
lib/language_server/Did_change.ml
+1
-4
lib/parser/Parse.ml
+1
-4
lib/parser/Parse.ml
···
58
58
let lexbuf = Lexing.from_string text in
59
59
lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = path};
60
60
parse (`String {content = text; name = Some path}) lexbuf
61
-
|> Result.map (fun nodes ->
62
-
let source = `File path in
63
-
(*let identity = URI (URI_scheme.path_to_uri ~base:config.url path) *)
64
-
Tree.of_code ~source nodes)
61
+
|> Result.map (Tree.Parsed.create ~source:(`File path))
65
62
66
63
let parse_file filename =
67
64
let ch = open_in filename in
+1
-1
test/Print_syn.ml
+1
-1
test/Print_syn.ml
···
9
9
let forest = State.make ~env ~dev:true ~config:Config.(default ()) () in
10
10
match result with
11
11
| Ok code ->
12
-
let tree = Tree.of_code ~source:(`File filename) code in
12
+
let tree = Tree.Parsed.create ~source:(`File filename) code in
13
13
let Tree.{tree; _}, _ = Expand.(expand_tree ~forest tree) in
14
14
Format.printf "%a@." Syn.pp tree.nodes
15
15
| Error _ -> assert false