daily pastebin goal
53%
SHARE
TWEET

Untitled

a guest Feb 16th, 2019 79 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
  2. index 4472155..c217cf9 100644
  3. --- a/toplevel/genprintval.ml
  4. +++ b/toplevel/genprintval.ml
  5. @@ -45,7 +45,7 @@ module type S =
  6.      val remove_printer : Path.t -> unit
  7.      val outval_of_untyped_exception : t -> Outcometree.out_value
  8.      val outval_of_value :
  9. -          int -> int ->
  10. +          int option -> int option ->
  11.            (int -> t -> Types.type_expr -> Outcometree.out_value option) ->
  12.            Env.t -> t -> type_expr -> Outcometree.out_value
  13.    end
  14. @@ -166,13 +166,16 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
  15.  
  16.      (* The main printing function *)
  17.  
  18. +    let unopt default = function None -> default | Some x -> x
  19. +
  20.      let outval_of_value max_steps max_depth check_depth env obj ty =
  21.  
  22. -      let printer_steps = ref max_steps in
  23. +      let printer_steps = ref (unopt 0 max_steps) in
  24.  
  25.        let rec tree_of_val depth obj ty =
  26.          decr printer_steps;
  27. -        if !printer_steps < 0 || depth < 0 then Oval_ellipsis
  28. +        if (max_steps <> None && !printer_steps < 0) ||
  29. +           (max_depth <> None && depth < 0) then Oval_ellipsis
  30.          else begin
  31.          try
  32.            find_printer env ty obj
  33. @@ -193,7 +196,8 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
  34.                    Some x -> x
  35.                  | None ->
  36.                      let rec tree_of_conses tree_list obj =
  37. -                      if !printer_steps < 0 || depth < 0 then
  38. +                      if (max_steps <> None && !printer_steps < 0) ||
  39. +                         (max_depth <> None && depth < 0) then
  40.                          Oval_ellipsis :: tree_list
  41.                        else if O.is_block obj then
  42.                          let tree =
  43. @@ -213,7 +217,8 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
  44.                    Some x -> x
  45.                  | None ->
  46.                      let rec tree_of_items tree_list i =
  47. -                      if !printer_steps < 0 || depth < 0 then
  48. +                      if (max_steps <> None && !printer_steps < 0) ||
  49. +                         (max_depth <> None && depth < 0) then
  50.                          Oval_ellipsis :: tree_list
  51.                        else if i < length then
  52.                          let tree =
  53. @@ -370,6 +375,6 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
  54.            Some x -> x
  55.          | None -> outval_of_untyped_exception bucket
  56.  
  57. -    in tree_of_val max_depth obj ty
  58. +    in tree_of_val (unopt 0 max_depth) obj ty
  59.  
  60.  end
  61. diff --git a/toplevel/genprintval.mli b/toplevel/genprintval.mli
  62. index 8ddf079..d6b6948 100644
  63. --- a/toplevel/genprintval.mli
  64. +++ b/toplevel/genprintval.mli
  65. @@ -41,7 +41,7 @@ module type S =
  66.      val remove_printer : Path.t -> unit
  67.      val outval_of_untyped_exception : t -> Outcometree.out_value
  68.      val outval_of_value :
  69. -          int -> int ->
  70. +          int option -> int option ->
  71.            (int -> t -> Types.type_expr -> Outcometree.out_value option) ->
  72.            Env.t -> t -> type_expr -> Outcometree.out_value
  73.    end
  74. diff --git a/toplevel/opttopdirs.ml b/toplevel/opttopdirs.ml
  75. index 9741d17..4879fa1 100644
  76. --- a/toplevel/opttopdirs.ml
  77. +++ b/toplevel/opttopdirs.ml
  78. @@ -170,6 +170,14 @@ let _ =
  79.               (Directive_int(fun n -> max_printer_depth := n));
  80.    Hashtbl.add directive_table "print_length"
  81.               (Directive_int(fun n -> max_printer_steps := n));
  82. +  Hashtbl.add directive_table "print_all"
  83. +             (Directive_none(fun () -> print_kind := `All));
  84. +  Hashtbl.add directive_table "print_wide"
  85. +             (Directive_none(fun () -> print_kind := `Wide));
  86. +  Hashtbl.add directive_table "print_deep"
  87. +             (Directive_none(fun () -> print_kind := `Deep));
  88. +  Hashtbl.add directive_table "print_default"
  89. +             (Directive_none(fun () -> print_kind := `Default));
  90.  
  91.  (* Set various compiler flags *)
  92.  
  93. diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
  94. index a679f8c..7a99c16 100644
  95. --- a/toplevel/topdirs.ml
  96. +++ b/toplevel/topdirs.ml
  97. @@ -321,6 +321,14 @@ let _ =
  98.               (Directive_int(fun n -> max_printer_depth := n));
  99.    Hashtbl.add directive_table "print_length"
  100.               (Directive_int(fun n -> max_printer_steps := n));
  101. +  Hashtbl.add directive_table "print_all"
  102. +             (Directive_none(fun () -> print_kind := `All));
  103. +  Hashtbl.add directive_table "print_wide"
  104. +             (Directive_none(fun () -> print_kind := `Wide));
  105. +  Hashtbl.add directive_table "print_deep"
  106. +             (Directive_none(fun () -> print_kind := `Deep));
  107. +  Hashtbl.add directive_table "print_default"
  108. +             (Directive_none(fun () -> print_kind := `Default));
  109.  
  110.  (* Set various compiler flags *)
  111.  
  112. diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
  113. index 636fe15..1f12792 100644
  114. --- a/toplevel/toploop.ml
  115. +++ b/toplevel/toploop.ml
  116. @@ -74,6 +74,17 @@ module Printer = Genprintval.Make(Obj)(EvalPath)
  117.  let max_printer_depth = ref 100
  118.  let max_printer_steps = ref 300
  119.  
  120. +let print_kind = ref (`Default : [`Default | `Wide | `Deep | `All ])
  121. +
  122. +let get_max_printer_depth () =
  123. +  match !print_kind with
  124. +  | `Default | `Wide -> Some !max_printer_depth
  125. +  | `Deep | `All -> None
  126. +let get_max_printer_steps () =
  127. +  match !print_kind with
  128. +  | `Default | `Deep -> Some !max_printer_steps
  129. +  | `Wide | `All -> None
  130. +
  131.  let print_out_value = Oprint.out_value
  132.  let print_out_type = Oprint.out_type
  133.  let print_out_class_type = Oprint.out_class_type
  134. @@ -85,7 +96,7 @@ let print_out_phrase = Oprint.out_phrase
  135.  let print_untyped_exception ppf obj =
  136.    !print_out_value ppf (Printer.outval_of_untyped_exception obj)
  137.  let outval_of_value env obj ty =
  138. -  Printer.outval_of_value !max_printer_steps !max_printer_depth
  139. +  Printer.outval_of_value (get_max_printer_steps ()) (get_max_printer_depth ())
  140.      (fun _ _ _ -> None) env obj ty
  141.  let print_value env obj ppf ty =
  142.    !print_out_value ppf (outval_of_value env obj ty)
  143. diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli
  144. index da607de..4b3acde 100644
  145. --- a/toplevel/toploop.mli
  146. +++ b/toplevel/toploop.mli
  147. @@ -74,6 +74,7 @@ val remove_printer : Path.t -> unit
  148.  
  149.  val max_printer_depth: int ref
  150.  val max_printer_steps: int ref
  151. +val print_kind: [`Default | `Wide | `Deep | `All ] ref
  152.  
  153.  (* Hooks for external parsers and printers *)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top