Skip to content
This repository
tag: v1147
Fetching contributors…

Cannot retrieve contributors at this time

file 122 lines (113 sloc) 4.188 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
include Obj

(* just a hack to know if we are running in bytecode or in native *)
let native_runtime =
  match Obj.size (Obj.repr (fun x -> x)) with
  | 1 -> false
  | 2 -> true
  | _ -> assert false
let bytecode_runtime = not native_runtime

let buffer = Buffer.create 1000

let rec stringify ?(depth=max_int) t =
  if depth < 0 then
    Buffer.add_char buffer '.'
  else
    let depth = depth - 1 in
    let tag = Obj.tag t in
    if tag = Obj.int_tag then
      Buffer.add_string buffer (string_of_int (Obj.obj t : int))
    else if tag = 0 then (
      Buffer.add_char buffer '(';
      let size = Obj.size t in
      if size <> 0 then (
        stringify ~depth (Obj.field t 0);
        for i = 1 to size - 1 do
          Buffer.add_char buffer ',';
          stringify ~depth (Obj.field t i);
        done
      );
      Buffer.add_char buffer ')';
    )
    else if tag = Obj.lazy_tag then
      Buffer.add_string buffer "<lazy>"
    else if tag = Obj.closure_tag then
      Buffer.add_string buffer "<closure>"
    else if tag = Obj.object_tag then
      Buffer.add_string buffer ("<object " ^ string_of_int (Oo.id (Obj.obj t)) ^ ">" )
    else if tag = Obj.infix_tag then
      Buffer.add_string buffer "<infix>"
    else if tag = Obj.forward_tag then
      Buffer.add_string buffer "<forward>"
    else if tag < Obj.no_scan_tag then (
      Buffer.add_string buffer "Tag";
      Buffer.add_string buffer (string_of_int tag);
      Buffer.add_char buffer '(';
      let size = Obj.size t in
      if size <> 0 then (
        stringify ~depth (Obj.field t 0);
        for i = 1 to size - 1 do
          Buffer.add_char buffer ',';
          stringify ~depth (Obj.field t i);
        done
      );
      Buffer.add_char buffer ')';
    ) else if tag = Obj.no_scan_tag then
      Buffer.add_string buffer "<no_scan_tag>"
    else if tag = Obj.abstract_tag then
      Buffer.add_string buffer "<abstract>"
    else if tag = Obj.string_tag then (
      Buffer.add_char buffer '"';
      let s = Obj.obj t in
      if String.length s <= 200 then
        Buffer.add_string buffer (String.escaped s)
      else (
        Buffer.add_string buffer (String.escaped (String.sub s 0 100));
        Buffer.add_string buffer "...";
        Buffer.add_string buffer (String.escaped (String.sub s (String.length s - 100 - 1) 100));
      );
      Buffer.add_char buffer '"'
    ) else if tag = Obj.double_tag then (
      Buffer.add_string buffer (string_of_float (Obj.obj t))
    ) else if tag = Obj.double_array_tag then (
      Buffer.add_string buffer "[|";
      let t : float array = Obj.obj t in
      let size = Array.length t in
      if size <> 0 then (
        Buffer.add_string buffer (string_of_float t.(0));
        for i = 1 to size - 1 do
          Buffer.add_char buffer ';';
          Buffer.add_string buffer (string_of_float t.(i));
        done;
      );
      Buffer.add_string buffer "|]";
    ) else if tag = Obj.custom_tag then
      Buffer.add_string buffer "<custom>"
    else if tag = Obj.final_tag then
      Buffer.add_string buffer "<final>"
    else if tag = Obj.out_of_heap_tag then
      Buffer.add_string buffer "<out_of_heap>"
    else if tag = Obj.unaligned_tag then
      Buffer.add_string buffer "<unaligned>"
    else
      Buffer.add_string buffer "<UNKNOWN>"

let dump ?depth x =
  stringify ?depth (Obj.repr x);
  let s = Buffer.contents buffer in
  Buffer.reset buffer;
  s

let print ?prefix x =
  match prefix with
  | None -> print_endline (dump x)
  | Some s -> Printf.printf "%s: %s\n%!" s (dump x)
Something went wrong with that request. Please try again.