Skip to content
Browse files

Substitution of all ids (but sig_items are broken)

  • Loading branch information...
1 parent c528c38 commit 4359d0da7c2f158834aeef9f0c9bf6f91c093105 Tiphaine Turpin committed Jun 30, 2011
View
44 ocamlwizard/common/typedtreeOps.ml
@@ -16,6 +16,7 @@
(**************************************************************************)
open Typedtree
+open Util
type 'a sfun =
[ `structure of Typedtree.structure | `signature of Typedtree.signature]
@@ -272,30 +273,37 @@ let contains loc (b', e') =
b <= b' && e' <= e
(* This implementation is notably inefficient. *)
-let locate_innermost s loc =
+let find_map_innermost (type a) s cond =
let module M = Find (struct
- type t = [
- `pattern of pattern
- | `expression of expression
- | `structure_item of structure_item
- ]
+ type t = a
module IteratorArgument(Action : sig val found : t -> unit end) = struct
include DefaultIteratorArgument
- open Action
-
- let leave_pattern p =
- if Util.get_c_num p.pat_loc = loc then
- found (`pattern p)
-
- let leave_expression e =
- if contains e.exp_loc loc then
- found (`expression e)
+ let found x =
+ match cond x with
+ | Some x -> Action.found x
+ | None -> ()
- let leave_structure_item i =
- if contains i.str_loc loc then
- found (`structure_item i)
+ let leave_pattern p = found (`pattern p)
+ let leave_expression e = found (`expression e)
+ let leave_structure_item i = found (`structure_item i)
+ let leave_signature_item i = found (`signature_item i)
end
end) in
M.find s
+let locate_innermost s loc =
+ find_map_innermost s
+ (function t ->
+ if
+ contains
+ (match t with
+ | `pattern p -> p.pat_loc
+ | `expression e -> e.exp_loc
+ | `structure_item i -> i.str_loc
+ | `signature_item i -> i.sig_loc)
+ loc
+ then
+ Some t
+ else
+ None)
View
11 ocamlwizard/common/typedtreeOps.mli
@@ -73,6 +73,16 @@ module Find :
val find_pattern : (Typedtree.pattern -> 'a option) -> 'a sfun
val find_expression : (Typedtree.expression -> 'a option) -> 'a sfun
+(** Find the innermost subtree for which some condition holds. *)
+val find_map_innermost :
+ [ `signature of signature | `structure of structure ] ->
+ ([
+ `pattern of pattern
+ | `expression of expression
+ | `structure_item of structure_item
+ | `signature_item of signature_item
+ ] -> 'a option) -> 'a
+
(** Return the innermost subtree whose locations contains a given
character number interval [a, b[. *)
val locate_innermost :
@@ -81,4 +91,5 @@ val locate_innermost :
`pattern of pattern
| `expression of expression
| `structure_item of structure_item
+ | `signature_item of signature_item
]
View
27 ocamlwizard/refactor/findName.ml
@@ -141,12 +141,27 @@ let get_occurrences s =
!l
*)
+let ident_of_subtree = function
+ | `pattern {pat_desc = Tpat_var id ; pat_loc = loc}
+ | `expression {exp_desc = Texp_for (id, _, _, _, _) ; exp_loc = loc}
+ | `signature_item {sig_desc = Tsig_value (id, _) ; sig_loc = loc}
+ -> value_ops, id, loc
+ | `structure_item {str_desc = Tstr_module (id, _) ; str_loc = loc}
+ -> module_ops, id, loc
+ | _ -> raise Not_found
+
(* Should be almost complete for expressions, but this is not a safety
requirement anyway. *)
let locate_renamed_id s loc =
- match locate_innermost s loc with
- | `pattern {pat_desc = Tpat_var id} -> value_ops, id
- | `expression {exp_desc = Texp_for (id, _, _, _, _)} -> value_ops, id
- | `structure_item {str_desc = Tstr_module (id, _)} -> module_ops, id
- | _ -> invalid_arg "rename"
-
+ try
+ let kind, id, _ = ident_of_subtree (locate_innermost s loc) in kind, id
+ with Not_found ->
+ invalid_arg "rename"
+
+let find_id_def s id =
+ find_map_innermost s
+ (function t ->
+ try
+ let _, id', loc = ident_of_subtree t in
+ if id' = id then Some loc else None
+ with Not_found -> None)
View
4 ocamlwizard/refactor/findName.mli
@@ -32,3 +32,7 @@ val locate_renamed_id :
[ `signature of Typedtree.signature | `structure of Typedtree.structure ] ->
int * int ->
Resolve.specifics * Ident.t
+
+val find_id_def :
+ [ `signature of Typedtree.signature | `structure of Typedtree.structure ] ->
+ Ident.t -> Location.t
View
16 ocamlwizard/refactor/rename.ml
@@ -189,6 +189,20 @@ let sort_replaces =
List.sort
(fun (x, _, _) (y, _, _) -> compare x y)
+let find_id_defs ids s =
+ List.fold_right
+ (fun id acc ->
+ try
+ let loc = find_id_def s id in
+ (loc.loc_start.pos_cnum, loc.loc_end.pos_cnum, Ident.name id) :: acc
+ with
+ Not_found -> acc)
+ ids
+ []
+(*
+ [fst loc, snd loc, name']
+*)
+
(* TODO *)
let valid_ident kind name = true
@@ -210,7 +224,7 @@ let rename loc name name' file =
ids;
(* Compute the replacements for the *definitions* of the rename ids *)
- let def_replaces = [fst loc, snd loc, name'] in (* obviously incomplete ! *)
+ let def_replaces = find_id_defs ids (`structure s) in (* obviously incomplete ! *)
(* Check that our new name will not capture useful signature members *)
check_other_implicit_references renamed_kind ids name' incs includes;
View
2 typing/typedtree.mli
@@ -456,4 +456,4 @@ module MakeIterator :
end
module DefaultIteratorArgument : IteratorArgument
-
+

0 comments on commit 4359d0d

Please sign in to comment.
Something went wrong with that request. Please try again.