Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Added a path2env table to the cmt file

  • Loading branch information...
commit 0d04ec59efa8a59491d1078428ddfdbea193c8c6 1 parent dab0d1d
@tturpin tturpin authored
View
BIN  boot/ocamlc
Binary file not shown
View
BIN  boot/ocamldep
Binary file not shown
View
4 driver/compile.ml
@@ -83,6 +83,7 @@ let interface ppf sourcefile outputprefix =
let ast, ident_locations =
Pparse.file ppf inputfile Parse.interface' ast_intf_magic_number in
if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
+ Env.record_path_environments ();
let tsg = Typemod.transl_signature (initial_env()) ast in
let sg = tsg.sig_type in
if !Clflags.print_types then
@@ -91,7 +92,8 @@ let interface ppf sourcefile outputprefix =
Warnings.check_fatal ();
if not !Clflags.print_types then begin
Env.save_signature sg modulename (outputprefix ^ ".cmi");
- Typemod.save_signature ident_locations tsg outputprefix;
+ Typemod.save_signature
+ ident_locations (Env.flush_paths ()) tsg outputprefix;
end;
Pparse.remove_preprocessed inputfile
with e ->
View
11 ocamlwizard/README
@@ -106,6 +106,17 @@ Remark: Completion still needs to be improvemed in many respects. See
the test cases for a detailed overview of the current behavior.
+Refactoring:
+............
+
+- Renaming (C-c C-o r): rename a value identifier through a single .ml
+ file (other sorts of idents are not yet implemented). The cursor
+ must be placed on the *definition* of the value (typically, a let
+ binding or a pattern). Renaming takes care of necessary propagation
+ (e.g., when distinct values with the same name need to be renamed
+ consistently because this name appears in a common interface), and
+ capture is detected. Backups are made in case anything goes wrong.
+
- Command line interface
View
6 ocamlwizard/TODO
@@ -1,9 +1,11 @@
+- Traverse directly the path table to get all occurrences with kind, loc, env
+- Git add renameType.ml
- Rename: rename in signatures
-- Rename: update documentation
-- Rename: return a list of files that emacs should revert
- Rename: replace in multiple files
+- Rename: return a list of files that emacs should revert
- Rename: check that we always lookup in the right environment
+- Binannot: only record locs and envs if annot is set
- Rename: rename everything an not just values
- Rename: collect all occurrences in a or-pattern
- Rename: retrieve a definition from an occurrence
View
14 ocamlwizard/refactor/rename.ml
@@ -183,14 +183,18 @@ let read_cmt file =
match data.(0) with
| Saved_implementation str ->
(try
- match data.(1) with
- | Saved_ident_locations (Some loc) ->
- str, loc
+ match data.(1), data.(2) with
+ | Saved_ident_locations (Some loc),
+ Saved_path_environments (Some env) ->
+ str, loc, env
+(*
| Saved_ident_locations None ->
failwith "ident location table is empty"
+*)
| _ -> raise Not_found
with
- _ -> failwith "ident location table not found in cmt")
+ _ -> failwith
+ "ident location or path environment table not found in cmt")
| _ -> failwith "error reading cmt file"
else
invalid_arg "read_cmt"
@@ -277,7 +281,7 @@ let rename loc name' file =
failwith "cmt file is older than source file";
(* Read the typedtree *)
- let s, idents = read_cmt cmt_file in
+ let s, idents, paths = read_cmt cmt_file in
(* Get the "initial" id to rename and its sort *)
let renamed_kind, id = locate_renamed_id (`structure s) loc in
View
3  ocamlwizard/test/Makefile
@@ -7,7 +7,8 @@ R_CASES=renameSimple.ml renameSigNewCaptured.ml renameSigOldCaptured.ml \
renameIncludeNewCaptured.ml renameIncludeOldCaptured.ml \
renameOpenNewCaptured.ml renameOpenOldCaptured.ml \
renameMultiple.ml renameProp.ml renamePropFunctor.ml \
- renamePropFunctorNoApp.ml renameType.ml
+ renamePropFunctorNoApp.ml
+# renameType.ml
# renameModtype.ml
R_TESTS=$(subst .ml,_rres.ml, $(R_CASES))
View
34 typing/env.ml
@@ -491,6 +491,40 @@ let lookup_simple proj1 proj2 lid env =
| Lapply(l1, l2) ->
raise Not_found
+module PathTbl = Hashtbl.Make
+ (struct
+ type t = Path.t
+ let equal = ( == )
+ let hash = Hashtbl.hash
+ end)
+
+type path2env = t PathTbl.t
+
+let path_table = ref None
+
+let record_path_environments () =
+ path_table := Some (PathTbl.create 1000)
+
+let flush_paths () =
+ let paths = !path_table in
+ path_table := None;
+ paths
+
+let record p env =
+ match !path_table with
+ | Some t -> PathTbl.add t p env
+ | None -> ()
+
+let lookup_module lid env =
+ let path, _ as res = lookup_module lid env in
+ record path env;
+ res
+
+let lookup proj1 proj2 lid env =
+ let path, _ as res = lookup proj1 proj2 lid env in
+ record path env;
+ res
+
let lookup_value =
lookup (fun env -> env.values) (fun sc -> sc.comp_values)
let lookup_annot id e =
View
8 typing/env.mli
@@ -171,3 +171,11 @@ val report_error: formatter -> error -> unit
(* Forward declaration to break mutual recursion with Includemod. *)
val check_modtype_inclusion:
(t -> module_type -> Path.t -> module_type -> unit) ref
+
+module PathTbl : Hashtbl.S with type key = Path.t
+
+type path2env = t PathTbl.t
+
+val record_path_environments : unit -> unit
+
+val flush_paths : unit -> path2env option
View
1  typing/typedtree.ml
@@ -361,6 +361,7 @@ type saved_type =
| Saved_pattern of pattern
| Saved_class_expr of class_expr
| Saved_ident_locations of Location.string_table option
+| Saved_path_environments of Env.path2env option
let saved_types = ref []
let get_saved_types () = !saved_types
View
1  typing/typedtree.mli
@@ -378,6 +378,7 @@ type saved_type =
| Saved_pattern of pattern
| Saved_class_expr of class_expr
| Saved_ident_locations of Location.string_table option
+| Saved_path_environments of Env.path2env option
val get_saved_types : unit -> saved_type list
val set_saved_types : saved_type list -> unit
View
15 typing/typemod.ml
@@ -1172,20 +1172,29 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
end
end
-let save_signature loc tsg outputprefix =
+let save_signature loc env tsg outputprefix =
if !Clflags.annotations then
let oc = open_out (outputprefix ^ ".cmti") in
- output_value oc [| Saved_signature tsg ; Saved_ident_locations loc |];
+ output_value oc [|
+ Saved_signature tsg;
+ Saved_ident_locations loc;
+ Saved_path_environments env
+ |];
close_out oc
let type_implementation sourcefile outputprefix modulename initial_env loc ast =
try
Typedtree.set_saved_types [];
+ Env.record_path_environments ();
let (str, coercion) = type_implementation sourcefile outputprefix modulename initial_env ast in
if !Clflags.annotations then begin
Typedtree.set_saved_types [];
let oc = open_out (outputprefix ^ ".cmt") in
- output_value oc [| Saved_implementation str ; Saved_ident_locations loc |];
+ output_value oc [|
+ Saved_implementation str;
+ Saved_ident_locations loc;
+ Saved_path_environments (Env.flush_paths ())
+ |];
close_out oc;
(*
let oc = open_out (outputprefix ^ "_ast2src.ml") in
View
3  typing/typemod.mli
@@ -34,7 +34,8 @@ val check_nongen_schemes:
val simplify_signature: signature -> signature
val save_signature :
- Location.string_table option -> Typedtree.signature -> string -> unit
+ Location.string_table option -> Env.path2env option ->
+ Typedtree.signature -> string -> unit
val package_units:
string list -> string -> string -> Typedtree.module_coercion
Please sign in to comment.
Something went wrong with that request. Please try again.