Permalink
Browse files

Refactoring (type "specifics" deleted)

  • Loading branch information...
1 parent 362a08d commit 6c8555ca54ff951fd3eee9554953c61ba8e72590 @tturpin tturpin committed Jul 7, 2011
View
54 ocamlwizard/refactor/findName.ml
@@ -188,45 +188,11 @@ let get_occurrences env idents lidents paths s =
(find_all_occurrences env idents paths s)
*)
-(*
-let reverse t =
- let r = Longident.LongidentTbl.create 1000 in
- Env.PathTbl.iter
- (fun p (sort, lid, env) ->
- if sort <> Env.Annot then
- Longident.LongidentTbl.add r lid (sort, p, env))
- t;
- r
-*)
-
-let kind2kind = function
- | Env.Value -> value_ops
- | Env.Type -> type_ops
- | Env.Annot
- | Env.Constructor
- | Env.Label
- | Env.Module
- | Env.Modtype
- | Env.Class
- | Env.Cltype
- -> raise Not_found
-
-let kind2str = function
- | Env.Value -> "value"
- | Env.Type -> "type"
- | Env.Annot -> "annot"
- | Env.Constructor -> "constructor"
- | Env.Label -> "label"
- | Env.Module -> "module"
- | Env.Modtype -> "modtype"
- | Env.Class -> "class"
- | Env.Cltype -> "cltype"
-
let rec check_same = function
| [x] -> x
| (kind, env) :: ((kind', env') :: _ as l) ->
if kind <> kind' then
- failwith (kind2str kind ^ " <> " ^ kind2str kind');
+ failwith (Resolve.kind2str kind ^ " <> " ^ kind2str kind');
if env != env' then failwith "different environments";
check_same l
| [] -> invalid_arg "check_same"
@@ -255,16 +221,10 @@ let get_occurrences lid2loc lid2env s =
lid2loc
[]
-let extract_longident (loc, text, (env, occ)) =
- let kind = match occ with
- | Env.Value -> value_ops
- | Env.Module -> module_ops
- | Env.Type -> type_ops
- | _ -> failwith "not implemented"
- in
+let extract_longident (loc, text, (env, kind)) =
let ast =
try
- kind.parse_lid text
+ Resolve.parse_lid kind text
with _ ->
failwith ("error parsing the following ident: " ^ text)
in
@@ -279,14 +239,14 @@ let ident_of_subtree = function
| `pattern {pat_desc = Tpat_var id}
| `expression {exp_desc = Texp_for (id, _, _, _, _)}
| `signature_item {sig_desc = Tsig_value (id, _)}
- -> value_ops, id
+ -> Env.Value, id
| `structure_item {str_desc = Tstr_module (id, _)}
- -> module_ops, id
+ -> Env.Module, id
| `structure_item {str_desc = Tstr_modtype (id, _)}
- -> modtype_ops, id
+ -> Env.Modtype, id
| `structure_item {str_desc = Tstr_type types}
-> (match types with
- | [id, _] -> type_ops, id
+ | [id, _] -> Env.Type, id
| _ -> failwith "multiple type definitions are not yes supported")
| _ -> raise Not_found
View
4 ocamlwizard/refactor/findName.mli
@@ -29,12 +29,12 @@ val get_lids :
string ->
Location.t Longident.LongidentTbl.t -> Env.lid2env ->
[ `signature of Typedtree.signature | `structure of Typedtree.structure ]->
- (Location.t * Longident.t * (Env.t * Resolve.specifics)) list
+ (Location.t * Longident.t * (Env.t * Env.path_sort)) list
val locate_renamed_id :
[ `signature of Typedtree.signature | `structure of Typedtree.structure ] ->
int * int ->
- Resolve.specifics * Ident.t
+ Env.path_sort * Ident.t
val find_id_def :
(*
View
4 ocamlwizard/refactor/rename.ml
@@ -219,8 +219,8 @@ let find_id_defs ids name s =
*)
let fix_case kind =
- match kind.sort with
- | `Module | `Modtype -> String.capitalize
+ match kind with
+ | Env.Module | Env.Modtype -> String.capitalize
| _ -> String.uncapitalize
let backup file =
View
24 ocamlwizard/refactor/renameLid.ml
@@ -21,17 +21,17 @@ open Util
(* Rename the ident id of type renamed_kind in the longident lid of kind sort *)
let rec rename_in_lid renamed_kind ids name env kind lid =
- let rename = rename_in_lid renamed_kind ids name env module_ops in
- match renamed_kind.sort, lid with
+ let rename = rename_in_lid renamed_kind ids name env Env.Module in
+ match renamed_kind, lid with
| _, Lident i ->
- if kind.sort = renamed_kind.sort && resolves_to kind env lid ids then (
+ if kind = renamed_kind && resolves_to kind env lid ids then (
check kind ids name env (Env.summary env) ~renamed:true;
Some (Lident name)
) else
None
| _, Ldot (pref, n) ->
let n' =
- if kind.sort = renamed_kind.sort && resolves_to kind env lid ids then (
+ if kind = renamed_kind && resolves_to kind env lid ids then (
let _, t = wrap_lookup lid_to_str "module" Env.lookup_module pref env in
check_in_sig kind ids name (modtype_signature env t) ~renamed:true;
Some name
@@ -43,7 +43,7 @@ let rec rename_in_lid renamed_kind ids name env kind lid =
| None, Some n -> Some (Ldot(pref, n))
| Some pref, None -> Some (Ldot(pref, n))
| Some pref, Some n -> Some (Ldot(pref, n)))
- | `Module, Lapply (lid, lid') ->
+ | Env.Module, Lapply (lid, lid') ->
(match rename lid, rename lid' with
| None, None -> None
| Some lid, None -> Some (Lapply (lid, lid'))
@@ -52,18 +52,18 @@ let rec rename_in_lid renamed_kind ids name env kind lid =
| _, Lapply _ -> None
let rec check_lid renamed_kind ids name env kind lid =
- let check_lid = check_lid renamed_kind ids name env module_ops in
+ let check_lid = check_lid renamed_kind ids name env Env.Module in
match lid with
| Lident i ->
- if kind.sort = renamed_kind.sort && i = name then
+ if kind = renamed_kind && i = name then
check kind ids name env (Env.summary env) ~renamed:false
| Ldot (pref, n) ->
check_lid pref;
- if kind.sort = renamed_kind.sort && n = name then
+ if kind = renamed_kind && n = name then
let _, t = wrap_lookup lid_to_str "module" Env.lookup_module pref env in
check_in_sig kind ids name (modtype_signature env t) ~renamed:false
| Lapply (lid, lid') ->
- if renamed_kind.sort = `Module then (
+ if renamed_kind = Env.Module then (
check_lid lid;
check_lid lid'
)
@@ -113,21 +113,21 @@ let rec rename_in_lid
(name' : string)
kind
(lid : Longident.t) =
- match renamed_kind.sort with
+ match renamed_kind with
| `Module -> rename_in_ext_mod_path env id name'
| _ ->
match lid with
| Lident i ->
let p, _ = renamed_kind.lookup lid env in
- if kind.sort = renamed_kind.sort &&
+ if kind = renamed_kind &&
resolves_to renamed_kind env id p then (
check_value id name' env (Env.summary env);
Some (Lident name')
) else
None
| _, Ldot (lid, n) ->
let p, _ = renamed_kind.lookup lid env in
- if kind.sort = renamed_kind.sort && field_resolves_to kind env p n id then
+ if kind = renamed_kind && field_resolves_to kind env p n id then
Some (Ldot(lid, name'))
else
None
View
8 ocamlwizard/refactor/renameLid.mli
@@ -23,12 +23,12 @@
the same thing (i.e., is not subject to masking by other
equally-named elements). *)
val rename_in_lid :
- Resolve.specifics -> Ident.t list -> string ->
- Env.t -> Resolve.specifics -> Longident.t -> Longident.t option
+ Env.path_sort -> Ident.t list -> string ->
+ Env.t -> Env.path_sort -> Longident.t -> Longident.t option
(** Check that no existing occurrence of the new name appearing in a
longident would be captured by one of the renamed idents if we
applied the given renaming. *)
val check_lid :
- Resolve.specifics -> Ident.t list -> string ->
- Env.t -> Resolve.specifics -> Longident.t -> unit
+ Env.path_sort -> Ident.t list -> string ->
+ Env.t -> Env.path_sort -> Longident.t -> unit
View
4 ocamlwizard/refactor/renamePropagation.ml
@@ -68,14 +68,14 @@ and constraint_signature incs env sg sg' =
(function
| Sig_module (id, t, _) ->
(match
- lookup_in_signature module_ops (Ident.name id) sg
+ lookup_in_signature Env.Module (Ident.name id) sg
with
| Sig_module (_, t', _) ->
constraint_modtype incs env t t'
| _ -> assert false)
| Sig_modtype (id, Modtype_manifest t) ->
(match
- lookup_in_signature modtype_ops (Ident.name id) sg
+ lookup_in_signature Env.Modtype (Ident.name id) sg
with
| Sig_modtype (_, Modtype_manifest t') ->
constraint_modtype incs env t t'
View
6 ocamlwizard/refactor/renamePropagation.mli
@@ -36,15 +36,15 @@ val collect_signature_inclusions :
a given id, as well as the "implicit" bindings of signature
elements to those idents. *)
val propagate_renamings :
- Resolve.specifics -> Ident.t -> ConstraintSet.t -> IncludeSet.t ->
+ Env.path_sort -> Ident.t -> ConstraintSet.t -> IncludeSet.t ->
Ident.t list
* ([ `certain | `maybe ] * Types.signature * Ident.t) list
(* means id is bound to sg.(name id), unless we were wrong about the sort. *)
val check_renamed_implicit_references :
- Resolve.specifics -> Ident.t list -> string ->
+ Env.path_sort -> Ident.t list -> string ->
([ `certain | `maybe ] * Types.signature * Ident.t) list -> unit
val check_other_implicit_references :
- Resolve.specifics -> Ident.t list -> string ->
+ Env.path_sort -> Ident.t list -> string ->
ConstraintSet.t -> IncludeSet.t -> unit
View
126 ocamlwizard/refactor/resolve.ml
@@ -19,67 +19,76 @@ open Path
open Types
open Env
open Util
-
-type sort = [
- | `Module
- | `Modtype
- | `Value
- | `Type
-]
-
-type specifics = {
- sort : sort;
- lookup : Longident.t -> Env.t -> Path.t;
- sig_item : Types.signature_item -> Ident.t option;
- summary_item : Env.summary -> Ident.t option;
- parse_lid : string -> Longident.t
-}
+open Env
let wrap_lookup to_string name lookup x e =
try lookup x e
with Not_found -> failwith ("unbound " ^ name ^ " " ^ to_string x)
let keep_first name f lid env = fst (wrap_lookup lid_to_str name f lid env)
+let keep_first' f lid env = fst (f lid env)
+
let parse parser s =
let lexbuf = Lexing.from_string s in
parser Lexer.token lexbuf
-let value_ops = {
- sort = `Value;
- lookup = keep_first "value" Env.lookup_value;
- sig_item = (function Sig_value (i, _) -> Some i | _ -> None);
- summary_item = (function Env_value (_, i, _) -> Some i | _ -> None);
- parse_lid =
- function s ->
- try parse Parser.val_longident s
- with _ -> Longident.Lident (parse Parser.operator s)
-}
-
-let type_ops = {
- sort = `Type;
- lookup = keep_first "type" Env.lookup_type;
- sig_item = (function Sig_type (i, _, _) -> Some i | _ -> None);
- summary_item = (function Env_type (_, i, _) -> Some i | _ -> None);
- parse_lid = parse Parser.type_longident
-}
-
-let module_ops = {
- sort = `Module;
- lookup = keep_first "module" Env.lookup_module;
- sig_item = (function Sig_module (i, _, _) -> Some i | _ -> None);
- summary_item = (function Env_module (_, i, _) -> Some i | _ -> None);
- parse_lid = parse Parser.mod_longident (* extended ? *)
-}
-
-let modtype_ops = {
- sort = `Modtype;
- lookup = keep_first "module type" Env.lookup_modtype;
- sig_item = (function Sig_modtype (i, _) -> Some i | _ -> None);
- summary_item = (function Env_modtype (_, i, _) -> Some i | _ -> None);
- parse_lid = parse Parser.mty_longident
-}
-
+let kind2str = function
+ | Value -> "value"
+ | Type -> "type"
+ | Annot -> "annot"
+ | Constructor -> "constructor"
+ | Label -> "label"
+ | Module -> "module"
+ | Modtype -> "modtype"
+ | Class -> "class"
+ | Cltype -> "cltype"
+
+let lookup kind lid e =
+ let lookup =
+ match kind with
+ | Value -> keep_first' lookup_value
+ | Type -> keep_first' lookup_type
+ | Module -> keep_first' lookup_module
+ | Constructor -> keep_first' lookup_constructor
+ | Label -> keep_first' lookup_label
+ | Modtype -> keep_first' lookup_modtype
+ | Class -> keep_first' lookup_class
+ | Cltype -> keep_first' lookup_cltype
+ | Annot -> assert false
+ in
+ wrap_lookup lid_to_str (kind2str kind) lookup lid e
+
+let sig_item sort item =
+ match sort, item with
+ | Value, Sig_value (i, _)
+ | Type, Sig_type (i, _, _)
+ | Module, Sig_module (i, _, _)
+ | Modtype, Sig_modtype (i, _) -> Some i
+ (* To be completed *)
+ | _ -> None
+
+let summary_item kind item =
+ match kind, item with
+ | Value, Env_value (_, i, _)
+ | Type, Env_type (_, i, _)
+ | Module, Env_module (_, i, _)
+ | Modtype, Env_modtype (_, i, _) -> Some i
+ (* To be completed *)
+ | _ -> None
+
+let parse_lid kind =
+ match kind with
+ | Value ->
+ (function s ->
+ try parse Parser.val_longident s
+ with _ -> Longident.Lident (parse Parser.operator s))
+ | Type -> parse Parser.type_longident
+ | Module -> parse Parser.mod_longident (* extended ? *)
+ | Modtype -> parse Parser.mty_longident
+ | _ -> assert false
+
+(*
let sig_item_ops = function
| Sig_value _ -> value_ops
| Sig_module _ -> module_ops
@@ -89,12 +98,13 @@ let sig_item_ops = function
| Sig_class _
| Sig_class_type _ ->
assert false
+*)
exception Abstract_modtype
(* Return the signature of a given (extended) module type path *)
let rec resolve_modtype env path =
- match wrap_lookup Path.name "module type" Env.find_modtype path env with
+ match wrap_lookup Path.name "module type" find_modtype path env with
| Modtype_abstract -> raise Abstract_modtype
| Modtype_manifest mt -> modtype env mt
@@ -116,12 +126,12 @@ let modtype_functor env m =
(* Return the signature of a given (extended) module path *)
let resolve_module env path =
- modtype_signature env (wrap_lookup Path.name "module" Env.find_module path env)
+ modtype_signature env (wrap_lookup Path.name "module" find_module path env)
(* unused *)
let resolve_module_lid env lid =
modtype_signature env
- (snd (wrap_lookup lid_to_str "module" Env.lookup_module lid env))
+ (snd (wrap_lookup lid_to_str "module" lookup_module lid env))
let is_one_of id = List.exists (Ident.same id)
@@ -132,7 +142,7 @@ let field_resolves_to kind env path name ids =
try
List.exists
(function s ->
- match kind.sig_item s with
+ match sig_item kind s with
| Some id -> Ident.name id = name && is_one_of id ids
| None -> false)
(resolve_module env path)
@@ -142,14 +152,14 @@ let field_resolves_to kind env path name ids =
(* Test whether a p reffers to id in environment env. This indicates
that the rightmost name in lid needs renaming. *)
let resolves_to kind env lid ids =
- match kind.lookup lid env with
+ match lookup kind lid env with
| Pident id' -> is_one_of id' ids
| Pdot (p, n, _) -> field_resolves_to kind env p n ids
| Papply _ -> invalid_arg "resolves_to"
let lookup_in_signature kind name =
List.find
- (function item -> match kind.sig_item item with
+ (function item -> match sig_item kind item with
| Some id -> Ident.name id = name
| None -> false)
@@ -159,7 +169,7 @@ exception Ident of Ident.t
let first_of_in_sig kind ids name sg =
List.iter
(function item ->
- (match kind.sig_item item with
+ (match sig_item kind item with
| Some id ->
debugln "found %s" (Ident.name id);
if is_one_of id ids then
@@ -180,7 +190,7 @@ let rec first_of kind ids name env = function
Not_found ->
first_of kind ids name env s)
| summary ->
- (match kind.summary_item summary with
+ (match summary_item kind summary with
| Some id ->
if is_one_of id ids then
raise (Ident id)
View
32 ocamlwizard/refactor/resolve.mli
@@ -17,24 +17,18 @@
(** Different sort of names, and their bindings. *)
-type sort = [ `Modtype | `Module | `Value | `Type ]
-(* TODO: everything else... *)
-
-type specifics = {
- sort : sort;
- lookup : Longident.t -> Env.t -> Path.t;
- sig_item : Types.signature_item -> Ident.t option;
- summary_item : Env.summary -> Ident.t option;
- parse_lid : string -> Longident.t
-}
-
-val value_ops : specifics
-val type_ops : specifics
-val module_ops : specifics
-val modtype_ops : specifics
+val kind2str : Env.path_sort -> string
+(*
+val lookup : Env.path_sort -> Longident.t -> Env.t -> Path.t
+val sig_item : Env.path_sort -> Types.signature_item -> Ident.t option
+summary_item
+*)
+val parse_lid : Env.path_sort -> string -> Longident.t
+(*
(** Return the specific operations associated with a signature item. *)
val sig_item_ops : Types.signature_item -> specifics
+*)
(* Turns Not_found into a Failure with the unbound name *)
val wrap_lookup : ('a -> string) -> string -> ('a -> 'b -> 'c) -> 'a -> 'b -> 'c
@@ -75,11 +69,11 @@ val resolve_modtype :
of ids in environment env, i.e., if the object directly denoted by
lid is named with one of ids. This indicates that the rightmost
name in lid needs renaming (assuming we are renaming ids). *)
-val resolves_to : specifics -> Env.t -> Longident.t -> Ident.t list -> bool
+val resolves_to : Env.path_sort -> Env.t -> Longident.t -> Ident.t list -> bool
(** Retrieve an element in a signature from its name *)
val lookup_in_signature :
- specifics -> string -> Types.signature -> Types.signature_item
+ Env.path_sort -> string -> Types.signature -> Types.signature_item
(** Raised by check to signal an impossible renaming due to a masking
of an existing occurrence of the new name, or of a renamed
@@ -101,12 +95,12 @@ exception Masked_by of bool * Ident.t
Raise (Masked_by id) if masking would occur. *)
val check :
- specifics -> Ident.t list -> string -> Env.t -> Env.summary ->
+ Env.path_sort -> Ident.t list -> string -> Env.t -> Env.summary ->
renamed:bool -> unit
(** Similar to check, but for a signature. *)
val check_in_sig :
- specifics -> Ident.t list -> string -> Types.signature ->
+ Env.path_sort -> Ident.t list -> string -> Types.signature ->
renamed:bool -> unit
(** Test if an id belongs to a list of ids *)

0 comments on commit 6c8555c

Please sign in to comment.