Permalink
Browse files

Check that renamed definitions are in the current file.

  • Loading branch information...
1 parent 4c9ab9f commit 3308fb04d630027911c36e3b609b83f9ff081fab Tiphaine Turpin committed Jul 12, 2011
@@ -18,9 +18,9 @@
open Typedtree
open Util
-type 'a sfun =
- [ `structure of Typedtree.structure | `signature of Typedtree.signature]
- -> 'a
+type typedtree = [ `structure of structure | `signature of signature]
+
+type 'a sfun = typedtree -> 'a
module MakeIterator
(Arg : IteratorArgument) = struct
@@ -21,9 +21,9 @@ open Typedtree
(** The type of functions that can apply either to a structure or a
signature. *)
-type 'a sfun =
- [ `structure of Typedtree.structure | `signature of Typedtree.signature]
- -> 'a
+type typedtree = [ `structure of structure | `signature of signature]
+
+type 'a sfun = typedtree -> 'a
(** The common type for all typedtree nodes. *)
type node = [
@@ -52,8 +52,8 @@ val source_locations :
val initial_env : unit -> Env.t
(** Indicates that the query cannot be processed, for some legitimate
- reason. The message will be printed on stdout (prefixed with
- "Error:" before exiting with signal 1). *)
+ reason. The message will be printed on stdout before exiting with
+ signal 1). *)
exception OwzFailure of string
val fail_owz : ('a, unit, string, 'b) format4 -> 'a
@@ -36,12 +36,22 @@ type renaming_context =
| Local of Ident.t (* A "local" ident *)
*)
-type toplevel_item =
- | Ml of structure
- | Mli of signature
+(* A filename (without extension), and its source file sort. *)
+type toplevel_item = string * [ `ml | `mli ]
(* Identifiers for a set of compilation units. *)
-type absolute_id = toplevel_item * Ident.t (* non-persistent Id *)
+type absolute_id =
+ | Persistent of Ident.t
+ | NonPersistent of toplevel_item * Ident.t (* non-persistent Id *)
+
+(*
+let absolute path item id =
+ if Ident.persistent id then
+
+ else
+ NonPersistent (item, id)
+*)
+
type absolute_path = toplevel_item * Path.t (* maybe persistent root Id *)
(*
@@ -213,21 +223,27 @@ let read_typedtree _ file =
let sort_replaces =
List.sort
+ (* This comparison is total because def locations are either
+ disjoint or identical *)
(fun (x, _, _) (y, _, _) -> compare x y)
-let find_id_defs ids name s =
- List.fold_right
- (fun id acc ->
- try
- let loc = Locate.ident_def s id in
- (loc.loc_start.pos_cnum, loc.loc_end.pos_cnum, name) :: acc
- with
- Not_found -> acc)
- ids
- []
-(*
- [fst loc, snd loc, name']
-*)
+let rec remove_duplicates = function
+ | x :: (y :: _ as l) ->
+ if x = y then
+ remove_duplicates l
+ else
+ x :: remove_duplicates l
+ | l -> l
+
+let find_id_defs ids locs name s =
+ let defs =
+ List.map2
+ (fun id loc ->
+ loc.loc_start.pos_cnum, loc.loc_end.pos_cnum, name)
+ ids
+ locs
+ in
+ remove_duplicates (sort_replaces defs)
let fix_case kind =
match kind with
@@ -236,10 +252,10 @@ let fix_case kind =
let backup file =
let backup = file ^ ".backup_" ^ string_of_int (int_of_float (Unix.time ())) in
- if Sys.file_exists backup then
- failwith "bad luck"
- else
- Edit.cp file backup
+ if Sys.file_exists backup then
+ failwith "bad luck"
+ else
+ Edit.cp file backup
(* Rename an ident in a structure file, with given ast. *)
let rename_in_file
@@ -249,11 +265,11 @@ let rename_in_file
let constraints, includes = collect_signature_inclusions typedtree in
(* Deduce the minimal set of ids to rename *)
- let ids, implicit_refs =
- propagate_renamings renamed_kind id constraints includes in
+ let ids, locs, implicit_refs =
+ propagate_renamings renamed_kind id constraints includes idents in
(* Compute the replacements for the *definitions* of the rename ids *)
- let def_replaces = find_id_defs ids name' idents in
+ let def_replaces = find_id_defs ids locs name' idents in
(* Check that our new name will not capture useful signature members *)
check_other_implicit_references renamed_kind ids name' constraints includes;
@@ -83,7 +83,9 @@ and constraint_signature incs env sg sg' =
| _ -> ())
sg'
-(* Collect the set of signature inclusion constraints implied by a structure. *)
+(* Collect the set of signature inclusion constraints implied by a structure.
+
+ signature constraints are missing ! *)
let collect_signature_inclusions s =
let incs = ref ConstraintSet.empty
and includes = ref IncludeSet.empty in
@@ -167,7 +169,7 @@ let add_relation eq x y =
(* Return the set of ids that would need to be renamed simultaneously
with id, and the list of "implicit" references which cause this
need (so that we can check them for masking). *)
-let propagate_renamings kind id incs includes =
+let propagate_renamings kind id incs includes idents =
let name = Ident.name id in
let eq = Hashtbl.create 10 in
Hashtbl.add eq id (ref [id]);
@@ -202,13 +204,22 @@ let propagate_renamings kind id incs includes =
ambiguous := (find_in_signature kind name sg) :: !ambiguous)
includes;
let ids = !(Hashtbl.find eq id) in
+ let locs = List.map
+ (function id ->
+ try
+ Locate.ident_def idents id
+ with Not_found ->
+ fail_owz "Cannot perform renaming because a member of a persistent \
+ structure would be impacted")
+ ids
+ in
List.iter
(function id ->
- if is_one_of id ids then
- failwith
- "Cannot perform renaming because of an ambiguous include")
+ if is_one_of id ids then
+ failwith
+ "Cannot perform renaming because of an ambiguous include")
!ambiguous;
- ids, !implicit_refs
+ ids, locs, !implicit_refs
(* Check that the implicit ident references which are concerned by
renaming will not be masked (i.e., that the bound signature items
@@ -37,7 +37,8 @@ val collect_signature_inclusions :
elements to those idents. *)
val propagate_renamings :
Env.path_sort -> Ident.t -> ConstraintSet.t -> IncludeSet.t ->
- Ident.t list
+ Location.string_table ->
+ Ident.t list * Location.t list
* ([ `certain | `maybe ] * Types.signature * Ident.t) list
(* means id is bound to sg.(name id), unless we were wrong about the sort. *)
@@ -0,0 +1,9 @@
+module M = struct
+ let y = 1
+end
+
+include M
+
+let _ = y
+Renamed 1 definition(s) and 1 reference(s)
+
@@ -0,0 +1,7 @@
+module M = struct
+ let $x€ = 1
+end
+
+include M
+
+let _ = x

0 comments on commit 3308fb0

Please sign in to comment.