Commits

camlspotter committed 5d363ba

added comments

Comments (0)

Files changed (1)

typing/printtyp.ml

 module Opened_path = struct
   let do_heuristic = ref true (* the switch *)
   
-  (* global states *)
-  let env_ref = ref Env.empty
-  let opened_paths = ref []
+  (* Global states 
+
+     Having global states is generally a bad idea, but this prevents me from
+     extending all the printer functions with env arguments.
+  *)
+  let env_ref = ref Env.empty (** The type environment at the printing context *)
+  let opened_paths = ref [] (** The opened module paths at the context *)
 
   let rec get_opened_paths acc = function
     | Env.Env_empty -> acc
         get_opened_paths (p :: acc) summary
   ;;
 
+  (** [under_env env f v] executes [f v] under setting the global states
+      ([env_ref] and [opened_paths]) by [env]. After execution, the states
+      are recovered by the originals *) 
   let under_env env f v =
     let env_back = !env_ref in
     let opened_paths_back = !opened_paths in 
     opened_paths := get_opened_paths [] (Env.summary env);
     try 
       let res = f v in 
-      env_ref := env_back; opened_paths := opened_paths_back;
+      env_ref := env_back; 
+      opened_paths := opened_paths_back;
       res 
     with
     | e -> 
-        env_ref := env_back; opened_paths := opened_paths_back;
+        env_ref := env_back; 
+        opened_paths := opened_paths_back;
         raise e
 
-  let is_open p =
-    !do_heuristic &&
-      match p with
-      | Pident id when Ident.same id ident_pervasive -> true
-      | _ -> List.mem p !opened_paths 
+  let is_open = function
+    | Pident id when Ident.same id ident_pervasive -> true
+    | p -> !do_heuristic && List.mem p !opened_paths
 
+  (** [kind_of_path env p] determins for which kind of object the path [p] is
+      used under [env]. *)
   let kind_of_path env p =
     try
       Some (
       )
     with Not_found -> None 
 
+  (** [lident_of_path p] tralsnate the path [p] to [Longident.t]. *)
   let rec lident_of_path = function
     | Pident id -> Longident.Lident (Ident.name id)
     | Pdot (t, name, _) -> Longident.Ldot (lident_of_path t, name)
     | Papply (t1, t2) -> Longident.Lapply (lident_of_path t1, lident_of_path t2)
-
 end
 
 let under_env = Opened_path.under_env
   | Papply(p1, p2) ->
       fprintf ppf "%a(%a)" path p1 path p2
 
-open Opened_path
+module Heuristic_expansion = struct
 
-module Heuristic_expansion = struct
-  (* ty must be repred *)
+  open Opened_path
+
+  (* ty must be repr-ed *)
   let rec find_expansions acc ty =
     try
       let ty = try_expand_once_opt !env_ref ty in
       (field :: fields, rest)
 
 and heuristic_expand_constructor_type sch ty =
-  if not !do_heuristic then None
+  if not !Opened_path.do_heuristic then None
   else 
     try
       let def = 
           Some (fst (Heuristic_expansion.find_min (fun (_,sz1) (_,sz2) -> compare sz1 sz2) x xs))
     with
       | Ctype.Unify trace -> 
-          env_ref := Env.empty;
+          Opened_path.env_ref := Env.empty;
           Format.eprintf "@[<v2>heuristic_expand_constructor_type:@ @[%a@]@." 
             (fun ppf trace ->
               !Heuristic_expansion.report_unification_error_ref ppf
   !Oprint.out_type ppf (tree_of_typexp sch ty)
 
 let typexp sch prio ppf ty =
-  let tree_original = do_heuristic := false; tree_of_typexp sch ty in
-  let tree_heuristic = do_heuristic := true; tree_of_typexp sch ty in
+  let tree_original = Opened_path.do_heuristic := false; tree_of_typexp sch ty in
+  let tree_heuristic = Opened_path.do_heuristic := true; tree_of_typexp sch ty in
   if tree_original <> tree_heuristic then
     Format.fprintf ppf "@[%a@ < @[%a@] >@]"
       !Oprint.out_type tree_heuristic