forked from
jonmsterling.com/ocaml-forester
ocaml
Changes to prepare for introduction of LSP
authored by
Kento Okura
and committed by
Jon Sterling
5a5f50f4
36ad9fb5
+125
-169
+1
bin/forester/dune
+1
bin/forester/dune
+9
-1
bin/forester/main.ml
+9
-1
bin/forester/main.ml
···
253
253
]
254
254
in
255
255
let info = Cmd.info "forester" ~version ~doc ~man in
256
-
Cmd.group info [build_cmd ~env; new_tree_cmd ~env; complete_cmd ~env; init_cmd ~env; query_cmd ~env]
256
+
Cmd.group
257
+
info
258
+
[
259
+
build_cmd ~env;
260
+
new_tree_cmd ~env;
261
+
complete_cmd ~env;
262
+
init_cmd ~env;
263
+
query_cmd ~env
264
+
]
257
265
258
266
let () =
259
267
Random.self_init ();
+5
-1
dune-project
+5
-1
dune-project
+6
-6
flake.lock
+6
-6
flake.lock
···
67
67
},
68
68
"nixpkgs": {
69
69
"locked": {
70
-
"lastModified": 1729665710,
71
-
"narHash": "sha256-AlcmCXJZPIlO5dmFzV3V2XF6x/OpNWUV8Y/FMPGd8Z4=",
70
+
"lastModified": 1729880355,
71
+
"narHash": "sha256-RP+OQ6koQQLX5nw0NmcDrzvGL8HDLnyXt/jHhL1jwjM=",
72
72
"owner": "NixOS",
73
73
"repo": "nixpkgs",
74
-
"rev": "2768c7d042a37de65bb1b5b3268fc987e534c49d",
74
+
"rev": "18536bf04cd71abd345f9579158841376fdd0c5a",
75
75
"type": "github"
76
76
},
77
77
"original": {
···
156
156
"opam-repository_2": {
157
157
"flake": false,
158
158
"locked": {
159
-
"lastModified": 1729853674,
160
-
"narHash": "sha256-ybgYdaUajafKIaUK6d7abGpj702jQkBzTIF24kixiek=",
159
+
"lastModified": 1730065415,
160
+
"narHash": "sha256-ky2HYwZMNVS1gJyQxFOWowV/lE2Itee9eLHA9lolJVw=",
161
161
"owner": "ocaml",
162
162
"repo": "opam-repository",
163
-
"rev": "19f88a00fcef3c5732457519b333b9657aa36317",
163
+
"rev": "6383bc5431ca714c10b4e29dbf7eda9572a4ac07",
164
164
"type": "github"
165
165
},
166
166
"original": {
+28
-12
flake.nix
+28
-12
flake.nix
···
6
6
opam-repository.flake = false;
7
7
opam-nix.url = "github:tweag/opam-nix";
8
8
};
9
-
outputs = { self, flake-utils, opam-nix, nixpkgs, opam-repository }@inputs:
10
-
let package = "forester";
11
-
in flake-utils.lib.eachDefaultSystem (system:
9
+
outputs =
10
+
{
11
+
self,
12
+
flake-utils,
13
+
opam-nix,
14
+
nixpkgs,
15
+
opam-repository,
16
+
}@inputs:
17
+
let
18
+
package = "forester";
19
+
in
20
+
flake-utils.lib.eachDefaultSystem (
21
+
system:
12
22
let
13
23
pkgs = nixpkgs.legacyPackages.${system};
14
24
on = opam-nix.lib.${system};
15
25
devPackagesQuery = {
16
26
ocaml-base-compiler = "5.2.0";
17
27
ocaml-lsp-server = "*";
28
+
ocamlformat = "*";
29
+
memtrace = "*";
18
30
};
19
31
query = devPackagesQuery // { };
20
-
scope =
21
-
on.buildOpamProject' { repos = [ "${opam-repository}" ]; } ./. query;
32
+
scope = on.buildOpamProject' { repos = [ "${opam-repository}" ]; } ./. query;
22
33
overlay = final: prev: {
23
-
${package} =
24
-
prev.${package}.overrideAttrs (_: { doNixSupport = false; });
34
+
${package} = prev.${package}.overrideAttrs (_: {
35
+
doNixSupport = false;
36
+
});
25
37
};
26
38
scope' = scope.overrideScope' overlay;
27
39
main = scope'.${package};
28
-
devPackages = builtins.attrValues
29
-
(pkgs.lib.getAttrs (builtins.attrNames devPackagesQuery) scope');
30
-
in {
40
+
devPackages = builtins.attrValues (pkgs.lib.getAttrs (builtins.attrNames devPackagesQuery) scope');
41
+
in
42
+
{
31
43
legacyPackages = scope';
32
44
packages.default = main;
33
45
devShells.default = pkgs.mkShell {
34
46
inputsFrom = [ main ];
35
-
buildInputs = devPackages ++ [ pkgs.topiary ];
47
+
buildInputs = devPackages ++ [
48
+
pkgs.topiary
49
+
pkgs.reuse
50
+
];
36
51
};
37
-
});
52
+
}
53
+
);
38
54
}
+2
forester.opam
+2
forester.opam
+12
-8
lib/compiler/Expand.ml
+12
-8
lib/compiler/Expand.ml
···
306
306
match TeX_cs.parse name with
307
307
| None ->
308
308
let extra_remarks = create_suggestions path in
309
-
Reporter.fatalf
309
+
Reporter.emitf
310
310
?loc
311
311
~extra_remarks
312
312
Resolution_error
313
313
"path %a could not be resolved"
314
314
Sc.pp_path
315
-
path
315
+
path;
316
+
[]
316
317
| Some (cs, rest) ->
317
318
let rest = match rest with "" -> [] | _ -> [Range.{ value = Syn.Text rest; loc }] in
318
319
Range.{ value = Syn.TeX_cs cs; loc } :: rest
319
320
end
320
321
| None, _ ->
321
322
let extra_remarks = create_suggestions path in
322
-
Reporter.fatalf
323
+
Reporter.emitf
323
324
?loc
324
325
~extra_remarks
325
326
Resolution_error
326
327
"path %a could not be resolved"
327
328
Sc.pp_path
328
-
path
329
+
path;
330
+
[]
329
331
| Some (Term x, ()), _ ->
330
332
let relocate Range.{ value; _ } = Range.{ value; loc } in
331
333
List.map relocate x
332
334
| Some (Xmlns { xmlns; prefix }, ()), _ ->
333
-
Reporter.fatalf
335
+
Reporter.emitf
334
336
?loc
335
337
Resolution_error
336
338
"path %a resolved to xmlns:%s=\"%s\" instead of term"
337
339
Sc.pp_path
338
340
path
339
341
xmlns
340
-
prefix
342
+
prefix;
343
+
[]
341
344
342
345
and expand_xml_ident loc (prefix, uname) =
343
346
match prefix with
···
347
350
| Some (Xmlns { xmlns; prefix }, ()) ->
348
351
{ xmlns = Some xmlns; prefix = prefix; uname }
349
352
| _ ->
350
-
Reporter.fatalf
353
+
Reporter.emitf
351
354
?loc
352
355
Resolution_error
353
356
"expected path `%s` to resolve to xmlns"
354
-
prefix
357
+
prefix;
358
+
{ xmlns = None; prefix = ""; uname = "" }
355
359
356
360
and expand_tree_inner (tree : Code.tree) : Syn.tree =
357
361
let trace f =
+7
-1
lib/compiler/Expand.mli
+7
-1
lib/compiler/Expand.mli
···
3
3
*
4
4
* SPDX-License-Identifier: GPL-3.0-or-later
5
5
*)
6
+
open Forester_prelude
7
+
open Forester_core
8
+
9
+
module Unit_map: Map.S
10
+
11
+
type exports = Resolver.P.data Trie.Untagged.t
6
12
7
13
module Env: sig
8
-
type t
14
+
type t = exports Unit_map.t
9
15
val empty : t
10
16
end
11
17
+1
lib/compiler/Forester_compiler.ml
+1
lib/compiler/Forester_compiler.ml
+7
-7
lib/compiler/Grammar.messages
+7
-7
lib/compiler/Grammar.messages
···
4
4
main: TICK
5
5
main: OBJECT LBRACE LSQUARE TEXT RSQUARE WHITESPACE TICK
6
6
main: SUBTREE LBRACE TICK
7
-
main: IDENT TICK
8
7
9
8
Unexpected symbol: '
10
9
10
+
main: IDENT TICK
11
11
main: ALLOC XML_ELT_IDENT
12
12
main: CALL LBRACE RBRACE LBRACE XML_ELT_IDENT
13
13
main: CALL LBRACE RBRACE XML_ELT_IDENT
···
96
96
97
97
main: DATALOG LBRACE WHITESPACE VERBATIM
98
98
99
-
<YOUR SYNTAX ERROR MESSAGE HERE>
99
+
<SYNTAX ERROR 802 HERE>
100
100
101
101
main: DATALOG LBRACE DX_VAR WHITESPACE VERBATIM
102
102
103
-
<YOUR SYNTAX ERROR MESSAGE HERE>
103
+
<SYNTAX ERROR 903 HERE>
104
104
105
105
main: DATALOG LBRACE IDENT DX_ENTAILED LBRACE IDENT DX_ENTAILED
106
106
107
-
<YOUR SYNTAX ERROR MESSAGE HERE>
107
+
<SYNTAX ERROR 951 HERE>
108
108
109
109
main: DATALOG LBRACE IDENT DX_ENTAILED WHITESPACE HASH
110
110
111
-
<YOUR SYNTAX ERROR MESSAGE HERE>
111
+
<SYNTAX ERROR 972 HERE>
112
112
113
113
main: DATALOG LBRACE IDENT RBRACE
114
114
115
-
<YOUR SYNTAX ERROR MESSAGE HERE>
115
+
<SYNTAX ERROR 1020 HERE>
116
116
117
117
main: CALL LBRACE TEXT
118
118
main: CALL LBRACE IDENT TEXT
119
119
120
-
<YOUR SYNTAX ERROR MESSAGE HERE>
120
+
<SYNTAX ERROR 1180 HERE>
121
121
122
122
main: LBRACE IDENT RSQUARE
123
123
main: SCOPE LBRACE IDENT RSQUARE
+9
-117
lib/compiler/Parse.ml
+9
-117
lib/compiler/Parse.ml
···
100
100
lexbuf ->
101
101
(Code.t, Reporter.Message.t Asai.Diagnostic.t) Result.t
102
102
= fun ?(stop_on_err = true) lexbuf ->
103
-
104
-
(* a checkpoint is an intermediate or final state of the parser *)
105
103
let initial_checkpoint = (Grammar.Incremental.main lexbuf.lex_curr_p) in
106
-
107
-
(* The idea is simple: push opening delimiters onto the stack, pop them
108
-
once they are closed. Upon encountering an error, the reported range
109
-
includes the last unclosed delimiter.
110
-
*)
111
104
let delim_stack = Stack.create () in
112
-
113
-
(* The recursive loop.*)
114
-
let fail
115
-
: _ I.checkpoint ->
116
-
(Code.t, Reporter.Message.t Asai.Diagnostic.t) Result.t
117
-
= fun checkpoint ->
118
-
match checkpoint with
119
-
(*
120
-
Consider the source file
121
-
122
-
```
123
-
\def\foo{
124
-
125
-
\p{
126
-
lorem ipsum dolor sit amet
127
-
}
128
-
```
129
-
130
-
Before this patch, the error reported when encountering this was
131
-
undecipherable, since it just hit EOF and then reported unexpected ``.
132
-
133
-
The diagnostic constructed below enlarges the range of the reported
134
-
error to the last unclosed delimiter. This makes the error much more
135
-
understandable
136
-
137
-
```
138
-
￭ ./trees/comment.tree
139
-
1 | \def\foo{
140
-
^ This delimiter is never closed
141
-
2 |
142
-
3 | \p{
143
-
4 | lorem ipsum dolor sit amet
144
-
5 | }
145
-
6 |
146
-
^ Did you forget to close it?
147
-
```
148
-
149
-
However, for implementing an LSP this is insufficient. When
150
-
encountering an error, we produce no value. We need an
151
-
error-resilient parser. We want the parse tree to look something like
152
-
this:
153
-
154
-
1 TREE
155
-
2 FUN_SPEC
156
-
3 NAME "foo"
157
-
4 ARG_LIST []
158
-
5 BODY ERROR
159
-
6 PRIM PARAGRAPH
160
-
7 TEXT "lorem ipsum dolor sit amet"
161
-
162
-
The tricky bit here is that we only know that there is a parse error
163
-
when encountering EOF. How can we derive the fact that the erroneous
164
-
construct is the function definition, and that the error should be
165
-
localised at the unclosed brace?
166
-
167
-
We would need to inspect the parser state and recognize that we are
168
-
currently parsing a function whose body never gets closed, produce a
169
-
value like at line 5, and resume:
170
-
https://gallium.inria.fr/%7Efpottier/menhir/manual.html#sec%3Aincremental%3Aupdating
171
-
172
-
This illustrates the problem with having such strictly typed parse
173
-
tree. Code.t was not able to represent such a failed parse. (I have
174
-
sinced added an error node, so it is now technically possible for
175
-
this specific usecase, but so far it is unused. Furhtermore, the code
176
-
can't represent, for example, trie paths that failed to parse).
177
-
178
-
Aside: Inspired by rust-analyzer and rowan, I am playing around
179
-
with github.com/kentookura/orochi. In rust-analyzer, they use such
180
-
an untyped API and layer a typed AST over it. I haven't gotten
181
-
around to that part yet.
182
-
183
-
Now the use case of the incremental API becomes apparent. It allows
184
-
us to inspect the parser state and travel in time, look back, look
185
-
forward, anything we want.
186
-
187
-
Here are the action items:
188
-
189
-
- Understand what kinds of syntax errors can occur when typing. These
190
-
are the erroneous inputs we are most likely to encounter, as we want
191
-
to make an LSP server. This is stuff like unclosed delimiters, etc.
192
-
193
-
- Understand how we should best recover from erroneous input, for
194
-
example:
195
-
196
-
```
197
-
\ul{
198
-
\li{
199
-
asdf
200
-
}
201
-
{
202
-
}
203
-
```
204
-
205
-
Should report "unexpected {", rather than "unclosed {", and produce
206
-
something like:
207
-
208
-
1 TREE
209
-
2 PRIM OL
210
-
3 PRIM LI
211
-
4 TEXT "asdf"
212
-
5 ERROR "{"
213
-
214
-
- Study the menhir API so that we know how to implement this kind of
215
-
recovery.
216
-
*)
217
-
| I.HandlingError _ -> Reporter.fatalf Parse_error "TODO"
218
-
| _ -> Reporter.fatalf Parse_error "TODO"
219
-
in
220
105
let rec run
221
106
: _ I.checkpoint ->
222
107
_ ->
···
226
111
| I.InputNeeded _env ->
227
112
(* In this phase we push and pop delimiters onto the stack.*)
228
113
let token, start, end_ = supplier () in
114
+
(* NOTE: Should we be storing the checkpoints?
115
+
The reason would be that we might want to resume parsing from an
116
+
unclosed delimiter, and putting an error node where the unclosed
117
+
delimiter was found, and we might only find out that the delimiter
118
+
was not closed upon encountering EOF
119
+
*)
229
120
let start_position = lexbuf.lex_start_p in
230
121
let end_position = lexbuf.lex_curr_p in
231
122
if is_opening_delim token then
···
303
194
parse lexbuf
304
195
with
305
196
| Grammar.Error ->
306
-
Reporter.fatalf ~loc: (Range.of_lexbuf lexbuf) Parse_error "failed to parse"
307
-
| exn -> raise exn
197
+
Error (Asai.Diagnostic.of_text ~loc: (Range.of_lexbuf lexbuf) Error Forester_core.Reporter.Message.Parse_error (Asai.Diagnostic.text "failed to parse"))
198
+
(* | exn -> *)
199
+
(* Error (Asai.Diagnostic.of_text ~loc: (Range.of_lexbuf lexbuf) Error Forester_core.Reporter.Message.Parse_error (Asai.Diagnostic.text "failed to parse")) *)
308
200
309
201
let parse_channel filename ch =
310
202
let lexbuf = Lexing.from_channel ch in
+1
lib/compiler/Resolver.ml
+1
lib/compiler/Resolver.ml
+20
-6
lib/core/Reporter.ml
+20
-6
lib/core/Reporter.ml
···
4
4
* SPDX-License-Identifier: GPL-3.0-or-later
5
5
*)
6
6
7
+
open Base
8
+
7
9
module Message = struct
8
10
type t =
9
-
| Duplicate_tree
11
+
| Tree_not_found of iri
12
+
| Duplicate_tree of iri
10
13
| Parse_error
11
14
| Type_error
12
15
| Type_warning
13
16
| Resolution_error
14
17
| Resolution_warning
15
-
| Expansion_error
16
18
| Duplicate_attribute
17
-
| Frontmatter_in_body
18
19
| Unhandled_case
19
20
| Transclusion_loop
20
21
| Internal_error
···
29
30
[@@deriving show]
30
31
31
32
let default_severity : t -> Asai.Diagnostic.severity = function
32
-
| Duplicate_tree -> Error
33
+
| Duplicate_tree _ -> Error
34
+
| Tree_not_found _ -> Error
33
35
| Parse_error -> Error
34
36
| Type_error -> Error
35
37
| Type_warning -> Warning
36
38
| Resolution_error -> Error
37
39
| Resolution_warning -> Warning
38
-
| Expansion_error -> Error
39
40
| Duplicate_attribute -> Error
40
-
| Frontmatter_in_body -> Error
41
41
| Unhandled_case -> Bug
42
42
| Transclusion_loop -> Error
43
43
| Internal_error -> Bug
···
79
79
in
80
80
let emit _diagnostics = () in
81
81
run ~emit ~fatal k
82
+
83
+
let lsp_run ?init_loc ?init_backtrace publish path k =
84
+
let diagnostics = ref [] in
85
+
let push_diagnostic d =
86
+
diagnostics := d :: !diagnostics
87
+
in
88
+
run
89
+
~emit: push_diagnostic
90
+
~fatal: push_diagnostic
91
+
?init_loc
92
+
?init_backtrace @@
93
+
fun () ->
94
+
k ();
95
+
publish path !diagnostics
+11
-10
lib/frontend/Forest_reader.ml
+11
-10
lib/frontend/Forest_reader.ml
···
60
60
module Job_map_reduce = Map_reduce.Make(Job_runner)
61
61
module Eval_map_reduce = Map_reduce.Make(Eval_runner)
62
62
63
-
let read_trees ~(env : env) ~host (trees : Code.tree list) : T.content T.article list * Job.publication list =
63
+
let expand ~host trees =
64
64
let unexpanded_trees = organise_trees ~host trees in
65
-
let _, expanded_trees =
66
-
let task addr (units, trees) =
67
-
match String_map.find_opt addr unexpanded_trees with
68
-
| None -> units, trees
69
-
| Some tree ->
70
-
let units, syn = Expand.expand_tree units tree in
71
-
units, (addr, tree.source_path, syn) :: trees
72
-
in
73
-
Import_graph.topo_fold task (Import_graph.build trees) (Expand.Env.empty, [])
65
+
let task addr (units, trees) =
66
+
match String_map.find_opt addr unexpanded_trees with
67
+
| None -> units, trees
68
+
| Some tree ->
69
+
let units, syn = Expand.expand_tree units tree in
70
+
units, (addr, tree.source_path, syn) :: trees
74
71
in
72
+
Import_graph.topo_fold task (Import_graph.build trees) (Expand.Env.empty, [])
73
+
74
+
let read_trees ~(env : env) ~host (trees : Code.tree list) : T.content T.article list * Job.publication list =
75
+
let _, expanded_trees = expand ~host trees in
75
76
let Eval_runner.{ articles; jobs } = Eval_map_reduce.reduce ~env: { host } expanded_trees in
76
77
let job_results =
77
78
Job_map_reduce.reduce
+6
lib/frontend/Forester.mli
+6
lib/frontend/Forester.mli
···
9
9
type env = Eio_unix.Stdenv.base
10
10
type dir = Eio.Fs.dir_ty Eio.Path.t
11
11
12
+
val parse_trees_in_dirs :
13
+
dev: bool ->
14
+
?ignore_malformed: bool ->
15
+
Eio.Fs.dir_ty Eio.Path.t list ->
16
+
Forester_compiler.Code.tree list
17
+
12
18
val plant_raw_forest_from_dirs :
13
19
env: env ->
14
20
host: string ->