camlspotter avatar camlspotter committed daa5575

fixed search of exceptions

Comments (0)

Files changed (2)

         record p.pat_loc (Type (p.pat_type, p.pat_env, `Pattern ident_opt));
         begin match p.pat_desc with
         | Tpat_construct (_, cdesc, _, _) ->
-            let kind = match cdesc.Types.cstr_tag with
-              | Types.Cstr_exception _ -> K.Exception
-              | _ -> K.Type
-            in
-            let path = 
-              let ty = cdesc.Types.cstr_res in
-              match (Ctype.repr ty).Types.desc with
-              | Tconstr (p, _, _) -> p
-              | _ -> assert false
-            in
-            record p.pat_loc (Use (kind, Path.Pdot(path, cdesc.Types.cstr_name, -1 (* dummy *))))
+            begin match cdesc.Types.cstr_tag with
+            | Types.Cstr_exception (path,_) -> 
+                record p.pat_loc (Use (Kind.Exception, path))
+            | _ -> 
+                let path = 
+                  let ty = cdesc.Types.cstr_res in
+                  match (Ctype.repr ty).Types.desc with
+                  | Tconstr (p, _, _) -> p
+                  | _ -> assert false
+                in
+                record p.pat_loc (Use (Kind.Type, Path.Pdot(path, cdesc.Types.cstr_name, -1 (* dummy *))))
+            end
         | Tpat_record _ -> record_record tbl p.pat_loc p.pat_type
         | _ -> ()
         end;
 
         begin match e.exp_desc with
         | Texp_construct (_, cdesc, _, _) ->
-            let kind = match cdesc.Types.cstr_tag with
-              | Types.Cstr_exception _ -> K.Exception
-              | _ -> K.Constructor
-            in
-            (* CR jfuruse: dupe at class fold *)
-            let path = 
-              let ty = cdesc.Types.cstr_res in
-              match (Ctype.repr ty).Types.desc with
-              | Tconstr (p, _, _) -> p
-              | _ -> assert false
-            in
-            record_use_construct e.exp_loc kind path cdesc.Types.cstr_name
+            begin match cdesc.Types.cstr_tag with
+              | Types.Cstr_exception (path, _) ->
+                  record e.exp_loc (Use (Kind.Exception, path))
+              | _ ->
+                  (* CR jfuruse: dupe at class fold *)
+                  let path = 
+                    let ty = cdesc.Types.cstr_res in
+                    match (Ctype.repr ty).Types.desc with
+                    | Tconstr (p, _, _) -> p
+                    | _ -> assert false
+                  in
+                  record_use_construct e.exp_loc Kind.Constructor path cdesc.Types.cstr_name
+            end
         | Texp_record _ -> record_record tbl e.exp_loc e.exp_type
         | _ -> ()
         end;
     type t = binding
     val domain : t -> Ident.t list
     val find : t -> Ident.t -> (Kind.t * z) option
+(*    val find_first_name : t -> Kind.t -> string -> (Kind.t * z) option *)
     val override : t -> structure_item -> t
     val overrides : t -> structure -> t
     val set : t -> structure -> unit
       | Some str -> f str
     let domain = with_check (List.map fst) 
     let find t id = try Some (with_check (List.assoc id) t) with Not_found -> None
+(*
+    let find_first_name t k name = 
+      let assoc name xs = 
+        match 
+          List.find_map_opt (fun (id, (k', _ as v)) ->
+            if Ident0.name id = name && k = k' then Some v
+            else None) xs
+        with
+        | None -> raise Not_found
+        | Some v -> v
+      in
+      try Some (with_check (assoc name) t) with Not_found -> None
+*)
     let override t v = ref (Some (with_check (fun t -> v :: t) t))
     let overrides t vs = ref (Some (with_check (fun t -> vs @ t) t))
     let invalid = ref None 
   let format = Value.Format.env
   let domain t = Binding.domain t.binding
   let find t id = Binding.find t.binding id
+  (* let find_first_name t name = Binding.find_first_name t.binding name *)
   let override t v = { t with binding = Binding.override t.binding v }
   let overrides t vs = { t with binding = Binding.overrides t.binding vs }
   let predef = {
 	let v1 = find_path env (Kind.Module, p1) in
 	let v2 = find_path env (Kind.Module, p2) in
 	apply v1 v2
-    | _, Path.Pident id ->
+    | k, Path.Pident id ->
         (* predef check first (testing) *)
         begin match Env.find Env.predef id with
         | Some (_, v) -> v
-        | None -> 
-            if Ident.global id then
-              lazy begin try
-                let path, str = !str_of_global_ident ~cwd:env.cwd ~load_paths:env.load_paths id in
-                let str = Structure ( { PIdent.path = path; ident = None }, 
-                                      str,
-                                      None (* CR jfuruse: todo (read .mli *))
-                in
-                Debug.format "@[<2>LOAD SUCCESS %s =@ %a@]@."
-                  (Ident.name id)
-                  Value.Format.t str;
-                str
+        | None when Ident.global id -> 
+            (* This must be a module *)
+            assert (k = Kind.Module);
+            lazy begin try
+              let path, str = !str_of_global_ident ~cwd:env.cwd ~load_paths:env.load_paths id in
+              let str = Structure ( { PIdent.path = path; ident = None }, 
+                                    str,
+                                    None (* CR jfuruse: todo (read .mli) *) )
+              in
+              Debug.format "@[<2>LOAD SUCCESS %s =@ %a@]@."
+                (Ident.name id)
+                Value.Format.t str;
+              str
               with
               | e -> 
                   eprintf "LOAD FAILURE %s: %s@." (Ident.name id) (Printexc.to_string e);
                   Error e
-              end
-            else begin 
-              lazy begin
-                Debug.format "find_path %s:%s in { %s }@." 
-                  (Kind.name kind)
-                  (Path.name p)
-                  (String.concat "; " 
-                    (List.map Ident.name (Env.domain env)));
-                match Env.find env id with
-                | Some (_, lazy v) -> v
-                | None -> 
+            end
+        | None ->
+            lazy begin
+              Debug.format "find_path %s:%s in { %s }@." 
+                (Kind.name kind)
+                (Path.name p)
+                (String.concat "; " 
+                   (List.map Ident.name (Env.domain env)));
+              match Env.find env id with
+              | Some (_, lazy v) -> v
+              | None -> 
     (*
                   (* it may be a predefed thing *)
                   try !!(snd (Env.find Env.predef id)) with Not_found ->
     *)
-                    (* If it is a non-value object, it might be included with stamp = -1 *)
-                    let error id = 
-                      Error (Failure (Printf.sprintf "%s:%s not found in { %s }" 
-                                        (Kind.name kind)
-                                        (Ident.name id)
-                                        (String.concat "; " 
-                                           (List.map Ident.name (Env.domain env)))))
-                    in
-                    match kind with
-                    | Kind.Value | Kind.Module | Kind.Class | Kind.Exception -> error id
-                    | _ ->
-                        let gid = Ident.create_with_stamp (Ident0.name id) (-1) in
-                        match Env.find env gid with
-                        | Some (_, lazy v) -> v
-                        | None -> error id
-              end
+                  (* If it is a non-value object, it might be included with stamp = -1 *)
+                  let error id = 
+                    Error (Failure (Printf.sprintf "%s:%s not found in { %s }" 
+                                      (Kind.name kind)
+                                      (Ident.name id)
+                                      (String.concat "; " 
+                                         (List.map Ident.name (Env.domain env)))))
+                  in
+                  match kind with
+                  | Kind.Value | Kind.Module | Kind.Class | Kind.Exception -> error id
+                  | Constructor | Field -> assert false
+                  | _ ->
+                      (* CR jfuruse: is it really required? *)
+                      let gid = { id with stamp = -1 } in
+                      match Env.find env gid with
+                      | Some (_, lazy v) -> v
+                      | None -> error id
             end
-            end
-    | (Kind.Constructor | Field), Path.Pdot (p, name, pos) ->
+        end
+    | (Kind.Constructor | Field ), Path.Pdot (p, name, pos) ->
         assert (pos = -1);
         lazy begin
           match !!(find_path env (Kind.Type, p)) with
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.