Skip to content
Browse files

Localisation des longidents

  • Loading branch information...
1 parent 6283226 commit 7a517b820214b1e7b320dd890d8845b83252926d Tiphaine Turpin committed Jul 1, 2011
View
4 asmcomp/cmmgen.ml
@@ -333,7 +333,7 @@ let lookup_tag obj tag =
Cop(Cextcall("caml_get_public_method", typ_addr, false, Debuginfo.none),
[obj; tag]))
-let lookup_label obj lab =
+let lookup_label_lid obj lab =
bind "lab" lab (fun lab ->
let table = Cop (Cload Word, [obj]) in
addr_array_ref table lab)
@@ -859,7 +859,7 @@ let rec transl = function
bind "obj" (transl obj) (fun obj ->
match kind, args with
Self, _ ->
- bind "met" (lookup_label obj (transl met)) (call_met obj args)
+ bind "met" (lookup_label_lid obj (transl met)) (call_met obj args)
| Cached, cache :: pos :: args ->
call_cached_method obj (transl met) (transl cache) (transl pos)
(List.map transl args) dbg
View
BIN boot/ocamlc
Binary file not shown.
View
2 bytecomp/matching.ml
@@ -1332,7 +1332,7 @@ let get_mod_field modname field =
let mod_ident = Ident.create_persistent modname in
let env = Env.open_pers_signature modname Env.initial in
let p = try
- match Env.lookup_value (Longident.Lident field) env with
+ match Env.lookup_value_lid (Longident.Lident field) env with
| (Path.Pdot(_,_,i), _) -> i
| _ -> fatal_error ("Primitive "^modname^"."^field^" not found.")
with Not_found -> fatal_error ("Primitive "^modname^"."^field^" not found.")
View
2 bytecomp/translmod.ml
@@ -105,7 +105,7 @@ let field_path path field =
let mod_prim name =
try
transl_path
- (fst (Env.lookup_value (Ldot (Lident "CamlinternalMod", name))
+ (fst (Env.lookup_value_lid (Ldot (Lident "CamlinternalMod", name))
Env.empty))
with Not_found ->
fatal_error ("Primitive " ^ name ^ " not found.")
View
2 bytecomp/translobj.ml
@@ -23,7 +23,7 @@ open Lambda
let oo_prim name =
try
transl_path
- (fst (Env.lookup_value (Ldot (Lident "CamlinternalOO", name)) Env.empty))
+ (fst (Env.lookup_value_lid (Ldot (Lident "CamlinternalOO", name)) Env.empty))
with Not_found ->
fatal_error ("Primitive " ^ name ^ " not found.")
View
25 camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
@@ -111,7 +111,9 @@ module Make (Ast : Sig.Camlp4Ast) = struct
;
value array_function str name =
- ldot (lident str) (if Camlp4_config.unsafe.val then "unsafe_" ^ name else name)
+ longident Camlp4_import.Location.none
+ (ldot (lident str)
+ (if Camlp4_config.unsafe.val then "unsafe_" ^ name else name))
;
value mkrf =
@@ -163,11 +165,12 @@ module Make (Ast : Sig.Camlp4Ast) = struct
| _ -> error (loc_of_ident i) "invalid long identifier" ]
in self i None;
- value ident ?conv_lid i = fst (ident_tag ?conv_lid i);
+ value ident ?conv_lid i =
+ longident (mkloc (loc_of_ident i)) (fst (ident_tag ?conv_lid i));
value long_lident msg i =
match ident_tag i with
- [ (i, `lident) -> i
+ [ (lid, `lident) -> longident (mkloc (loc_of_ident i)) lid
| _ -> error (loc_of_ident i) msg ]
;
@@ -182,6 +185,11 @@ module Make (Ast : Sig.Camlp4Ast) = struct
| _ -> error (loc_of_ident i) "uppercase identifier expected" ]
;
+ value long_uident ?conv_con i =
+ longident (mkloc (loc_of_ident i)) (long_uident ?conv_con i)
+ ;
+
+(*
value rec ctyp_long_id_prefix t =
match t with
[ <:ctyp< $id:i$ >> -> ident i
@@ -191,6 +199,13 @@ module Make (Ast : Sig.Camlp4Ast) = struct
Lapply li1 li2
| t -> error (loc_of_ctyp t) "invalid module expression" ]
;
+*)
+
+ value lident = Camlp4_import.Longident.lident Camlp4_import.Location.none
+ ;
+ value mkli s ml =
+ Camlp4_import.Longident.longident Camlp4_import.Location.none (mkli s ml)
+ ;
value ctyp_long_id t =
match t with
@@ -598,7 +613,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
fun
[ <:expr@loc< $x$.val >> ->
mkexp loc
- (Pexp_apply (mkexp loc (Pexp_ident (Lident "!"))) [("", expr x)])
+ (Pexp_apply (mkexp loc (Pexp_ident (lident "!"))) [("", expr x)])
| ExAcc loc _ _ | <:expr@loc< $id:<:ident< $_$ . $_$ >>$ >> as e ->
let (e, l) =
match sep_expr_acc [] e with
@@ -658,7 +673,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
let e =
match e with
[ <:expr@loc< $x$.val >> ->
- Pexp_apply (mkexp loc (Pexp_ident (Lident ":=")))
+ Pexp_apply (mkexp loc (Pexp_ident (lident ":=")))
[("", expr x); ("", expr v)]
| ExAcc loc _ _ ->
match (expr e).pexp_desc with
View
24 camlp4/boot/Camlp4.ml
@@ -14300,8 +14300,9 @@ module Struct =
fun s -> try Hashtbl.find t s with | Not_found -> s)
let array_function str name =
- ldot (lident str)
- (if !Camlp4_config.unsafe then "unsafe_" ^ name else name)
+ longident Camlp4_import.Location.none
+ (ldot (lident str)
+ (if !Camlp4_config.unsafe then "unsafe_" ^ name else name))
let mkrf =
function
@@ -14352,11 +14353,12 @@ module Struct =
| _ -> error (loc_of_ident i) "invalid long identifier"
in self i None
- let ident ?conv_lid i = fst (ident_tag ?conv_lid i)
+ let ident ?conv_lid i =
+ longident (mkloc (loc_of_ident i)) (fst (ident_tag ?conv_lid i))
let long_lident msg i =
match ident_tag i with
- | (i, `lident) -> i
+ | (lid, `lident) -> longident (mkloc (loc_of_ident i)) lid
| _ -> error (loc_of_ident i) msg
let long_type_ident = long_lident "invalid long identifier type"
@@ -14370,13 +14372,23 @@ module Struct =
| (i, `app) -> i
| _ -> error (loc_of_ident i) "uppercase identifier expected"
+ let long_uident ?conv_con i =
+ longident (mkloc (loc_of_ident i)) (long_uident ?conv_con i)
+
+(*
let rec ctyp_long_id_prefix t =
match t with
| Ast.TyId (_, i) -> ident i
| Ast.TyApp (_, m1, m2) ->
let li1 = ctyp_long_id_prefix m1 in
let li2 = ctyp_long_id_prefix m2 in Lapply (li1, li2)
| t -> error (loc_of_ctyp t) "invalid module expression"
+*)
+
+ let lident = Camlp4_import.Longident.lident Camlp4_import.Location.none
+ let mkli s ml =
+ Camlp4_import.Longident.longident Camlp4_import.Location.none
+ (mkli s ml)
let ctyp_long_id t =
match t with
@@ -14879,7 +14891,7 @@ module Struct =
function
| Ast.ExAcc (loc, x, (Ast.ExId (_, (Ast.IdLid (_, "val"))))) ->
mkexp loc
- (Pexp_apply ((mkexp loc (Pexp_ident (Lident "!"))),
+ (Pexp_apply ((mkexp loc (Pexp_ident (lident "!"))),
[ ("", (expr x)) ]))
| (ExAcc (loc, _, _) | Ast.ExId (loc, (Ast.IdAcc (_, _, _))) as
e) ->
@@ -14958,7 +14970,7 @@ module Struct =
(match e with
| Ast.ExAcc (loc, x,
(Ast.ExId (_, (Ast.IdLid (_, "val"))))) ->
- Pexp_apply ((mkexp loc (Pexp_ident (Lident ":="))),
+ Pexp_apply ((mkexp loc (Pexp_ident (lident ":="))),
[ ("", (expr x)); ("", (expr v)) ])
| ExAcc (loc, _, _) ->
(match (expr e).pexp_desc with
View
2 debugger/eval.ml
@@ -75,7 +75,7 @@ let rec expression event env = function
(begin match valdesc.val_kind with
Val_ivar (_, cl_num) ->
let (p0, _) =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
+ Env.lookup_value_lid (Longident.Lident ("self-" ^ cl_num)) env
in
let v = path event p0 in
let i = path event p in
View
5 debugger/loadprinter.ml
@@ -96,11 +96,12 @@ let rec eval_path = function
(* Install, remove a printer (as in toplevel/topdirs) *)
let match_printer_type desc typename =
+ let lid = Ldot(Lident "Topdirs", typename) in
let (printer_type, _) =
try
- Env.lookup_type (Ldot(Lident "Topdirs", typename)) Env.empty
+ Env.lookup_type_lid lid Env.empty
with Not_found ->
- raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename)))) in
+ raise (Error(Unbound_identifier(longident Location.none lid))) in
Ctype.init_def(Ident.current_time());
Ctype.begin_def();
let ty_arg = Ctype.newvar() in
View
11 debugger/parser.mly
@@ -166,12 +166,14 @@ opt_signed_int64_eol :
/* Identifiers and long identifiers */
-longident :
+lid :
LIDENT { Lident $1 }
| module_path DOT LIDENT { Ldot($1, $3) }
| OPERATOR { Lident $1 }
;
+longident : lid { longident (Location.symbol_rloc ()) $1 }
+
module_path :
UIDENT { Lident $1 }
| module_path DOT UIDENT { Ldot($1, $3) }
@@ -181,9 +183,10 @@ longident_eol :
longident end_of_line { $1 };
opt_longident :
- UIDENT { Some (Lident $1) }
- | LIDENT { Some (Lident $1) }
- | module_path DOT UIDENT { Some (Ldot($1, $3)) }
+ UIDENT { Some (lident (Location.symbol_rloc ()) $1) }
+ | LIDENT { Some (lident (Location.symbol_rloc ()) $1) }
+ | module_path DOT UIDENT
+ { Some (longident (Location.symbol_rloc ()) (Ldot($1, $3))) }
| { None };
opt_longident_eol :
View
2 ocamldoc/odoc_misc.ml
@@ -77,6 +77,8 @@ let rec string_of_longident li =
| Longident.Lapply(l1, l2) ->
string_of_longident l1 ^ "(" ^ string_of_longident l2 ^ ")"
+let string_of_longident li = string_of_longident li.Longident.lid
+
let get_fields type_expr =
let (fields, _) = Ctype.flatten_fields (Ctype.object_fields type_expr) in
List.fold_left
View
3 ocamlwizard/TODO
@@ -1,6 +1,6 @@
-- Rename: replace all the id definitions ; not just the initial one
- Rename: replace in multiple files
- Rename: check that we always lookup in the right environment
+- Rename: do more testing
- Rename: rename everything an not just values
- Rename: collect all occurrences in a or-pattern
@@ -19,4 +19,3 @@
- Match_cases completion: buffer still marked modified if we undo the completion
- Expansion: allow expansion even if the match_case is unfinished
- Expansion: add parentheses as needed for or-patterns
-- Emacs mode: use a mode for .ml files
View
6 toplevel/genprintval.ml
@@ -157,13 +157,13 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
let tree_of_constr =
tree_of_qualified
(fun lid env ->
- let (_path, cstr) = Env.lookup_constructor lid env
+ let (_path, cstr) = Env.lookup_constructor_lid lid env
in
cstr.cstr_res)
and tree_of_label =
tree_of_qualified (fun lid env ->
- let (_path, label) = Env.lookup_label lid env
+ let (_path, label) = Env.lookup_label_lid lid env
in
label.lbl_res)
@@ -350,7 +350,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
try
(* Attempt to recover the constructor description for the exn
from its name *)
- let (_path, cstr) = Env.lookup_constructor0 lid env in
+ let (_path, cstr) = Env.lookup_constructor lid env in
let path =
match cstr.cstr_tag with
Cstr_exception p -> p | _ -> raise Not_found in
View
4 toplevel/opttopdirs.ml
@@ -103,7 +103,7 @@ type 'a printer_type_old = 'a -> unit
let match_printer_type ppf desc typename =
let (printer_type, _) =
try
- Env.lookup_type (Ldot(Lident "Topdirs", typename)) !toplevel_env
+ Env.lookup_type_lid (Ldot(Lident "Topdirs", typename)) !toplevel_env
with Not_found ->
fprintf ppf "Cannot find type Topdirs.%s.@." typename;
raise Exit in
@@ -119,7 +119,7 @@ let match_printer_type ppf desc typename =
let find_printer_type ppf lid =
try
- let (path, desc) = Env.lookup_value lid !toplevel_env in
+ let (path, desc) = Env.lookup_value_lid lid !toplevel_env in
let (ty_arg, is_old_style) =
try
(match_printer_type ppf desc "printer_type_new", false)
View
8 toplevel/topdirs.ml
@@ -141,7 +141,7 @@ type 'a printer_type_old = 'a -> unit
let match_printer_type ppf desc typename =
let (printer_type, _) =
try
- Env.lookup_type (Ldot(Lident "Topdirs", typename)) !toplevel_env
+ Env.lookup_type_lid (Ldot(Lident "Topdirs", typename)) !toplevel_env
with Not_found ->
fprintf ppf "Cannot find type Topdirs.%s.@." typename;
raise Exit in
@@ -157,7 +157,7 @@ let match_printer_type ppf desc typename =
let find_printer_type ppf lid =
try
- let (path, desc) = Env.lookup_value0 lid !toplevel_env in
+ let (path, desc) = Env.lookup_value lid !toplevel_env in
let (ty_arg, is_old_style) =
try
(match_printer_type ppf desc "printer_type_new", false)
@@ -210,7 +210,7 @@ let tracing_function_ptr =
let dir_trace ppf lid =
try
- let (path, desc) = Env.lookup_value0 lid !toplevel_env in
+ let (path, desc) = Env.lookup_value lid !toplevel_env in
(* Check if this is a primitive *)
match desc.val_kind with
| Val_prim p ->
@@ -246,7 +246,7 @@ let dir_trace ppf lid =
let dir_untrace ppf lid =
try
- let (path, desc) = Env.lookup_value0 lid !toplevel_env in
+ let (path, desc) = Env.lookup_value lid !toplevel_env in
let rec remove = function
| [] ->
fprintf ppf "%a was not traced.@." Printtyp.longident lid;
View
2 typing/ctype.ml
@@ -2775,7 +2775,7 @@ let lid_of_path ?sharp path =
{Longident.loc = Location.none ; lid = lid_of_path ?sharp path}
let find_cltype_for_path env p =
- let path, cl_abbr = Env.lookup_type0 (lid_of_path ~sharp:"#" p) env in
+ let path, cl_abbr = Env.lookup_type (lid_of_path ~sharp:"#" p) env in
match cl_abbr.type_manifest with
Some ty ->
begin match (repr ty).desc with
View
38 typing/env.ml
@@ -495,27 +495,31 @@ let lookup_simple proj1 proj2 lid env =
let lookup0 proj1 proj2 lid = lookup proj1 proj2 lid.lid
-let lookup_value =
+let lookup_value_lid =
lookup (fun env -> env.values) (fun sc -> sc.comp_values)
-let lookup_annot id e =
- lookup0 (fun env -> env.annotations) (fun sc -> sc.comp_annotations) id e
-and lookup_constructor =
+let lookup_annot_lid id e =
+ lookup (fun env -> env.annotations) (fun sc -> sc.comp_annotations) id e
+and lookup_constructor_lid =
lookup (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
-and lookup_label =
+and lookup_label_lid =
lookup (fun env -> env.labels) (fun sc -> sc.comp_labels)
-and lookup_type =
+and lookup_type_lid =
lookup (fun env -> env.types) (fun sc -> sc.comp_types)
-and lookup_modtype =
- lookup0 (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
-and lookup_class =
- lookup0 (fun env -> env.classes) (fun sc -> sc.comp_classes)
-and lookup_cltype =
- lookup0 (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
-
-let lookup_value0 lid = lookup_value lid.lid
-let lookup_constructor0 lid = lookup_constructor lid.lid
-let lookup_label0 lid = lookup_label lid.lid
-let lookup_type0 lid = lookup_type lid.lid
+and lookup_modtype_lid =
+ lookup (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
+and lookup_class_lid =
+ lookup (fun env -> env.classes) (fun sc -> sc.comp_classes)
+and lookup_cltype_lid =
+ lookup (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+
+let lookup_value lid = lookup_value_lid lid.lid
+let lookup_annot lid = lookup_annot_lid lid.lid
+let lookup_constructor lid = lookup_constructor_lid lid.lid
+let lookup_label lid = lookup_label_lid lid.lid
+let lookup_type lid = lookup_type_lid lid.lid
+let lookup_modtype lid = lookup_modtype_lid lid.lid
+let lookup_class lid = lookup_class_lid lid.lid
+let lookup_cltype lid = lookup_cltype_lid lid.lid
let ident_tbl_fold f t acc =
List.fold_right
View
22 typing/env.mli
@@ -40,21 +40,25 @@ val find_modtype_expansion: Path.t -> t -> Types.module_type
(* Lookup by long identifiers *)
-val lookup_value0: Longident.t -> t -> Path.t * value_description
-val lookup_label0: Longident.t -> t -> Path.t * label_description
-val lookup_type0: Longident.t -> t -> Path.t * type_declaration
-val lookup_constructor0: Longident.t -> t -> Path.t * constructor_description
-
-val lookup_value: Longident.lid -> t -> Path.t * value_description
+val lookup_value: Longident.t -> t -> Path.t * value_description
val lookup_annot: Longident.t -> t -> Path.t * Annot.ident
-val lookup_constructor: Longident.lid -> t -> Path.t * constructor_description
-val lookup_label: Longident.lid -> t -> Path.t * label_description
-val lookup_type: Longident.lid -> t -> Path.t * type_declaration
+val lookup_constructor: Longident.t -> t -> Path.t * constructor_description
+val lookup_label: Longident.t -> t -> Path.t * label_description
+val lookup_type: Longident.t -> t -> Path.t * type_declaration
val lookup_module: Longident.t -> t -> Path.t * module_type
val lookup_modtype: Longident.t -> t -> Path.t * modtype_declaration
val lookup_class: Longident.t -> t -> Path.t * class_declaration
val lookup_cltype: Longident.t -> t -> Path.t * class_type_declaration
+val lookup_value_lid: Longident.lid -> t -> Path.t * value_description
+val lookup_annot_lid: Longident.lid -> t -> Path.t * Annot.ident
+val lookup_constructor_lid: Longident.lid -> t -> Path.t * constructor_description
+val lookup_label_lid: Longident.lid -> t -> Path.t * label_description
+val lookup_type_lid: Longident.lid -> t -> Path.t * type_declaration
+val lookup_modtype_lid: Longident.lid -> t -> Path.t * modtype_declaration
+val lookup_class_lid: Longident.lid -> t -> Path.t * class_declaration
+val lookup_cltype_lid: Longident.lid -> t -> Path.t * class_type_declaration
+
(* Fold over all identifiers (for analysis purpose) *)
val fold_values:
(string -> Path.t -> value_description -> 'a -> 'a) ->
View
22 typing/typecore.ml
@@ -120,13 +120,13 @@ let type_option ty =
let option_none ty loc =
let lid = Longident.lident Location.none "None" in
- let (path, cnone) = Env.lookup_constructor0 lid Env.initial in
+ let (path, cnone) = Env.lookup_constructor lid Env.initial in
{ exp_desc = Texp_construct(path, cnone, []);
exp_type = ty; exp_loc = loc; exp_env = Env.initial }
let option_some texp =
let lid = Longident.lident Location.none "Some" in
- let (path, csome) = Env.lookup_constructor0 lid Env.initial in
+ let (path, csome) = Env.lookup_constructor lid Env.initial in
{ exp_desc = Texp_construct(path, csome, [texp]); exp_loc = texp.exp_loc;
exp_type = type_option texp.exp_type; exp_env = texp.exp_env }
@@ -960,7 +960,7 @@ let rec approx_type env sty =
newty (Ttuple (List.map (approx_type env) args))
| Ptyp_constr (lid, ctl) ->
begin try
- let (path, decl) = Env.lookup_type0 lid env in
+ let (path, decl) = Env.lookup_type lid env in
if List.length ctl <> decl.type_arity then raise Not_found;
let tyl = List.map (approx_type env) ctl in
newconstr path tyl
@@ -1116,12 +1116,12 @@ let rec type_exp env sexp =
begin match desc.val_kind with
Val_ivar (_, cl_num) ->
let (self_path, _) =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
+ Env.lookup_value_lid (Longident.Lident ("self-" ^ cl_num)) env
in
Texp_instvar(self_path, path)
| Val_self (_, _, cl_num, _) ->
let (path, _) =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
+ Env.lookup_value_lid (Longident.Lident ("self-" ^ cl_num)) env
in
Texp_ident(path, desc)
| Val_unbound ->
@@ -1490,8 +1490,8 @@ let rec type_exp env sexp =
end
in
begin match
- Env.lookup_value (Longident.Lident ("selfpat-" ^ cl_num)) env,
- Env.lookup_value (Longident.Lident ("self-" ^cl_num)) env
+ Env.lookup_value_lid (Longident.Lident ("selfpat-" ^ cl_num)) env,
+ Env.lookup_value_lid (Longident.Lident ("self-" ^cl_num)) env
with
(_, ({val_kind = Val_self (meths, _, _, privty)} as desc)),
(path, _) ->
@@ -1572,12 +1572,12 @@ let rec type_exp env sexp =
end
| Pexp_setinstvar (lab, snewval) ->
begin try
- let (path, desc) = Env.lookup_value (Longident.Lident lab) env in
+ let (path, desc) = Env.lookup_value_lid (Longident.Lident lab) env in
match desc.val_kind with
Val_ivar (Mutable, cl_num) ->
let newval = type_expect env snewval (instance desc.val_type) in
let (path_self, _) =
- Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
+ Env.lookup_value_lid (Longident.Lident ("self-" ^ cl_num)) env
in
re {
exp_desc = Texp_setinstvar(path_self, path, newval);
@@ -1604,8 +1604,8 @@ let rec type_exp env sexp =
[] in
begin match
try
- Env.lookup_value (Longident.Lident "selfpat-*") env,
- Env.lookup_value (Longident.Lident "self-*") env
+ Env.lookup_value_lid (Longident.Lident "selfpat-*") env,
+ Env.lookup_value_lid (Longident.Lident "self-*") env
with Not_found ->
raise(Error(loc, Outside_class))
with
View
4 typing/typedecl.ml
@@ -209,7 +209,7 @@ let transl_declaration env (name, sdecl) id =
(* Add abstract row *)
if is_fixed_type sdecl then begin
let (p, _) =
- try Env.lookup_type (Longident.Lident(Ident.name id ^ "#row")) env
+ try Env.lookup_type_lid (Longident.Lident(Ident.name id ^ "#row")) env
with Not_found -> assert false in
set_fixed_row env sdecl.ptype_loc p decl
end;
@@ -776,7 +776,7 @@ let transl_exception env excdecl =
let transl_exn_rebind env loc lid =
let (path, cdescr) =
try
- Env.lookup_constructor0 lid env
+ Env.lookup_constructor lid env
with Not_found ->
raise(Error(loc, Unbound_exception lid)) in
match cdescr.cstr_tag with
View
2 typing/typemod.ml
@@ -198,7 +198,7 @@ let merge_constraint initial_env loc sg lid constr =
with Exit -> raise (Error (sdecl.ptype_loc, With_need_typeconstr))
in
let (path, _) =
- try Env.lookup_type0 lid initial_env with Not_found -> assert false
+ try Env.lookup_type lid initial_env with Not_found -> assert false
in
let sub = Subst.add_type id path Subst.identity in
Subst.signature sub sg
View
12 typing/typetexp.ml
@@ -83,15 +83,15 @@ let find_component lookup make_error env loc lid =
: unit (* to avoid a warning *));
assert false
-let find_type = find_component Env.lookup_type0 (fun lid -> Unbound_type_constructor lid)
+let find_type = find_component Env.lookup_type (fun lid -> Unbound_type_constructor lid)
-let find_constructor = find_component Env.lookup_constructor0 (fun lid -> Unbound_constructor lid)
+let find_constructor = find_component Env.lookup_constructor (fun lid -> Unbound_constructor lid)
-let find_label = find_component Env.lookup_label0 (fun lid -> Unbound_label lid)
+let find_label = find_component Env.lookup_label (fun lid -> Unbound_label lid)
let find_class = find_component Env.lookup_class (fun lid -> Unbound_class lid)
-let find_value = find_component Env.lookup_value0 (fun lid -> Unbound_value lid)
+let find_value = find_component Env.lookup_value (fun lid -> Unbound_value lid)
let find_module = find_component Env.lookup_module (fun lid -> Unbound_module lid)
@@ -258,7 +258,7 @@ let rec transl_type env policy styp =
| Ptyp_class(lid, stl, present) ->
let (path, decl, is_variant) =
try
- let (path, decl) = Env.lookup_type0 lid env in
+ let (path, decl) = Env.lookup_type lid env in
let rec check decl =
match decl.type_manifest with
None -> raise Not_found
@@ -280,7 +280,7 @@ let rec transl_type env policy styp =
| Longident.Ldot(r, s) -> Longident.Ldot (r, "#" ^ s)
| Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
} in
- let (path, decl) = Env.lookup_type0 lid2 env in
+ let (path, decl) = Env.lookup_type lid2 env in
(path, decl, false)
with Not_found ->
raise(Error(styp.ptyp_loc, Unbound_class lid))

0 comments on commit 7a517b8

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