Commits

camlspotter committed bd96827

fixed the issue of finding typedef - load_path was not set

  • Participants
  • Parent commits cf6a306
  • Branches ocamlspot

Comments (0)

Files changed (5)

File ocamlspot/ocamlspot.ml

         if C.print_type_declaration then begin
           match List.filter (function Annot.Type _ -> true | _ -> false) annots with
           | [Annot.Type (typ, env)] -> 
-              printf "Expand: @[%a@]@." Typeexpand.format_as_expr (Typeexpand.expand env typ)
+              printf "Expand: @[%a@]@." Typeexpand.format_as_expr (Typeexpand.expand file.File.load_paths env typ)
           | [] -> ()
           | _ -> eprintf "More than one Annot.Type found. Disabled --print-type-decl.@."
         end;

File ocamlspot/typeexpand.ml

 open Format
 open Utils
 
+module EnvSummary = struct
+  open Env
+
+  let rec format ppf = function
+    | Env_empty -> fprintf ppf "END"
+    | Env_value (sum, id, _vdesc) -> 
+        fprintf ppf "Value %s@ " (Ident.name id);
+        format ppf sum
+    | Env_type (sum, id, _tdesc) ->
+        fprintf ppf "Type %s@ " (Ident.name id);
+        format ppf sum
+    | Env_exception (sum, id, _) ->
+        fprintf ppf "Exc %s@ " (Ident.name id);
+        format ppf sum
+    | Env_module (sum, id, _) ->
+        fprintf ppf "Module %s@ " (Ident.name id);
+        format ppf sum
+    | Env_modtype (sum, id, _) -> 
+        fprintf ppf "Module type %s@ " (Ident.name id);
+        format ppf sum
+    | Env_class (sum, id, _) -> 
+        fprintf ppf "Class %s@ " (Ident.name id);
+        format ppf sum
+    | Env_cltype (sum, id, _) -> 
+        fprintf ppf "Class type %s@ " (Ident.name id);
+        format ppf sum
+    | Env_open (sum, p) ->
+        fprintf ppf "open %s@ " (Path.name p);
+        format ppf sum
+
+  let format ppf sum = fprintf ppf "@[<v>%a@]" format sum
+end
+
 type t =
   | Function of (label * type_expr) list * type_expr
   | Tuple of type_expr list
       fprintf ppf "(@[%a@])" (Format.list ", " (fun ppf _ -> fprintf ppf "assert false")) typs
   | Variant args ->
       fprintf ppf "(assert false (* @[%a@] *))" 
-        (Format.list "| " (fun ppf -> 
+        (Format.list "@,| " (fun ppf -> 
           function
             | (name, []) -> fprintf ppf "%s" name
             | (name, args) -> 
         label_typ_list
   | Polyvar l_field_list ->
       fprintf ppf "(assert false (* @[%a@] | ... *))" 
-        (Format.list "| " (fun ppf (name, row_field) -> 
+        (Format.list "@,| " (fun ppf (name, row_field) -> 
           match row_field with
           | Rabsent | Rpresent None -> fprintf ppf "`%s" name
           | Rpresent (Some _) -> fprintf ppf "`%s (assert false)" name
       fprintf ppf "(@[%a@])" (Format.list ", " (fun ppf _ -> fprintf ppf "_")) typs
   | Variant args ->
       fprintf ppf "( @[%a@] )" 
-        (Format.list "| " (fun ppf -> 
+        (Format.list "@,| " (fun ppf -> 
           function
             | (name, []) -> fprintf ppf "%s" name
             | (name, args) -> 
         label_typ_list
   | Polyvar l_field_list ->
       fprintf ppf "(@[%a@] | ... )" 
-        (Format.list "| " (fun ppf (name, row_field) -> 
+        (Format.list "@,| " (fun ppf (name, row_field) -> 
           match row_field with
           | Rabsent | Rpresent None -> fprintf ppf "`%s" name
           | Rpresent (Some _) -> fprintf ppf "`%s _" name
             | None -> Abstract
             | Some typ -> expand env typ
       with
-      | Not_found -> prerr_endline "NOTFOUND"; Abstract (* pity *)
+      | Not_found -> 
+          eprintf "ENV @[%a@]@." EnvSummary.format (Env.summary env);
+          eprintf "NOT FOUND %s@." (Path.name path);
+          Abstract (* pity *)
       end
   | Tvariant row_desc -> Polyvar row_desc.row_fields
   | Tpoly (typ, _) -> expand env typ (* CR jfuruse: ? *)
   | Tarrow (label, typ_arg, typ_body, _) -> 
       expand_arrow ((label, typ_arg) :: st) typ_body
   | _ -> Function (List.rev st, typ)
+
+let expand load_path env ty =
+  let load_path_back = !Config.load_path in
+  Config.load_path := load_path;
+  Utils.protect ~f:(fun () -> expand env ty) () ~finally:(fun _ ->
+    Config.load_path := load_path_back)
+

File ocamlspot/typeexpand.mli

 
 type t 
 
-val expand : Env.t -> type_expr -> t
+val expand : string list (* load_path *) -> Env.t -> type_expr -> t
 
 val format_as_expr : Format.formatter -> t -> unit
 val format_as_pattern : Format.formatter -> t -> unit
+
+module EnvSummary : sig
+  val format : Format.formatter -> Env.summary -> unit
+end

File ocamlspot/utils.ml

 
 module Format = struct
   include Format
-  let rec list sep f ppf = function
+  let rec list (sep : (unit, formatter, unit) format)  f ppf = function
     | [] -> ()
     | [x] -> f ppf x
     | x::xs -> 
-        fprintf ppf "@[%a@]%t@,%a" 
+        fprintf ppf "@[%a@]%t%a" 
 	  f x
-	  (fun ppf -> fprintf ppf "%s" sep)
+	  (fun ppf -> fprintf ppf sep)
 	  (list sep f) xs
 
   let option f ppf = function

File ocamlspot/utils.mli

 module Format : sig
   include module type of Format with type formatter = Format.formatter
   val list :
-    string -> (formatter -> 'a -> unit) -> formatter -> 'a list -> unit
+    (unit, formatter, unit) format (* seprator *)
+    -> (formatter -> 'a -> unit) -> formatter -> 'a list -> unit
   val option :
     (formatter -> 'a -> unit) ->
     formatter -> 'a option -> unit