File tree Expand file tree Collapse file tree 3 files changed +19
-4
lines changed Expand file tree Collapse file tree 3 files changed +19
-4
lines changed Original file line number Diff line number Diff line change @@ -117,6 +117,21 @@ let super_warning_printer loc ppf w =
117
117
end
118
118
;;
119
119
120
+ (* taken from https://github.com/BuckleScript/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/parsing/location.ml#L354 *)
121
+ let print_phanton_error_prefix ppf =
122
+ (* modified from the original. We use only 2 indentations for error report
123
+ (see super_error_reporter above) *)
124
+ Format. pp_print_as ppf 2 " "
125
+
126
+ let errorf ?(loc = none) ?(sub = [] ) ?(if_highlight = " " ) fmt =
127
+ Location. pp_ksprintf
128
+ ~before: print_phanton_error_prefix
129
+ (fun msg -> {loc; msg; sub; if_highlight})
130
+ fmt
131
+
132
+ let error_of_printer loc print x =
133
+ errorf ~loc " %a@?" print x
134
+
120
135
(* This will be called in super_main. This is how you override the default error and warning printers *)
121
136
let setup () =
122
137
Location. error_reporter := super_error_reporter;
Original file line number Diff line number Diff line change @@ -48,9 +48,9 @@ let report_error env ppf = function
48
48
(* modified *)
49
49
report_unification_error ppf env trace
50
50
(function ppf ->
51
- fprintf ppf " @{<error> This is:@} " )
51
+ fprintf ppf " This is:" )
52
52
(function ppf ->
53
- fprintf ppf " @{<info>but somewhere wanted:@} " )
53
+ fprintf ppf " But somewhere wanted:" )
54
54
| Apply_non_function typ ->
55
55
(* modified *)
56
56
reset_and_mark_loops typ;
@@ -239,7 +239,7 @@ let setup () =
239
239
Location. register_error_of_exn
240
240
(function
241
241
| Typecore. Error (loc , env , err ) ->
242
- Some (Location . error_of_printer loc (report_error env) err)
242
+ Some (Super_location . error_of_printer loc (report_error env) err)
243
243
| Typecore. Error_forward err ->
244
244
Some err
245
245
| _ ->
Original file line number Diff line number Diff line change @@ -159,7 +159,7 @@ let setup () =
159
159
Location. register_error_of_exn
160
160
(function
161
161
| Typetexp. Error (loc , env , err ) ->
162
- Some (Location . error_of_printer loc (report_error env) err)
162
+ Some (Super_location . error_of_printer loc (report_error env) err)
163
163
(* typetexp doesn't expose Error_forward *)
164
164
(* | Error_forward err ->
165
165
Some err *)
You can’t perform that action at this time.
0 commit comments