The unpac monorepo manager self-hosting as a monorepo using unpac
Moved location of error message to match location and warning settings
+26
-21
+4
-4
testsuite/tests/typing-warnings/unused_types.ml
+4
-4
testsuite/tests/typing-warnings/unused_types.ml
···
676
676
(x3 : int as 'used1) (x4 : 'used1) (x5 : 'used2) = (x1, x2, x3, x4, x5)
677
677
678
678
[%%expect{|
679
-
Line 1, characters 12-27:
679
+
Line 1, characters 19-27:
680
680
1 | let f (x1 : int as 'unused1) (x2 : int as 'unused2)
681
-
^^^^^^^^^^^^^^^
681
+
^^^^^^^^
682
682
Warning 34 [unused-type-declaration]: unused type "'unused1".
683
683
684
-
Line 1, characters 35-50:
684
+
Line 1, characters 42-50:
685
685
1 | let f (x1 : int as 'unused1) (x2 : int as 'unused2)
686
-
^^^^^^^^^^^^^^^
686
+
^^^^^^^^
687
687
Warning 34 [unused-type-declaration]: unused type "'unused2".
688
688
689
689
val f : int -> int -> int -> int -> 'used2 -> int * int * int * int * 'used2 =
+22
-17
typing/typetexp.ml
+22
-17
typing/typetexp.ml
···
57
57
58
58
val is_in_scope : string -> bool
59
59
60
-
val add : check:bool -> Location.t -> string -> type_expr -> unit
60
+
val add : ?unused:bool ref -> string -> type_expr -> unit
61
61
(* add a global type variable to the environment *)
62
62
63
63
val with_local_scope : (unit -> 'a) -> 'a
···
104
104
row_context:type_expr option ref list -> string -> type_expr
105
105
(* look up a local type variable; throws Not_found if it isn't in scope *)
106
106
107
-
val remember_used : check:bool -> string -> type_expr -> Location.t -> unit
107
+
val remember_used :
108
+
?check:Location.t -> string -> type_expr -> Location.t -> unit
108
109
(* remember that a given name is bound to a given type *)
109
110
110
111
val globalize_used_variables : policy -> Env.t -> unit -> unit
···
165
166
let is_in_scope name =
166
167
TyVarMap.mem name !type_variables
167
168
168
-
let add ~check loc name v =
169
+
let add ?(unused = ref false) name v =
169
170
assert (not_generic v);
170
-
let unused = ref check in
171
-
if check then
172
-
!Env.add_delayed_check_forward begin fun () ->
173
-
let warn = Warnings.Unused_type_declaration ("'" ^ name) in
174
-
if !unused && Warnings.is_active warn
175
-
then Location.prerr_warning loc warn
176
-
end;
177
171
type_variables := TyVarMap.add name (v, unused) !type_variables
178
172
179
173
let narrow () =
···
283
277
inserted into [used_variables] are non-generic, but some
284
278
might get generalized. *)
285
279
286
-
let remember_used ~check name v loc =
280
+
let remember_used ?check name v loc =
287
281
assert (not_generic v);
288
-
used_variables := TyVarMap.add name (v, loc, ref check) !used_variables
282
+
let unused = match check with
283
+
| None -> ref false
284
+
| Some check_loc ->
285
+
let unused = ref true in
286
+
!Env.add_delayed_check_forward begin fun () ->
287
+
let warn = Warnings.Unused_type_declaration ("'" ^ name) in
288
+
if !unused && Warnings.is_active warn
289
+
then Location.prerr_warning check_loc warn
290
+
end;
291
+
unused
292
+
in
293
+
used_variables := TyVarMap.add name (v, loc, unused) !used_variables
289
294
290
295
291
296
type flavor = Unification | Universal
···
320
325
let globalize_used_variables { flavor; extensibility } env =
321
326
let r = ref [] in
322
327
TyVarMap.iter
323
-
(fun name (ty, loc, c) ->
328
+
(fun name (ty, loc, unused) ->
324
329
if flavor = Unification || is_in_scope name then
325
330
let v = new_global_var () in
326
331
let snap = Btype.snapshot () in
···
338
343
get_in_scope_names ())));
339
344
let v2 = new_global_var () in
340
345
r := (loc, v, v2) :: !r;
341
-
add ~check:!c loc name v2)
346
+
add ~unused name v2)
342
347
!used_variables;
343
348
used_variables := TyVarMap.empty;
344
349
fun () ->
···
397
402
if TyVarEnv.is_in_scope name then
398
403
raise Already_bound;
399
404
let v = new_global_var ~name () in
400
-
TyVarEnv.add ~check:false loc name v;
405
+
TyVarEnv.add name v;
401
406
v
402
407
in
403
408
{ ctyp_desc = Ttyp_var name; ctyp_type = ty; ctyp_env = env;
···
439
444
TyVarEnv.lookup_local ~row_context:row_context name
440
445
with Not_found ->
441
446
let v = TyVarEnv.new_var ~name policy in
442
-
TyVarEnv.remember_used ~check:false name v styp.ptyp_loc;
447
+
TyVarEnv.remember_used name v styp.ptyp_loc;
443
448
v
444
449
end
445
450
in
···
544
549
with_local_level_generalize_structure_if_principal begin fun () ->
545
550
let t = newvar () in
546
551
(* Use the whole location, which is used by [Type_mismatch]. *)
547
-
TyVarEnv.remember_used ~check:true alias.txt t styp.ptyp_loc;
552
+
TyVarEnv.remember_used ~check:alias.loc alias.txt t styp.ptyp_loc;
548
553
let ty = transl_type env ~policy ~row_context st in
549
554
begin try unify_var env t ty.ctyp_type with Unify err ->
550
555
let err = Errortrace.swap_unification_error err in