The unpac monorepo manager self-hosting as a monorepo using unpac
Format_doc: preserve the type of Foo.report_error, add Foo.report_error_doc (#13311)
* Format_doc: preserve the type of Foo.report_error, add Foo.report_error_doc
The introduction of Format_doc changed the type of various
'reprot_error' functions in the compiler codebase. But this breaks
user code. An alternative proposed here is to keep 'report_error'
at the same type as before and introduce 'report_error_doc' in addition.
authored by
Gabriel Scherer
and committed by
GitHub
fb010ad9
96afe938
+186
-104
-6
.depend
-6
.depend
···
8113
8113
debugger/input_handling.cmi \
8114
8114
debugger/history.cmi \
8115
8115
debugger/frames.cmi \
8116
-
utils/format_doc.cmi \
8117
8116
debugger/events.cmi \
8118
8117
debugger/eval.cmi \
8119
8118
typing/envaux.cmi \
···
8153
8152
debugger/input_handling.cmx \
8154
8153
debugger/history.cmx \
8155
8154
debugger/frames.cmx \
8156
-
utils/format_doc.cmx \
8157
8155
debugger/events.cmx \
8158
8156
debugger/eval.cmx \
8159
8157
typing/envaux.cmx \
···
8383
8381
utils/load_path.cmi \
8384
8382
debugger/input_handling.cmi \
8385
8383
debugger/frames.cmi \
8386
-
utils/format_doc.cmi \
8387
8384
debugger/exec.cmi \
8388
8385
debugger/debugger_config.cmi \
8389
8386
utils/config.cmi \
···
8407
8404
utils/load_path.cmx \
8408
8405
debugger/input_handling.cmx \
8409
8406
debugger/frames.cmx \
8410
-
utils/format_doc.cmx \
8411
8407
debugger/exec.cmx \
8412
8408
debugger/debugger_config.cmx \
8413
8409
utils/config.cmx \
···
8749
8745
ocamldoc/odoc_ast.cmi \
8750
8746
parsing/location.cmi \
8751
8747
parsing/lexer.cmi \
8752
-
utils/format_doc.cmi \
8753
8748
typing/env.cmi \
8754
8749
driver/compmisc.cmi \
8755
8750
utils/clflags.cmi \
···
8778
8773
ocamldoc/odoc_ast.cmx \
8779
8774
parsing/location.cmx \
8780
8775
parsing/lexer.cmx \
8781
-
utils/format_doc.cmx \
8782
8776
typing/env.cmx \
8783
8777
driver/compmisc.cmx \
8784
8778
utils/clflags.cmx \
+2
-2
Changes
+2
-2
Changes
···
339
339
platforms (Linux, *BSD).
340
340
(Miod Vallat, review by Nicolás Ojeda Bär)
341
341
342
-
- #13169: Introduce a document data type for compiler messages rather than
343
-
relying on `Format.formatter -> unit` closures.
342
+
- #13169, #13311: Introduce a document data type for compiler messages
343
+
rather than relying on `Format.formatter -> unit` closures.
344
344
(Florian Angeletti, review by Gabriel Scherer)
345
345
346
346
- #13193: Remove the unused env_init field from class blocks
+5
-3
asmcomp/asmgen.ml
+5
-3
asmcomp/asmgen.ml
···
312
312
module Style = Misc.Style
313
313
let fprintf, dprintf = Format_doc.fprintf, Format_doc.dprintf
314
314
315
-
let report_error ppf = function
315
+
let report_error_doc ppf = function
316
316
| Assembler_error file ->
317
317
fprintf ppf "Assembler error, input left in file %a"
318
318
Location.Doc.quoted_filename file
···
327
327
| Asm_generation(fn, err) ->
328
328
fprintf ppf
329
329
"Error producing assembly code for function %a: %a"
330
-
Style.inline_code fn Emitaux.report_error err
330
+
Style.inline_code fn Emitaux.report_error_doc err
331
331
332
332
let () =
333
333
Location.register_error_of_exn
334
334
(function
335
-
| Error err -> Some (Location.error_of_printer_file report_error err)
335
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
336
336
| _ -> None
337
337
)
338
+
339
+
let report_error = Format_doc.compat report_error_doc
+2
-1
asmcomp/asmgen.mli
+2
-1
asmcomp/asmgen.mli
···
45
45
| Asm_generation of string * Emitaux.error
46
46
47
47
exception Error of error
48
-
val report_error: error Format_doc.printer
48
+
val report_error: error Format_doc.format_printer
49
+
val report_error_doc: error Format_doc.printer
49
50
50
51
val compile_unit
51
52
: output_prefix:string
+5
-3
asmcomp/asmlibrarian.ml
+5
-3
asmcomp/asmlibrarian.ml
···
86
86
module Style = Misc.Style
87
87
open Format_doc
88
88
89
-
let report_error ppf = function
89
+
let report_error_doc ppf = function
90
90
| File_not_found name ->
91
91
fprintf ppf "Cannot find file %a" Style.inline_code name
92
92
| Archiver_error name ->
93
93
fprintf ppf "Error while creating the library %a" Style.inline_code name
94
94
| Link_error e ->
95
-
Linkdeps.report_error ~print_filename:Location.Doc.filename ppf e
95
+
Linkdeps.report_error_doc ~print_filename:Location.Doc.filename ppf e
96
96
97
97
let () =
98
98
Location.register_error_of_exn
99
99
(function
100
-
| Error err -> Some (Location.error_of_printer_file report_error err)
100
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
101
101
| _ -> None
102
102
)
103
+
104
+
let report_error = Format_doc.compat report_error_doc
+2
-1
asmcomp/asmlibrarian.mli
+2
-1
asmcomp/asmlibrarian.mli
+5
-3
asmcomp/asmlink.ml
+5
-3
asmcomp/asmlink.ml
···
362
362
module Style = Misc.Style
363
363
open Format_doc
364
364
365
-
let report_error ppf = function
365
+
let report_error_doc ppf = function
366
366
| File_not_found name ->
367
367
fprintf ppf "Cannot find file %a" Style.inline_code name
368
368
| Not_an_object_file name ->
···
402
402
Style.inline_code "-I"
403
403
Style.inline_code (name^".cmx")
404
404
| Link_error e ->
405
-
Linkdeps.report_error ~print_filename:Location.Doc.filename ppf e
405
+
Linkdeps.report_error_doc ~print_filename:Location.Doc.filename ppf e
406
406
407
407
let () =
408
408
Location.register_error_of_exn
409
409
(function
410
-
| Error err -> Some (Location.error_of_printer_file report_error err)
410
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
411
411
| _ -> None
412
412
)
413
+
414
+
let report_error = Format_doc.compat report_error_doc
413
415
414
416
let reset () =
415
417
Cmi_consistbl.clear crc_interfaces;
+2
-1
asmcomp/asmlink.mli
+2
-1
asmcomp/asmlink.mli
+4
-2
asmcomp/asmpackager.ml
+4
-2
asmcomp/asmpackager.ml
···
284
284
open Format_doc
285
285
module Style = Misc.Style
286
286
287
-
let report_error ppf = function
287
+
let report_error_doc ppf = function
288
288
Illegal_renaming(name, file, id) ->
289
289
fprintf ppf "Wrong file naming: %a@ contains the code for\
290
290
@ %a when %a was expected"
···
307
307
let () =
308
308
Location.register_error_of_exn
309
309
(function
310
-
| Error err -> Some (Location.error_of_printer_file report_error err)
310
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
311
311
| _ -> None
312
312
)
313
+
314
+
let report_error = Format_doc.compat report_error_doc
+2
-1
asmcomp/asmpackager.mli
+2
-1
asmcomp/asmpackager.mli
+4
-2
asmcomp/emitaux.ml
+4
-2
asmcomp/emitaux.ml
···
457
457
let binary_backend_available = ref false
458
458
let create_asm_file = ref true
459
459
460
-
let report_error ppf = function
460
+
let report_error_doc ppf = function
461
461
| Stack_frame_too_large n ->
462
462
Format_doc.fprintf ppf "stack frame too large (%d bytes)" n
463
463
464
464
let () =
465
465
Location.register_error_of_exn
466
466
(function
467
-
| Error err -> Some (Location.error_of_printer_file report_error err)
467
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
468
468
| _ -> None
469
469
)
470
+
471
+
let report_error = Format_doc.compat report_error_doc
470
472
471
473
let mk_env f : Emitenv.per_function_env =
472
474
{
+2
-1
asmcomp/emitaux.mli
+2
-1
asmcomp/emitaux.mli
···
87
87
| Stack_frame_too_large of int
88
88
89
89
exception Error of error
90
-
val report_error: error Format_doc.printer
90
+
val report_error: error Format_doc.format_printer
91
+
val report_error_doc: error Format_doc.printer
91
92
92
93
val mk_env : Linear.fundecl -> Emitenv.per_function_env
93
94
+5
-3
bytecomp/bytelibrarian.ml
+5
-3
bytecomp/bytelibrarian.ml
···
124
124
open Format_doc
125
125
module Style = Misc.Style
126
126
127
-
let report_error ppf = function
127
+
let report_error_doc ppf = function
128
128
| File_not_found name ->
129
129
fprintf ppf "Cannot find file %a" Style.inline_code name
130
130
| Not_an_object_file name ->
131
131
fprintf ppf "The file %a is not a bytecode object file"
132
132
Location.Doc.quoted_filename name
133
133
| Link_error e ->
134
-
Linkdeps.report_error ~print_filename:Location.Doc.filename ppf e
134
+
Linkdeps.report_error_doc ~print_filename:Location.Doc.filename ppf e
135
135
136
136
let () =
137
137
Location.register_error_of_exn
138
138
(function
139
-
| Error err -> Some (Location.error_of_printer_file report_error err)
139
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
140
140
| _ -> None
141
141
)
142
+
143
+
let report_error = Format_doc.compat report_error_doc
142
144
143
145
let reset () =
144
146
lib_ccobjs := [];
+2
-1
bytecomp/bytelibrarian.mli
+2
-1
bytecomp/bytelibrarian.mli
+6
-4
bytecomp/bytelink.ml
+6
-4
bytecomp/bytelink.ml
···
871
871
open Format_doc
872
872
module Style = Misc.Style
873
873
874
-
let report_error ppf = function
874
+
let report_error_doc ppf = function
875
875
| File_not_found name ->
876
876
fprintf ppf "Cannot find file %a"
877
877
Location.Doc.quoted_filename name
···
885
885
| Symbol_error(name, err) ->
886
886
fprintf ppf "Error while linking %a:@ %a"
887
887
Location.Doc.quoted_filename name
888
-
Symtable.report_error err
888
+
Symtable.report_error_doc err
889
889
| Inconsistent_import(intf, file1, file2) ->
890
890
fprintf ppf
891
891
"@[<hov>Files %a@ and %a@ \
···
906
906
Style.inline_code header
907
907
Style.inline_code msg
908
908
| Link_error e ->
909
-
Linkdeps.report_error ~print_filename:Location.Doc.filename ppf e
909
+
Linkdeps.report_error_doc ~print_filename:Location.Doc.filename ppf e
910
910
911
911
let () =
912
912
Location.register_error_of_exn
913
913
(function
914
-
| Error err -> Some (Location.error_of_printer_file report_error err)
914
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
915
915
| _ -> None
916
916
)
917
+
918
+
let report_error = Format_doc.compat report_error_doc
917
919
918
920
let reset () =
919
921
lib_ccobjs := [];
+2
-1
bytecomp/bytelink.mli
+2
-1
bytecomp/bytelink.mli
+4
-2
bytecomp/bytepackager.ml
+4
-2
bytecomp/bytepackager.ml
···
347
347
open Format_doc
348
348
module Style = Misc.Style
349
349
350
-
let report_error ppf = function
350
+
let report_error_doc ppf = function
351
351
Forward_reference(file, compunit) ->
352
352
fprintf ppf "Forward reference to %a in file %a"
353
353
Style.inline_code (Compunit.name compunit)
···
372
372
let () =
373
373
Location.register_error_of_exn
374
374
(function
375
-
| Error err -> Some (Location.error_of_printer_file report_error err)
375
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
376
376
| _ -> None
377
377
)
378
+
379
+
let report_error = Format_doc.compat report_error_doc
+2
-1
bytecomp/bytepackager.mli
+2
-1
bytecomp/bytepackager.mli
+4
-2
bytecomp/symtable.ml
+4
-2
bytecomp/symtable.ml
···
440
440
441
441
open Format_doc
442
442
443
-
let report_error ppf = function
443
+
let report_error_doc ppf = function
444
444
| Undefined_global global ->
445
445
fprintf ppf "Reference to undefined %a" Global.description global
446
446
| Unavailable_primitive s ->
···
456
456
let () =
457
457
Location.register_error_of_exn
458
458
(function
459
-
| Error err -> Some (Location.error_of_printer_file report_error err)
459
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
460
460
| _ -> None
461
461
)
462
+
463
+
let report_error = Format_doc.compat report_error_doc
462
464
463
465
let reset () =
464
466
global_table := GlobalMap.empty;
+2
-1
bytecomp/symtable.mli
+2
-1
bytecomp/symtable.mli
+3
-3
debugger/command_line.ml
+3
-3
debugger/command_line.ml
···
516
516
env_of_event !selected_event
517
517
with
518
518
| Envaux.Error msg ->
519
-
Format_doc.compat Envaux.report_error ppf msg;
519
+
Envaux.report_error ppf msg;
520
520
raise Toplevel
521
521
in
522
522
List.iter (print_expr depth !selected_event env ppf) exprs
···
533
533
env_of_event !selected_event
534
534
with
535
535
| Envaux.Error msg ->
536
-
Format_doc.compat Envaux.report_error ppf msg;
536
+
Envaux.report_error ppf msg;
537
537
raise Toplevel
538
538
in
539
539
let print_addr expr =
···
622
622
env_of_event !selected_event
623
623
with
624
624
| Envaux.Error msg ->
625
-
Format_doc.compat Envaux.report_error ppf msg;
625
+
Envaux.report_error ppf msg;
626
626
raise Toplevel
627
627
in
628
628
begin try
+2
-2
debugger/main.ml
+2
-2
debugger/main.ml
···
233
233
| Toplevel ->
234
234
exit 2
235
235
| Persistent_env.Error e ->
236
-
report (Format_doc.compat Persistent_env.report_error) e;
236
+
report Persistent_env.report_error e;
237
237
exit 2
238
238
| Cmi_format.Error e ->
239
-
report (Format_doc.compat Cmi_format.report_error) e;
239
+
report Cmi_format.report_error e;
240
240
exit 2
+4
-2
driver/pparse.ml
+4
-2
driver/pparse.ml
···
218
218
let file ~tool_name inputfile parse_fun ast_kind =
219
219
file_aux ~tool_name ~sourcefile:inputfile inputfile parse_fun ignore ast_kind
220
220
221
-
let report_error ppf = function
221
+
let report_error_doc ppf = function
222
222
| CannotRun cmd ->
223
223
fprintf ppf "Error while running external preprocessor@.\
224
224
Command line: %s@." cmd
···
229
229
let () =
230
230
Location.register_error_of_exn
231
231
(function
232
-
| Error err -> Some (Location.error_of_printer_file report_error err)
232
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
233
233
| _ -> None
234
234
)
235
+
236
+
let report_error = Format_doc.compat report_error_doc
235
237
236
238
let parse_file ~tool_name invariant_fun parse kind sourcefile =
237
239
Location.input_name := sourcefile;
+2
-1
driver/pparse.mli
+2
-1
driver/pparse.mli
···
51
51
?restore:bool -> tool_name:string -> Parsetree.signature ->
52
52
Parsetree.signature
53
53
54
-
val report_error : error Format_doc.printer
54
+
val report_error : error Format_doc.format_printer
55
+
val report_error_doc: error Format_doc.printer
55
56
56
57
57
58
val parse_implementation:
+4
-2
file_formats/cmi_format.ml
+4
-2
file_formats/cmi_format.ml
···
96
96
97
97
open Format_doc
98
98
99
-
let report_error ppf = function
99
+
let report_error_doc ppf = function
100
100
| Not_an_interface filename ->
101
101
fprintf ppf "%a@ is not a compiled interface"
102
102
Location.Doc.quoted_filename filename
···
112
112
let () =
113
113
Location.register_error_of_exn
114
114
(function
115
-
| Error err -> Some (Location.error_of_printer_file report_error err)
115
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
116
116
| _ -> None
117
117
)
118
+
119
+
let report_error = Format_doc.compat report_error_doc
+2
-1
file_formats/cmi_format.mli
+2
-1
file_formats/cmi_format.mli
+4
-2
lambda/translclass.ml
+4
-2
lambda/translclass.ml
···
997
997
open Format_doc
998
998
module Style = Misc.Style
999
999
1000
-
let report_error ppf = function
1000
+
let report_error_doc ppf = function
1001
1001
| Tags (lab1, lab2) ->
1002
1002
fprintf ppf "Method labels %a and %a are incompatible.@ %s"
1003
1003
Style.inline_code lab1
···
1008
1008
Location.register_error_of_exn
1009
1009
(function
1010
1010
| Error (loc, err) ->
1011
-
Some (Location.error_of_printer ~loc report_error err)
1011
+
Some (Location.error_of_printer ~loc report_error_doc err)
1012
1012
| _ ->
1013
1013
None
1014
1014
)
1015
+
1016
+
let report_error = Format_doc.compat report_error_doc
+2
-1
lambda/translclass.mli
+2
-1
lambda/translclass.mli
+4
-2
lambda/translcore.ml
+4
-2
lambda/translcore.ml
···
1315
1315
1316
1316
open Format_doc
1317
1317
1318
-
let report_error ppf = function
1318
+
let report_error_doc ppf = function
1319
1319
| Free_super_var ->
1320
1320
fprintf ppf
1321
1321
"Ancestor names can only be used to select inherited methods"
···
1326
1326
Location.register_error_of_exn
1327
1327
(function
1328
1328
| Error (loc, err) ->
1329
-
Some (Location.error_of_printer ~loc report_error err)
1329
+
Some (Location.error_of_printer ~loc report_error_doc err)
1330
1330
| _ ->
1331
1331
None
1332
1332
)
1333
+
1334
+
let report_error = Format_doc.compat report_error_doc
+2
-1
lambda/translcore.mli
+2
-1
lambda/translcore.mli
···
45
45
46
46
exception Error of Location.t * error
47
47
48
-
val report_error: error Format_doc.printer
48
+
val report_error: error Format_doc.format_printer
49
+
val report_error_doc: error Format_doc.printer
49
50
50
51
(* Forward declaration -- to be filled in by Translmod.transl_module *)
51
52
val transl_module :
+4
-2
lambda/translprim.ml
+4
-2
lambda/translprim.ml
···
873
873
open Format_doc
874
874
module Style = Misc.Style
875
875
876
-
let report_error ppf = function
876
+
let report_error_doc ppf = function
877
877
| Unknown_builtin_primitive prim_name ->
878
878
fprintf ppf "Unknown builtin primitive %a" Style.inline_code prim_name
879
879
| Wrong_arity_builtin_primitive prim_name ->
···
884
884
Location.register_error_of_exn
885
885
(function
886
886
| Error (loc, err) ->
887
-
Some (Location.error_of_printer ~loc report_error err)
887
+
Some (Location.error_of_printer ~loc report_error_doc err)
888
888
| _ ->
889
889
None
890
890
)
891
+
892
+
let report_error = Format_doc.compat report_error_doc
+2
-1
lambda/translprim.mli
+2
-1
lambda/translprim.mli
+4
-2
middle_end/compilenv.ml
+4
-2
middle_end/compilenv.ml
···
455
455
open Format_doc
456
456
module Style = Misc.Style
457
457
458
-
let report_error ppf = function
458
+
let report_error_doc ppf = function
459
459
| Not_a_unit_info filename ->
460
460
fprintf ppf "%a@ is not a compilation unit description."
461
461
Location.Doc.quoted_filename filename
···
485
485
let () =
486
486
Location.register_error_of_exn
487
487
(function
488
-
| Error err -> Some (Location.error_of_printer_file report_error err)
488
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
489
489
| _ -> None
490
490
)
491
+
492
+
let report_error = Format_doc.compat report_error_doc
+2
-1
middle_end/compilenv.mli
+2
-1
middle_end/compilenv.mli
+1
-1
ocamldoc/odoc_analyse.ml
+1
-1
ocamldoc/odoc_analyse.ml
+4
-2
parsing/attr_helper.ml
+4
-2
parsing/attr_helper.ml
···
41
41
42
42
open Format_doc
43
43
44
-
let report_error ppf = function
44
+
let report_error_doc ppf = function
45
45
| Multiple_attributes name ->
46
46
fprintf ppf "Too many %a attributes" Style.inline_code name
47
47
| No_payload_expected name ->
···
51
51
Location.register_error_of_exn
52
52
(function
53
53
| Error (loc, err) ->
54
-
Some (Location.error_of_printer ~loc report_error err)
54
+
Some (Location.error_of_printer ~loc report_error_doc err)
55
55
| _ ->
56
56
None
57
57
)
58
+
59
+
let report_error = Format_doc.compat report_error_doc
+2
-1
parsing/attr_helper.mli
+2
-1
parsing/attr_helper.mli
+1
-1
toplevel/topcommon.ml
+1
-1
toplevel/topcommon.ml
···
406
406
let loading_hint_printer ppf cu =
407
407
let open Format_doc in
408
408
let global = Symtable.Global.Glob_compunit (Cmo_format.Compunit cu) in
409
-
Symtable.report_error ppf (Symtable.Undefined_global global);
409
+
Symtable.report_error_doc ppf (Symtable.Undefined_global global);
410
410
let find_with_ext ext =
411
411
try Some (Load_path.find_normalized (cu ^ ext)) with Not_found -> None
412
412
in
+7
-4
typing/env.ml
+7
-4
typing/env.ml
···
3554
3554
3555
3555
let quoted_longident = Style.as_inline_code pp_longident
3556
3556
3557
-
let report_lookup_error _loc env ppf = function
3557
+
let report_lookup_error_doc _loc env ppf = function
3558
3558
| Unbound_value(lid, hint) -> begin
3559
3559
fprintf ppf "Unbound value %a" quoted_longident lid;
3560
3560
spellcheck ppf extract_values env lid;
···
3670
3670
quoted_longident lid
3671
3671
(Style.as_inline_code pp_path) p cause
3672
3672
3673
-
let report_error ppf = function
3673
+
let report_error_doc ppf = function
3674
3674
| Missing_module(_, path1, path2) ->
3675
3675
fprintf ppf "@[@[<hov>";
3676
3676
if Path.same path1 path2 then
···
3687
3687
| Illegal_value_name(_loc, name) ->
3688
3688
fprintf ppf "%a is not a valid value identifier."
3689
3689
Style.inline_code name
3690
-
| Lookup_error(loc, t, err) -> report_lookup_error loc t ppf err
3690
+
| Lookup_error(loc, t, err) -> report_lookup_error_doc loc t ppf err
3691
3691
3692
3692
let () =
3693
3693
Location.register_error_of_exn
···
3704
3704
then Location.error_of_printer_file
3705
3705
else Location.error_of_printer ~loc ?sub:None ?footnote:None
3706
3706
in
3707
-
Some (error_of_printer report_error err)
3707
+
Some (error_of_printer report_error_doc err)
3708
3708
| _ ->
3709
3709
None
3710
3710
)
3711
+
3712
+
let report_lookup_error = Format_doc.compat2 report_lookup_error_doc
3713
+
let report_error = Format_doc.compat report_error_doc
+6
-2
typing/env.mli
+6
-2
typing/env.mli
···
448
448
exception Error of error
449
449
450
450
451
-
val report_error: error Format_doc.printer
451
+
val report_error: error Format_doc.format_printer
452
+
val report_error_doc: error Format_doc.printer
452
453
453
-
val report_lookup_error: Location.t -> t -> lookup_error Format_doc.printer
454
+
val report_lookup_error:
455
+
Location.t -> t -> lookup_error Format_doc.format_printer
456
+
val report_lookup_error_doc:
457
+
Location.t -> t -> lookup_error Format_doc.printer
454
458
val in_signature: bool -> t -> t
455
459
456
460
val is_in_signature: t -> bool
+4
-2
typing/envaux.ml
+4
-2
typing/envaux.ml
···
104
104
open Format_doc
105
105
module Style = Misc.Style
106
106
107
-
let report_error ppf = function
107
+
let report_error_doc ppf = function
108
108
| Module_not_found p ->
109
109
fprintf ppf "@[Cannot find module %a@].@."
110
110
(Style.as_inline_code Printtyp.path) p
···
112
112
let () =
113
113
Location.register_error_of_exn
114
114
(function
115
-
| Error err -> Some (Location.error_of_printer_file report_error err)
115
+
| Error err -> Some (Location.error_of_printer_file report_error_doc err)
116
116
| _ -> None
117
117
)
118
+
119
+
let report_error = Format_doc.compat report_error_doc
+2
-1
typing/envaux.mli
+2
-1
typing/envaux.mli
+3
-1
typing/includeclass.ml
+3
-1
typing/includeclass.ml
···
103
103
| CM_Private_method lab ->
104
104
fprintf ppf "@[The private method %s cannot become public@]" lab
105
105
106
-
let report_error mode ppf = function
106
+
let report_error_doc mode ppf = function
107
107
| [] -> ()
108
108
| err :: errs ->
109
109
let print_errs ppf errs =
110
110
List.iter (fun err -> fprintf ppf "@ %a" (include_err mode) err) errs in
111
111
fprintf ppf "@[<v>%a%a@]" (include_err mode) err print_errs errs
112
+
113
+
let report_error mode = Format_doc.compat (report_error_doc mode)
+2
typing/includeclass.mli
+2
typing/includeclass.mli
+6
-6
typing/includemod_errorprinter.ml
+6
-6
typing/includemod_errorprinter.ml
···
696
696
(Printtyp.tree_of_cltype_declaration id diff.got Trec_first)
697
697
!Oprint.out_sig_item
698
698
(Printtyp.tree_of_cltype_declaration id diff.expected Trec_first)
699
-
(Includeclass.report_error Type_scheme) diff.symptom
699
+
(Includeclass.report_error_doc Type_scheme) diff.symptom
700
700
| Err.Class_declarations {got;expected;symptom} ->
701
701
let t1 = Printtyp.tree_of_class_declaration id got Trec_first in
702
702
let t2 = Printtyp.tree_of_class_declaration id expected Trec_first in
···
705
705
%a@;<1 -2>does not match@ %a@]@ %a"
706
706
!Oprint.out_sig_item t1
707
707
!Oprint.out_sig_item t2
708
-
(Includeclass.report_error Type_scheme) symptom
708
+
(Includeclass.report_error_doc Type_scheme) symptom
709
709
710
710
let missing_field ppf item =
711
711
let id, loc, kind = Includemod.item_ident_name item in
···
940
940
Printtyp.wrap_printing_env ~error:true env
941
941
(fun () -> (coalesce @@ all env err) ppf)
942
942
943
-
let report_error err =
943
+
let report_error_doc err =
944
944
Location.errorf
945
945
~loc:Location.(in_file !input_name)
946
946
~footnote:Printtyp.Conflicts.err_msg
947
947
"%a" err_msgs err
948
948
949
-
let report_apply_error ~loc env (app_name, mty_f, args) =
949
+
let report_apply_error_doc ~loc env (app_name, mty_f, args) =
950
950
let footnote = Printtyp.Conflicts.err_msg in
951
951
let d = Functor_suberror.App.patch env ~f:mty_f ~args in
952
952
match d with
···
1014
1014
let register () =
1015
1015
Location.register_error_of_exn
1016
1016
(function
1017
-
| Includemod.Error err -> Some (report_error err)
1017
+
| Includemod.Error err -> Some (report_error_doc err)
1018
1018
| Includemod.Apply_error {loc; env; app_name; mty_f; args} ->
1019
1019
Some (Printtyp.wrap_printing_env env ~error:true (fun () ->
1020
-
report_apply_error ~loc env (app_name, mty_f, args))
1020
+
report_apply_error_doc ~loc env (app_name, mty_f, args))
1021
1021
)
1022
1022
| _ -> None
1023
1023
)
+5
-3
typing/persistent_env.ml
+5
-3
typing/persistent_env.ml
···
244
244
Location.prerr_warning loc warn
245
245
| Cmi_format.Error err ->
246
246
let msg = Format.asprintf "%a"
247
-
(Format_doc.compat Cmi_format.report_error) err in
247
+
Cmi_format.report_error err in
248
248
let warn = Warnings.No_cmi_file(name, Some msg) in
249
249
Location.prerr_warning loc warn
250
250
| Error err ->
···
351
351
)
352
352
~exceptionally:(fun () -> remove_file filename)
353
353
354
-
let report_error ppf =
354
+
let report_error_doc ppf =
355
355
let open Format_doc in
356
356
function
357
357
| Illegal_renaming(modname, ps_name, filename) -> fprintf ppf
···
377
377
Location.register_error_of_exn
378
378
(function
379
379
| Error err ->
380
-
Some (Location.error_of_printer_file report_error err)
380
+
Some (Location.error_of_printer_file report_error_doc err)
381
381
| _ -> None
382
382
)
383
+
384
+
let report_error = Format_doc.compat report_error_doc
+2
-1
typing/persistent_env.mli
+2
-1
typing/persistent_env.mli
+7
-5
typing/typeclass.ml
+7
-5
typing/typeclass.ml
···
1977
1977
1978
1978
let out_type ppf t = Style.as_inline_code !Oprint.out_type ppf t
1979
1979
1980
-
let report_error env ppf =
1980
+
let report_error_doc env ppf =
1981
1981
let pp_args ppf args =
1982
1982
let args = List.map (Printtyp.tree_of_typexp Type) args in
1983
1983
Style.as_inline_code !Oprint.out_type_args ppf args
···
2092
2092
pp_args params
2093
2093
pp_args cstrs
2094
2094
| Class_match_failure error ->
2095
-
Includeclass.report_error Type ppf error
2095
+
Includeclass.report_error_doc Type ppf error
2096
2096
| Unbound_val lab ->
2097
2097
fprintf ppf "Unbound instance variable %a" Style.inline_code lab
2098
2098
| Unbound_type_var (msg, reason) ->
···
2174
2174
completely defined.@]"
2175
2175
(Style.as_inline_code Printtyp.type_scheme) sign.csig_self
2176
2176
2177
-
let report_error env ppf err =
2177
+
let report_error_doc env ppf err =
2178
2178
Printtyp.wrap_printing_env ~error:true
2179
-
env (fun () -> report_error env ppf err)
2179
+
env (fun () -> report_error_doc env ppf err)
2180
2180
2181
2181
let () =
2182
2182
Location.register_error_of_exn
2183
2183
(function
2184
2184
| Error (loc, env, err) ->
2185
-
Some (Location.error_of_printer ~loc (report_error env) err)
2185
+
Some (Location.error_of_printer ~loc (report_error_doc env) err)
2186
2186
| Error_forward err ->
2187
2187
Some err
2188
2188
| _ ->
2189
2189
None
2190
2190
)
2191
+
2192
+
let report_error = Format_doc.compat1 report_error_doc
+2
-1
typing/typeclass.mli
+2
-1
typing/typeclass.mli
···
127
127
exception Error of Location.t * Env.t * error
128
128
exception Error_forward of Location.error
129
129
130
-
val report_error : Env.t -> error Format_doc.printer
130
+
val report_error : Env.t -> Format.formatter -> error -> unit
131
+
val report_error_doc : Env.t -> error Format_doc.printer
131
132
132
133
(* Forward decl filled in by Typemod.type_open_descr *)
133
134
val type_open_descr :
+4
-2
typing/typedecl.ml
+4
-2
typing/typedecl.ml
···
1972
1972
end
1973
1973
1974
1974
let quoted_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty
1975
-
let report_error ppf = function
1975
+
let report_error_doc ppf = function
1976
1976
| Repeated_parameter ->
1977
1977
fprintf ppf "A type parameter occurs several times"
1978
1978
| Duplicate_constructor s ->
···
2259
2259
Location.register_error_of_exn
2260
2260
(function
2261
2261
| Error (loc, err) ->
2262
-
Some (Location.error_of_printer ~loc report_error err)
2262
+
Some (Location.error_of_printer ~loc report_error_doc err)
2263
2263
| _ ->
2264
2264
None
2265
2265
)
2266
+
2267
+
let report_error = Format_doc.compat report_error_doc
+2
-1
typing/typedecl.mli
+2
-1
typing/typedecl.mli
+3
-1
typing/typemod.ml
+3
-1
typing/typemod.ml
···
3447
3447
"The type of this packed module refers to %a, which is missing"
3448
3448
(Style.as_inline_code path) p
3449
3449
| Badly_formed_signature (context, err) ->
3450
-
Location.errorf ~loc "@[In %s:@ %a@]" context Typedecl.report_error err
3450
+
Location.errorf ~loc "@[In %s:@ %a@]"
3451
+
context
3452
+
Typedecl.report_error_doc err
3451
3453
| Cannot_hide_id Illegal_shadowing
3452
3454
{ shadowed_item_kind; shadowed_item_id; shadowed_item_loc;
3453
3455
shadower_id; user_id; user_kind; user_loc } ->
+4
-2
typing/typetexp.ml
+4
-2
typing/typetexp.ml
···
854
854
let pp_tag ppf t = fprintf ppf "`%s" t
855
855
let pp_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty
856
856
857
-
let report_error env ppf = function
857
+
let report_error_doc env ppf = function
858
858
| Unbound_type_variable (name, in_scope_names) ->
859
859
fprintf ppf "The type variable %a is unbound in this type declaration.@ %a"
860
860
Style.inline_code name
···
962
962
Location.register_error_of_exn
963
963
(function
964
964
| Error (loc, env, err) ->
965
-
Some (Location.error_of_printer ~loc (report_error env) err)
965
+
Some (Location.error_of_printer ~loc (report_error_doc env) err)
966
966
| Error_forward err ->
967
967
Some err
968
968
| _ ->
969
969
None
970
970
)
971
+
972
+
let report_error env = Format_doc.compat (report_error_doc env)
+2
-1
typing/typetexp.mli
+2
-1
typing/typetexp.mli
···
95
95
96
96
exception Error of Location.t * Env.t * error
97
97
98
-
val report_error: Env.t -> error Format_doc.printer
98
+
val report_error: Env.t -> error Format_doc.format_printer
99
+
val report_error_doc: Env.t -> error Format_doc.printer
99
100
100
101
(* Support for first-class modules. *)
101
102
val transl_modtype_longident: (* from Typemod *)
+4
utils/format_doc.ml
+4
utils/format_doc.ml
···
422
422
f r x;
423
423
!r
424
424
425
+
type 'a format_printer = Format.formatter -> 'a -> unit
426
+
425
427
let format_printer f ppf x =
426
428
let doc = doc_printer f x Doc.empty in
427
429
Doc.format ppf doc
428
430
let compat = format_printer
431
+
let compat1 f p1 = compat (f p1)
432
+
let compat2 f p1 p2 = compat (f p1 p2)
429
433
430
434
let kasprintf k fmt =
431
435
kdoc_printf (fun doc -> k (Format.asprintf "%a" Doc.format doc)) fmt
+4
-1
utils/format_doc.mli
+4
-1
utils/format_doc.mli
···
159
159
(** [formatter rdoc] creates a {!formatter} that updates the [rdoc] reference *)
160
160
161
161
(** Translate a {!Format_doc} printer to a {!Format} one. *)
162
-
val compat: 'a printer -> Format.formatter -> 'a -> unit
162
+
type 'a format_printer = Format.formatter -> 'a -> unit
163
+
val compat: 'a printer -> 'a format_printer
164
+
val compat1: ('p1 -> 'a printer) -> ('p1 -> 'a format_printer)
165
+
val compat2: ('p1 -> 'p2 -> 'a printer) -> ('p1 -> 'p2 -> 'a format_printer)
163
166
164
167
(** If necessary, embbed a {!Format} printer inside a formatting instruction
165
168
stream. This breaks every guarantees provided by {!Format_doc}. *)
+4
-1
utils/linkdeps.ml
+4
-1
utils/linkdeps.ml
···
107
107
let pp_list_comma f =
108
108
pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") f
109
109
110
-
let report_error ~print_filename ppf = function
110
+
let report_error_doc ~print_filename ppf = function
111
111
| Missing_implementations l ->
112
112
let print_modules ppf =
113
113
List.iter
···
137
137
in
138
138
fprintf ppf "@[<hov 2> Duplicated implementations:%a@]"
139
139
(pp_list_comma print) l
140
+
141
+
let report_error ~print_filename =
142
+
Format_doc.compat (report_error_doc ~print_filename)