Permalink
Browse files

Make Parsetree more uniform by keeping locations in all records which…

… have attributes.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14659 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent af3d4aa commit 3b6c0c88a50dc325633459af7fc920d072eb35b0 @alainfrisch alainfrisch committed Apr 22, 2014
View
@@ -300,28 +300,31 @@ module Mb = struct
end
module Opn = struct
- let mk ?(attrs = []) ?(override = Fresh) lid =
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(override = Fresh) lid =
{
popen_lid = lid;
popen_override = override;
+ popen_loc = loc;
popen_attributes = attrs;
}
end
module Incl = struct
- let mk ?(attrs = []) mexpr =
+ let mk ?(loc = !default_loc) ?(attrs = []) mexpr =
{
pincl_mod = mexpr;
+ pincl_loc = loc;
pincl_attributes = attrs;
}
end
module Vb = struct
- let mk ?(attrs = []) pat expr =
+ let mk ?(loc = !default_loc) ?(attrs = []) pat expr =
{
pvb_pat = pat;
pvb_expr = expr;
pvb_attributes = attrs;
+ pvb_loc = loc;
}
end
@@ -393,11 +396,12 @@ module Cstr = struct
end
module Exrb = struct
- let mk ?(attrs = []) name lid =
+ let mk ?(loc = !default_loc) ?(attrs = []) name lid =
{
pexrb_name = name;
pexrb_lid = lid;
pexrb_attributes = attrs;
+ pexrb_loc = loc;
}
end
@@ -241,20 +241,20 @@ module Mb:
(* Opens *)
module Opn:
sig
- val mk: ?attrs:attrs -> ?override:override_flag -> lid -> open_description
+ val mk: ?loc: loc -> ?attrs:attrs -> ?override:override_flag -> lid -> open_description
end
(* Includes *)
module Incl:
sig
- val mk: ?attrs:attrs -> 'a -> 'a include_infos
+ val mk: ?loc: loc -> ?attrs:attrs -> 'a -> 'a include_infos
end
(** Value bindings *)
module Vb:
sig
- val mk: ?attrs:attrs -> pattern -> expression -> value_binding
+ val mk: ?loc: loc -> ?attrs:attrs -> pattern -> expression -> value_binding
end
@@ -338,7 +338,7 @@ module Cstr:
(** Exception rebinding *)
module Exrb:
sig
- val mk: ?attrs:attrs -> str -> lid -> exception_rebind
+ val mk: ?loc:loc -> ?attrs:attrs -> str -> lid -> exception_rebind
end
View
@@ -13,7 +13,7 @@
(* A generic Parsetree mapping class *)
(*
-[@@@warning "+9"]
+[@@@ocaml.warning "+9"]
(* Ensure that record patterns don't miss any field. *)
*)
@@ -495,31 +495,35 @@ let default_mapper =
open_description =
- (fun this {popen_lid; popen_override; popen_attributes} ->
+ (fun this {popen_lid; popen_override; popen_attributes; popen_loc} ->
Opn.mk (map_loc this popen_lid)
~override:popen_override
+ ~loc:(this.location this popen_loc)
~attrs:(this.attributes this popen_attributes)
);
include_description =
- (fun this {pincl_mod; pincl_attributes} ->
+ (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
Incl.mk (this.module_type this pincl_mod)
+ ~loc:(this.location this pincl_loc)
~attrs:(this.attributes this pincl_attributes)
);
include_declaration =
- (fun this {pincl_mod; pincl_attributes} ->
+ (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
Incl.mk (this.module_expr this pincl_mod)
+ ~loc:(this.location this pincl_loc)
~attrs:(this.attributes this pincl_attributes)
);
value_binding =
- (fun this {pvb_pat; pvb_expr; pvb_attributes} ->
+ (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
Vb.mk
(this.pat this pvb_pat)
(this.expr this pvb_expr)
+ ~loc:(this.location this pvb_loc)
~attrs:(this.attributes this pvb_attributes)
);
@@ -545,10 +549,11 @@ let default_mapper =
);
exception_rebind =
- (fun this {pexrb_name; pexrb_lid; pexrb_attributes} ->
+ (fun this {pexrb_name; pexrb_lid; pexrb_attributes; pexrb_loc} ->
Exrb.mk
(map_loc this pexrb_name)
(map_loc this pexrb_lid)
+ ~loc:(this.location this pexrb_loc)
~attrs:(this.attributes this pexrb_attributes)
);
View
@@ -640,8 +640,9 @@ structure_item:
| EXCEPTION exception_declaration
{ mkstr(Pstr_exception $2) }
| EXCEPTION UIDENT EQUAL constr_longident post_item_attributes
- { mkstr (Pstr_exn_rebind (Exrb.mk (mkrhs $2 2)
- (mkloc $4 (rhs_loc 4)) ~attrs:$5)) }
+ { mkstr (Pstr_exn_rebind
+ (Exrb.mk (mkrhs $2 2)
+ (mkloc $4 (rhs_loc 4)) ~attrs:$5 ~loc:(symbol_rloc()))) }
| MODULE module_binding
{ mkstr(Pstr_module $2) }
| MODULE REC module_bindings
@@ -652,14 +653,13 @@ structure_item:
| MODULE TYPE ident EQUAL module_type post_item_attributes
{ mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3)
~typ:$5 ~attrs:$6 ~loc:(symbol_rloc()))) }
- | OPEN override_flag mod_longident post_item_attributes
- { mkstr(Pstr_open (Opn.mk (mkrhs $3 3) ~override:$2 ~attrs:$4)) }
+ | open_statement { mkstr(Pstr_open $1) }
| CLASS class_declarations
{ mkstr(Pstr_class (List.rev $2)) }
| CLASS TYPE class_type_declarations
{ mkstr(Pstr_class_type (List.rev $3)) }
| INCLUDE module_expr post_item_attributes
- { mkstr(Pstr_include (Incl.mk $2 ~attrs:$3)) }
+ { mkstr(Pstr_include (Incl.mk $2 ~attrs:$3 ~loc:(symbol_rloc()))) }
| item_extension post_item_attributes
{ mkstr(Pstr_extension ($1, $2)) }
| floating_attribute
@@ -746,10 +746,10 @@ signature_item:
{ mksig(Psig_modtype (Mtd.mk (mkrhs $3 3) ~typ:$5
~loc:(symbol_rloc())
~attrs:$6)) }
- | OPEN override_flag mod_longident post_item_attributes
- { mksig(Psig_open (Opn.mk (mkrhs $3 3) ~override:$2 ~attrs:$4)) }
+ | open_statement
+ { mksig(Psig_open $1) }
| INCLUDE module_type post_item_attributes %prec below_WITH
- { mksig(Psig_include (Incl.mk $2 ~attrs:$3)) }
+ { mksig(Psig_include (Incl.mk $2 ~attrs:$3 ~loc:(symbol_rloc()))) }
| CLASS class_descriptions
{ mksig(Psig_class (List.rev $2)) }
| CLASS TYPE class_type_declarations
@@ -759,7 +759,10 @@ signature_item:
| floating_attribute
{ mksig(Psig_attribute $1) }
;
-
+open_statement:
+ | OPEN override_flag mod_longident post_item_attributes
+ { Opn.mk (mkrhs $3 3) ~override:$2 ~attrs:$4 ~loc:(symbol_rloc()) }
+;
module_declaration:
COLON module_type
{ $2 }
@@ -1309,7 +1312,9 @@ lident_list:
| LIDENT lident_list { $1 :: $2 }
;
let_binding:
- let_binding_ post_item_attributes { let (p, e) = $1 in Vb.mk ~attrs:$2 p e }
+ let_binding_ post_item_attributes {
+ let (p, e) = $1 in Vb.mk ~loc:(symbol_rloc()) ~attrs:$2 p e
+ }
;
let_binding_:
val_ident fun_binding
@@ -297,7 +297,7 @@ and expression_desc =
Pexp_constraint(Pexp_pack, Ptyp_package S) *)
| Pexp_open of override_flag * Longident.t loc * expression
(* let open M in E
- let! open M in E
+ let! open M in E
*)
| Pexp_extension of extension
(* [%id] *)
@@ -390,6 +390,7 @@ and exception_rebind =
{
pexrb_name: string loc;
pexrb_lid: Longident.t loc;
+ pexrb_loc: Location.t;
pexrb_attributes: attributes;
}
(* exception C = M.X *)
@@ -638,6 +639,7 @@ and open_description =
{
popen_lid: Longident.t loc;
popen_override: override_flag;
+ popen_loc: Location.t;
popen_attributes: attributes;
}
(* open! X - popen_override = Override (silences the 'used identifier
@@ -648,6 +650,7 @@ and open_description =
and 'a include_infos =
{
pincl_mod: 'a;
+ pincl_loc: Location.t;
pincl_attributes: attributes;
}
@@ -742,6 +745,7 @@ and value_binding =
pvb_pat: pattern;
pvb_expr: expression;
pvb_attributes: attributes;
+ pvb_loc: Location.t;
}
and module_binding =
@@ -793,7 +793,9 @@ class printer ()= object(self:'self)
| Pexp_poly (e,None) ->
self#binding f {pvb_pat={ppat_desc=Ppat_var s;ppat_loc=Location.none;ppat_attributes=[]};
pvb_expr=e;
- pvb_attributes=[]}
+ pvb_attributes=[];
+ pvb_loc=Location.none;
+ }
| _ ->
self#expression f e ) e
| Pcf_constraint (ct1, ct2) ->
View
@@ -67,7 +67,9 @@ and untype_structure_item item =
pmtd_loc=mtd.mtd_loc;pmtd_attributes=mtd.mtd_attributes;}
| Tstr_open od ->
Pstr_open {popen_lid = od.open_txt; popen_override = od.open_override;
- popen_attributes = od.open_attributes}
+ popen_attributes = od.open_attributes;
+ popen_loc = od.open_loc;
+ }
| Tstr_class list ->
Pstr_class (List.map (fun (ci, _, _) ->
{ pci_virt = ci.ci_virt;
@@ -91,7 +93,9 @@ and untype_structure_item item =
) list)
| Tstr_include incl ->
Pstr_include {pincl_mod = untype_module_expr incl.incl_mod;
- pincl_attributes = incl.incl_attributes}
+ pincl_attributes = incl.incl_attributes;
+ pincl_loc = incl.incl_loc;
+ }
| Tstr_attribute x ->
Pstr_attribute x
in
@@ -155,6 +159,7 @@ and untype_exception_rebind er =
pexrb_name = er.exrb_name;
pexrb_lid = er.exrb_txt;
pexrb_attributes = er.exrb_attributes;
+ pexrb_loc = er.exrb_loc;
}
and untype_pattern pat =
@@ -229,11 +234,12 @@ and untype_case {c_lhs; c_guard; c_rhs} =
pc_rhs = untype_expression c_rhs;
}
-and untype_binding {vb_pat; vb_expr; vb_attributes} =
+and untype_binding {vb_pat; vb_expr; vb_attributes; vb_loc} =
{
pvb_pat = untype_pattern vb_pat;
pvb_expr = untype_expression vb_expr;
pvb_attributes = vb_attributes;
+ pvb_loc = vb_loc;
}
and untype_expression exp =
@@ -358,10 +364,14 @@ and untype_signature_item item =
| Tsig_open od ->
Psig_open {popen_lid = od.open_txt;
popen_override = od.open_override;
- popen_attributes = od.open_attributes}
+ popen_attributes = od.open_attributes;
+ popen_loc = od.open_loc;
+ }
| Tsig_include incl ->
Psig_include {pincl_mod = untype_module_type incl.incl_mod;
- pincl_attributes = incl.incl_attributes}
+ pincl_attributes = incl.incl_attributes;
+ pincl_loc = incl.incl_loc;
+ }
| Tsig_class list ->
Psig_class (List.map untype_class_description list)
| Tsig_class_type list ->
View
@@ -3035,7 +3035,9 @@ and type_argument env sarg ty_expected' ty_expected =
let let_pat, let_var = var_pair "arg" texp.exp_type in
re { texp with exp_type = ty_fun; exp_desc =
Texp_let (Nonrecursive,
- [{vb_pat=let_pat; vb_expr=texp; vb_attributes=[]}],
+ [{vb_pat=let_pat; vb_expr=texp; vb_attributes=[];
+ vb_loc=Location.none;
+ }],
func let_var) }
end
| _ ->
@@ -3627,7 +3629,9 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
let l =
List.map2
(fun (p, e) pvb ->
- {vb_pat=p; vb_expr=e; vb_attributes=pvb.pvb_attributes})
+ {vb_pat=p; vb_expr=e; vb_attributes=pvb.pvb_attributes;
+ vb_loc=pvb.pvb_loc;
+ })
l spat_sexp_list
in
(l, new_env, unpacks)
View
@@ -1049,7 +1049,7 @@ let transl_exception env excdecl =
cd, exn_decl, newenv
(* Translate an exception rebinding *)
-let transl_exn_rebind env loc ser =
+let transl_exn_rebind env ser =
let name = ser.pexrb_name in
let lid = ser.pexrb_lid in
let cdescr =
@@ -1067,7 +1067,7 @@ let transl_exn_rebind env loc ser =
{
exn_args = cdescr.cstr_args;
exn_attributes = [];
- Types.exn_loc = loc
+ Types.exn_loc = ser.pexrb_loc;
}
in
let (id, newenv) = Env.enter_exception name.txt exn_decl env in
@@ -1078,6 +1078,7 @@ let transl_exn_rebind env loc ser =
exrb_txt = lid;
exrb_type = exn_decl;
exrb_attributes = ser.pexrb_attributes;
+ exrb_loc = ser.pexrb_loc;
}
in
er, newenv
View
@@ -24,7 +24,7 @@ val transl_exception:
Parsetree.constructor_declaration -> Typedtree.constructor_declaration * exception_declaration * Env.t
val transl_exn_rebind:
- Env.t -> Location.t -> Parsetree.exception_rebind -> Typedtree.exception_rebind * Env.t
+ Env.t -> Parsetree.exception_rebind -> Typedtree.exception_rebind * Env.t
val transl_value_decl:
Env.t -> Location.t ->
Oops, something went wrong.

0 comments on commit 3b6c0c8

Please sign in to comment.