Source

spotlib / lib / xobj.ml

open Base
open Obj

type tag = [ `abstract
           | `closure
           | `custom
           | `final
           | `forward
           | `infix
           | `int
           | `lazy_
           | `noscan
           | `object_
           | `out_of_heap
           | `string
           | `unaligned
           | `unknown of int 
           ]

let parse_tag t = 
  if t = int_tag              then `int
  else if t = string_tag      then `string
  else if t = lazy_tag        then `lazy_
  else if t = closure_tag     then `closure
  else if t = object_tag      then `object_
  else if t = infix_tag       then `infix
  else if t = forward_tag     then `forward
  else if t = no_scan_tag     then `noscan
  else if t = abstract_tag    then `abstract
  else if t = custom_tag      then `custom
  else if t = final_tag       then `final
  else if t = out_of_heap_tag then `out_of_heap
  else if t = unaligned_tag   then `unaligned
  else `unknown t

let tag_name = function
  | `int ->         "int"
  | `string ->      "string"
  | `lazy_ ->       "lazy"
  | `closure ->     "closure"
  | `object_ ->     "object"
  | `infix ->       "infix"
  | `forward ->     "forward"
  | `noscan ->      "noscan"
  | `abstract ->    "abstract"
  | `custom ->      "custom"
  | `final ->       "final"
  | `out_of_heap -> "out_of_heap"
  | `unaligned ->   "unaligned"
  | `unknown x ->   string_of_int x 

let dump o = 
  let open Format in
  let rec dump ppf o =
    let t = parse_tag & tag o in
    match t with
    | `int -> fprintf ppf "%d" & obj o
    | `double -> fprintf ppf "%.4f" & obj o
    | `string -> fprintf ppf "%S" & obj o
    | _ -> 
       fprintf ppf "[%s @[" & tag_name t;
       let s = size o in
       for i = 0 to s - 1 do
         dump ppf (field o i);
         fprintf ppf "@ "
       done;
       fprintf ppf "@]]"
  in
  eprintf "%a@." dump o