@@ -6249,7 +6249,7 @@ and type_expect_
6249
6249
in
6250
6250
re { exp with exp_extra =
6251
6251
(Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra }
6252
- | Pexp_newtype ({ txt = name } , sbody ) ->
6252
+ | Pexp_newtype (name , sbody ) ->
6253
6253
type_newtype_expr ~loc ~env ~expected_mode ~rue ~attributes: sexp.pexp_attributes
6254
6254
name None sbody
6255
6255
| Pexp_pack m ->
@@ -6687,7 +6687,7 @@ and type_function
6687
6687
(* Check everything else in the scope of (type a). *)
6688
6688
let (params, body, newtypes, contains_gadt, fun_alloc_mode, ret_info),
6689
6689
exp_type, jkind_annot =
6690
- type_newtype loc env newtype_var.txt jkind_annot (fun env ->
6690
+ type_newtype env newtype_var jkind_annot (fun env ->
6691
6691
let { function_ = exp_type, params, body;
6692
6692
newtypes; params_contain_gadt = contains_gadt;
6693
6693
fun_alloc_mode; ret_info;
@@ -8282,9 +8282,10 @@ and type_function_cases_expect
8282
8282
by the user.
8283
8283
*)
8284
8284
and type_newtype
8285
- : type a . _ -> _ -> _ -> _ -> (Env. t -> a * type_expr )
8285
+ : type a . _ -> _ -> _ -> (Env. t -> a * type_expr )
8286
8286
-> a * type_expr * Jkind. annotation option =
8287
- fun loc env name jkind_annot_opt type_body ->
8287
+ fun env name jkind_annot_opt type_body ->
8288
+ let { txt = name; loc = name_loc } : _ Location. loc = name in
8288
8289
let jkind, jkind_annot =
8289
8290
Jkind. of_annotation_option_default ~context: (Newtype_declaration name)
8290
8291
~default: (Jkind. value ~why: Univar ) jkind_annot_opt
@@ -8298,7 +8299,7 @@ and type_newtype
8298
8299
(* Use [with_local_level] just for scoping *)
8299
8300
with_local_level begin fun () ->
8300
8301
(* Create a fake abstract type declaration for name. *)
8301
- let decl = new_local_type ~loc jkind ~jkind_annot in
8302
+ let decl = new_local_type ~loc: name_loc jkind ~jkind_annot in
8302
8303
let scope = create_scope () in
8303
8304
let (id, new_env) = Env. enter_type ~scope name decl env in
8304
8305
@@ -8324,15 +8325,15 @@ and type_newtype
8324
8325
and type_newtype_expr
8325
8326
~loc ~env ~expected_mode ~rue ~attributes name jkind_annot_opt sbody =
8326
8327
let body, ety, jkind_annot =
8327
- type_newtype loc env name jkind_annot_opt (fun env ->
8328
+ type_newtype env name jkind_annot_opt (fun env ->
8328
8329
let expr = type_exp env expected_mode sbody in
8329
8330
expr, expr.exp_type)
8330
8331
in
8331
8332
(* non-expansive if the body is non-expansive, so we don't introduce
8332
8333
any new extra node in the typed AST. *)
8333
8334
rue { body with exp_loc = loc; exp_type = ety;
8334
8335
exp_extra =
8335
- (Texp_newtype (name, jkind_annot),
8336
+ (Texp_newtype (name.txt , jkind_annot),
8336
8337
loc, attributes) :: body.exp_extra }
8337
8338
8338
8339
(* Typing of let bindings *)
@@ -9214,7 +9215,7 @@ and type_jkind_expr
9214
9215
~loc ~env ~expected_mode ~ty_expected :_ ~explanation :_ ~rue ~attributes
9215
9216
: Jane_syntax.Layouts.expression -> _ = function
9216
9217
| Lexp_constant x -> type_unboxed_constant ~loc ~env ~rue ~attributes x
9217
- | Lexp_newtype ({ txt = name } , jkind_annot , sbody ) ->
9218
+ | Lexp_newtype (name , jkind_annot , sbody ) ->
9218
9219
type_newtype_expr ~loc ~env ~expected_mode ~rue ~attributes
9219
9220
name (Some jkind_annot) sbody
9220
9221
0 commit comments