Commits

camlspotter committed 6f9ec11

lookup_value and lookup_values

  • Participants
  • Parent commits 4f0622d

Comments (0)

Files changed (12)

File boot/ocamlc

Binary file modified.

File boot/ocamldep

Binary file modified.

File bytecomp/matching.ml

       let env = Env.open_pers_signature modname Env.initial in
       let p = try
         match Env.lookup_value (Longident.Lident field) env with
-        | [] | _::_::_ -> assert false
-        | [(Path.Pdot(_,_,i), _)] -> i
+        | (Path.Pdot(_,_,i), _) -> i
         | _ -> fatal_error ("Primitive "^modname^"."^field^" not found.")
       with Not_found -> fatal_error ("Primitive "^modname^"."^field^" not found.")
       in

File bytecomp/translmod.ml

 let mod_prim name =
   try
     transl_path
-      (fst (match Env.lookup_value (Ldot (Lident "CamlinternalMod", name))
-                             Env.empty  with [v] -> v | _ -> assert false))
+      (fst (Env.lookup_value (Ldot (Lident "CamlinternalMod", name))
+                             Env.empty))
   with Not_found ->
     fatal_error ("Primitive " ^ name ^ " not found.")
 

File bytecomp/translobj.ml

 let oo_prim name =
   try
     transl_path
-      (fst (match Env.lookup_value (Ldot (Lident "CamlinternalOO", name)) Env.empty with [v] -> v | _ -> assert false))
+      (fst (Env.lookup_value (Ldot (Lident "CamlinternalOO", name)) Env.empty))
   with Not_found ->
     fatal_error ("Primitive " ^ name ^ " not found.")
 

File ocamldoc/odoc_ast.ml

           in
           (0, new_env2, [ Element_module_type mt ])
 
-      | Parsetree.Pstr_open longident ->
+      | Parsetree.Pstr_open longident
+      | Parsetree.Pstr_open_overload longident ->
           (* A VOIR : enrichir l'environnement quand open ? *)
           let ele_comments = match comment_opt with
             None -> []

File toplevel/topdirs.ml

 
 let find_printer_type ppf lid =
   try
-    let (path, desc) = match Env.lookup_value lid !toplevel_env with [v] -> v | _ -> assert false (* interesting though *) 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)
 
 let dir_trace ppf lid =
   try
-    let (path, desc) = match Env.lookup_value lid !toplevel_env with [v] -> v | _ -> assert false 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 ->
 
 let dir_untrace ppf lid =
   try
-    let (path, desc) = match Env.lookup_value lid !toplevel_env with [v] -> v | _ -> assert false in
+    let (path, desc) = Env.lookup_value lid !toplevel_env in
     let rec remove = function
     | [] ->
         fprintf ppf "%a was not traced.@." Printtyp.longident lid;

File typing/env.ml

   | Lapply(l1, l2) ->
       raise Not_found
 
+let lookup_values =
+  lookup' (fun env -> env.values) (fun sc -> sc.comp_values)
 let lookup_value =
-  lookup' (fun env -> env.values) (fun sc -> sc.comp_values)
+  lookup (fun env -> env.values) (fun sc -> sc.comp_values)
 let lookup_annot id e =
   lookup (fun env -> env.annotations) (fun sc -> sc.comp_annotations) id e
 and lookup_constructor =

File typing/env.mli

 
 (* Lookup by long identifiers *)
 
-val lookup_value: Longident.t -> t -> (Path.t * value_description) list
+val lookup_value: Longident.t -> t -> Path.t * value_description
+val lookup_values: Longident.t -> t -> (Path.t * value_description) list
 val lookup_annot: Longident.t -> t -> Path.t * Annot.ident
 val lookup_constructor: Longident.t -> t -> constructor_description
 val lookup_label: Longident.t -> t -> label_description

File typing/typecore.ml

                 (Stypes.An_ident (loc, name_of_path path, annot))
           with _ -> ()
         end;
-        let path_descs = Typetexp.find_value env loc lid in
+        let path_descs = Typetexp.find_values env loc lid in
         match path_descs with
         | [(path, desc)] ->
 	    Spot.Annot.record loc (Spot.Annot.Use (Spot.Kind.Value, path));
               exp_desc =
                 begin match desc.val_kind with
                   Val_ivar (_, cl_num) ->
-                    let self_path_s = 
+                    let self_path, _ = 
                       Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
                     in
-                    begin match self_path_s with
-                    | [(self_path, _)] ->
-                        Texp_instvar(self_path, path)
-                    | _ -> assert false
-                    end
+                    Texp_instvar(self_path, path)
                 | Val_self (_, _, cl_num, _) ->
-                    let path_s = 
+                    let path, _ = 
                       Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env
                     in
-                    begin match path_s with
-                    | [(path, _)] -> Texp_ident(path, desc)
-                    | _ -> assert false
-                    end
+                    Texp_ident(path, desc)
                 | Val_unbound ->
                     raise(Error(loc, Masked_instance_variable lid))
                 | _ ->
                 Env.lookup_value (Longident.Lident ("selfpat-" ^ cl_num)) env,
                 Env.lookup_value (Longident.Lident ("self-" ^cl_num)) env
               with
-                [(_, ({val_kind = Val_self (meths, _, _, privty)} as desc))],
-                [(path, _)] ->
+                (_, ({val_kind = Val_self (meths, _, _, privty)} as desc)),
+                (path, _) ->
                   let (_, typ) =
                     filter_self_method env met Private meths privty
                   in
         end
   | Pexp_setinstvar (lab, snewval) ->
       begin try
-        let path_descs = Env.lookup_value (Longident.Lident lab) env in
-        match path_descs with
-        | [] | _::_::_ -> assert false
-        | [(path, desc)] ->
-            match desc.val_kind with
-              Val_ivar (Mutable, cl_num) ->
-                let newval = type_expect env snewval (instance desc.val_type) in
-                let (path_self, _) =
-                  match Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env with
-                  | [v] -> v
-                  | _ -> assert false
-                in
-                re {
-                  exp_desc = Texp_setinstvar(path_self, path, newval);
-                  exp_loc = loc;
-                  exp_type = instance Predef.type_unit;
-                  exp_env = env }
-            | Val_ivar _ ->
-                raise(Error(loc,Instance_variable_not_mutable(true,lab)))
-            | _ ->
-                raise(Error(loc,Instance_variable_not_mutable(false,lab)))
+        let path, desc = Env.lookup_value (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 in
+            re {
+              exp_desc = Texp_setinstvar(path_self, path, newval);
+              exp_loc = loc;
+              exp_type = instance Predef.type_unit;
+              exp_env = env }
+        | Val_ivar _ ->
+            raise(Error(loc,Instance_variable_not_mutable(true,lab)))
+        | _ ->
+            raise(Error(loc,Instance_variable_not_mutable(false,lab)))
       with
         Not_found ->
           raise(Error(loc, Unbound_instance_variable lab))
         with Not_found ->
           raise(Error(loc, Outside_class))
       with
-      | [], _ | _, [] | _::_::_, _ | _, _::_::_ -> assert false
-      | [(_, {val_type = self_ty; val_kind = Val_self (_, vars, _, _)})],
-        [(path_self, _)] ->
+      | (_, {val_type = self_ty; val_kind = Val_self (_, vars, _, _)}),
+        (path_self, _) ->
           let type_override (lab, snewval) =
             begin try
               let (id, _, _, ty) = Vars.find lab !vars in

File typing/typetexp.ml

 
 let find_class = find_component Env.lookup_class (fun lid -> Unbound_class lid)
 
+let find_values = find_component Env.lookup_values (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)

File typing/typetexp.mli

 val find_type: Env.t -> Location.t -> Longident.t -> Path.t * Types.type_declaration
 val find_constructor: Env.t -> Location.t -> Longident.t -> Types.constructor_description
 val find_label: Env.t -> Location.t -> Longident.t -> Types.label_description
-val find_value: Env.t -> Location.t -> Longident.t -> (Path.t * Types.value_description) list
+val find_values: Env.t -> Location.t -> Longident.t -> (Path.t * Types.value_description) list
+val find_value: Env.t -> Location.t -> Longident.t -> Path.t * Types.value_description
 val find_class:  Env.t -> Location.t -> Longident.t -> Path.t * Types.class_declaration
 val find_module: Env.t -> Location.t -> Longident.t -> Path.t * Types.module_type
 val find_modtype: Env.t -> Location.t -> Longident.t -> Path.t * Types.modtype_declaration