Skip to content
Browse files

Error feedback for renaming, fixed expansion for exception arguments

  • Loading branch information...
1 parent 6a9e724 commit ecd2ca535aacdbc5788cdaf3fe166a49bd07b81f Tiphaine Turpin committed Jul 5, 2011
View
1 ocamlwizard/TODO
@@ -5,7 +5,6 @@
- Rename: rename everything an not just values
- Rename: collect all occurrences in a or-pattern
- Rename: retrieve a definition from an occurrence
-- Rename: report masking and capture errors accurately
- Rename: warn about potential future captures
- Rename: do a backup before replacing
- Rename: check that .cmt files are up to date
View
5 ocamlwizard/common/common_config.ml
@@ -99,9 +99,10 @@ let project_file_name = ".ocamlwizard"
(* Try to locate a project file in the directory containing d. *)
let rec find_project_file d =
let pf = Filename.concat d project_file_name in
- if Sys.file_exists pf then
+ if Sys.file_exists pf then (
+ if !debug then Printf.eprintf "Found project file in directory %s" d;
d, pf
- else if d = "/" then
+ ) else if d = "/" then
raise Not_found
else
find_project_file (Filename.dirname d)
View
2 ocamlwizard/completion/completion.ml
@@ -125,7 +125,7 @@ let main ce =
| None -> assert false
in
match_exp.Typedtree.exp_env, match_exp.Typedtree.exp_type
- | Match (BranchCs (p, l)) ->
+ | Match (BranchCs (p, l)) | Try (BranchCs (p, l)) ->
let place =
Expression_typing.locate_expansion_place structure
! Common_config.expand_loc
View
3 ocamlwizard/completion/extraction/proposal_extraction.ml
@@ -282,8 +282,7 @@ let complete_match ce pm_comp (env, t) =
let main sg ce se ty_check =
match se.comp with
- | Match pm_comp -> complete_match ce pm_comp ty_check
+ | Match pm_comp | Try pm_comp -> complete_match ce pm_comp ty_check
| Path pc -> complete_path sg ce se pc ty_check
- | Try pm -> assert false
| Other -> assert false
| Error e -> raise e
View
34 ocamlwizard/completion/typing/expression_typing.ml
@@ -43,10 +43,13 @@ let expansion_type = function
| Path.Pident i -> Ident.name i
| _ -> invalid_arg "expansion_type"
in
- match t.Types.type_kind with
- | Types.Type_variant cs ->
- env,
- Types.Ttuple (List.assoc c cs)
+ match desc.Types.cstr_tag, t.Types.type_kind with
+ | Types.Cstr_exception pe, _ ->
+ env,
+ Types.Ttuple desc.Types.cstr_args
+ | _, Types.Type_variant cs ->
+ env,
+ Types.Ttuple (List.assoc c cs)
| _ -> invalid_arg "expansion_type"
let locate_expression s loc =
@@ -65,34 +68,33 @@ let locate_expression s loc =
| `expression e -> e
| _ -> raise Not_found
-let locate_expansion_place s loc =
+let locate_expansion_place s (b, e as loc) =
let pattern p =
- debugln "looking for pattern at loc:";
- (*
- if !Common_config.debug then
- print Format.err_formatter loc;
- debugln "";
- *)
+ debugln "looking for pattern at loc: [%d, %d[" b e;
+ debugln "visiting pattern at loc: [%d, %d["
+ p.Typedtree.pat_loc.loc_start.pos_cnum p.Typedtree.pat_loc.loc_end.pos_cnum;
match p.Typedtree.pat_desc with
(* The pattern Cons _ is parsed as Cons (_, _) with
identical locations, so we need a special case. *)
| Typedtree.Tpat_construct
(c, d, ({pat_loc = l ; pat_desc = Tpat_any} :: ps)) ->
if (l.loc_start.pos_cnum, l.loc_end.pos_cnum) = loc &&
ps <> [] &&
- List.for_all (function p'' -> p''.pat_loc = l) ps then
- Some (Args (p, c, d))
- else
+ List.for_all (function p'' -> p''.pat_loc = l) ps then (
+ debugln "found constructor arguments";
+ Some (Args (p, c, d))
+ ) else
None
| _ ->
(*
if !Common_config.debug then
print Format.err_formatter p.Typedtree.pat_loc;
*)
let l = p.Typedtree.pat_loc in
- if (l.loc_start.pos_cnum, l.loc_end.pos_cnum) = loc then
+ if (l.loc_start.pos_cnum, l.loc_end.pos_cnum) = loc then (
+ debugln "found pattern";
Some (Pat p)
- else
+ ) else
None
in
find_pattern pattern (`structure s)
View
32 ocamlwizard/emacs/ocamlwizard.el
@@ -168,29 +168,31 @@
(save-excursion
(set-buffer buffer)
(compilation-minor-mode 1)
- (erase-buffer)
- (insert "\n\n"))
+ (erase-buffer))
(do-auto-save)
(setq exit-status
(call-process
- "ocamlwizard" nil (list t nil) nil
+ "ocamlwizard" nil buffer nil
"completion" "refactor" "-rename"
(concat (int-to-string (- start 1)) "-" (int-to-string (- end 1)))
word
name
file))
- (if (not (eq exit-status 10))
- (message "ocamlwizard: no completion"))
-; Thank you stackoverflow:
- (save-excursion
- (clear-visited-file-modtime)
- (widen)
- (delete-region (point-min) (point-max))
- (insert-file-contents (buffer-file-name)))
-; Problem: if we undo and then redo, emacs forgets the goto.
- (goto-char pos)
- (set-buffer-modified-p nil)
- (set-visited-file-modtime)
+ (if (eq exit-status 0)
+ ; Thank you stackoverflow:
+ (progn
+ (save-excursion
+ (clear-visited-file-modtime)
+ (widen)
+ (delete-region (point-min) (point-max))
+ (insert-file-contents (buffer-file-name)))
+ ; Problem: if we undo and then redo, emacs forgets the goto.
+ (goto-char pos)
+ (set-buffer-modified-p nil)
+ (set-visited-file-modtime)
+ (message "Renaming succeeded"))
+ (message "Renaming failed")
+ (display-message-or-buffer buffer))
)
(defun ocamlwizard ()
View
3 ocamlwizard/owz.sh
@@ -1,6 +1,7 @@
#!/bin/sh
OWZ=owz.opt
-PROJECT_DIR=`$OWZ -find-project-dir $*`
+PROJECT_DIR=`$OWZ -find-project-dir $* 2>>/dev/null`
echo ocamlwizard $* >$PROJECT_DIR/.ocamlwizard-stderr
OCAMLLIB=/usr/local/lib/ocaml $OWZ -debug -backtrace $* \
2>>$PROJECT_DIR/.ocamlwizard-stderr | tee $PROJECT_DIR/.ocamlwizard-stdout
+exit ${PIPESTATUS[0]}
View
61 ocamlwizard/refactor/rename.ml
@@ -220,13 +220,7 @@ let fix_case kind =
| _ -> String.uncapitalize
(* Temporary : we rename only in one file *)
-let rename loc name name' file =
- let s, idents = read_cmt (Filename.chop_suffix file ".ml" ^ ".cmt") in
-
- (* Get the "initial" id to rename and its sort *)
- let renamed_kind, id = locate_renamed_id (`structure s) loc in
-
- let name' = fix_case renamed_kind name' in
+let rename renamed_kind id name' file (s, idents) =
(* Collect constraints requiring simultaneous renaming *)
let incs, includes = collect_signature_inclusions s in
@@ -239,10 +233,7 @@ let rename loc name name' file =
ids;
(* Compute the replacements for the *definitions* of the rename ids *)
-(*
- let def_replaces = find_id_defs ids (`structure s) in (* obviously incomplete ! *)
-*)
- let def_replaces = find_id_defs ids name' idents in (* obviously incomplete ! *)
+ let def_replaces = find_id_defs ids name' idents in
(* Check that our new name will not capture useful signature members *)
check_other_implicit_references renamed_kind ids name' incs includes;
@@ -259,14 +250,42 @@ let rename loc name name' file =
(* Compute renamed lids, checking that they are not captured *)
let occ_replaces = rename_lids renamed_kind ids name' lids in
- (* We will need to sort them again ! *)
- let replaces = sort_replaces (def_replaces @ occ_replaces) in
+ (* We need to sort them again ! *)
+ sort_replaces (def_replaces @ occ_replaces)
- List.iter
- (function b, e, s -> debugln "replace %d--%d by %s\n%!" b e s)
- replaces;
-
- (* Replace lids in the source file *)
- Edit.edit replaces file;
-
- exit 0
+let rename loc name name' file =
+ let s, idents = read_cmt (Filename.chop_suffix file ".ml" ^ ".cmt") in
+ try
+
+ (* Get the "initial" id to rename and its sort *)
+ let renamed_kind, id = locate_renamed_id (`structure s) loc in
+
+ let name' = fix_case renamed_kind name' in
+
+ let replaces = rename renamed_kind id name' file (s, idents) in
+
+ List.iter
+ (function b, e, s -> debugln "replace %d--%d by %s\n%!" b e s)
+ replaces;
+
+ (* Replace lids in the source file *)
+ Edit.edit replaces file;
+
+ exit 0
+ with
+ | Masked_by (renamed, id) ->
+ let def = find_id_def idents id in
+ Location.print Format.std_formatter def;
+ if renamed then
+ Printf.printf
+ "This existing definition of %s would capture an occurrence of the \
+ renamed element"
+ name'
+ else
+ Printf.printf
+ "This definition of %s that you are trying to rename would capture \
+ an occurrence of an existing definition of %s"
+ name name';
+ exit 1
+ | _ ->
+ exit 2
View
4 ocamlwizard/refactor/resolve.ml
@@ -168,7 +168,7 @@ let rec first_of kind ids name env = function
-> first_of kind ids name env s
| Env_open _ | Env_empty _ -> assert false
-exception Masked_by of Ident.t
+exception Masked_by of bool * Ident.t
(* Check that the renaming of one of ids in name is not masked in the env. *)
@@ -180,7 +180,7 @@ let check ~renamed first_of arg =
(Ident _ | Name _) as e ->
match renamed, e with
| (true, Ident _ | false, Name _) -> ()
- | (true, Name id | false, Ident id) -> raise (Masked_by id)
+ | (true, Name id | false, Ident id) -> raise (Masked_by (renamed, id))
| _ -> assert false
let check kind id name env summary =
View
5 ocamlwizard/refactor/resolve.mli
@@ -76,8 +76,9 @@ val lookup_in_signature :
specifics -> string -> Types.signature -> Types.signature_item
(** Raised by check to signal an impossible renaming due to a masking
- of the new name by another element *)
-exception Masked_by of Ident.t
+ of an existing occurrence of the new name, or of a renamed
+ occurrence (the boolean specifies if it is a renamed occurrence). *)
+exception Masked_by of bool * Ident.t
(** Check that the renaming of a list of idents (with the same name)
into a new name would not change the meaning of a reference in a

0 comments on commit ecd2ca5

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