let print_class_data data =
let id x = x in
let from_list lst = Format.sprintf "[%s]" (String.concat ", " lst) in
let table_printer tbl name stringer =
let printer p s i = Format.sprintf "\t%s : %s => %s\n" p s (stringer i) in
print_string (name ^ ":\n");
print_lookup_table tbl printer in
let map_printer map name stringer =
let printer k i = Format.sprintf "\t%s => %s\n" k (stringer i) in
print_string (name ^ ":\n");
print_lookup_map map printer in
let func_list = function
| [one] -> full_signature_string one
| list -> let sigs = List.map (fun f -> "\n\t\t" ^ (full_signature_string f)) list in
String.concat "" sigs in
let func_of_list funcs =
let sigs = List.map (fun f -> "\n\t\t" ^ f.inklass ^ "->" ^ (full_signature_string f)) funcs in
String.concat "" sigs in
let class_printer cdef =
let rec count sect = function
| (where, members)::_ when where = sect -> List.length members
| _::rest -> count sect rest
| [] -> raise(Failure("The impossible happened -- searching for a section that should exist doesn't exist.")) in
let vars = klass_to_variables cdef in
let funcs = klass_to_functions cdef in
let format = ""^^"from %s: M(%d/%d/%d) F(%d/%d/%d) R(%d) M(%d)" in
let parent = match cdef.klass with
| "Object" -> "----"
| _ -> klass_to_parent cdef in
Format.sprintf format parent
(count Privates funcs) (count Protects funcs) (count Publics funcs)
(count Privates vars) (count Protects vars) (count Publics vars)
(count Refines funcs) (count Mains funcs) in
let print_list list =
let rec list_printer spaces endl space = function
| [] -> if endl then () else print_newline ()
| list when spaces = 0 -> print_string "\t"; list_printer 8 false false list
| list when spaces > 60 -> print_newline (); list_printer 0 true false list
| item::rest ->
if space then print_string " " else ();
print_string item;
list_printer (spaces + String.length item) false true rest in
list_printer 0 true false list in
Printf.printf "Types:\n";
print_list (StringSet.elements data.known);
print_newline ();
map_printer data.classes "Classes" class_printer;
print_newline ();
map_printer data.parents "Parents" id;
print_newline ();
map_printer data.children "Children" from_list;
print_newline ();
map_printer data.ancestors "Ancestors" from_list;
print_newline ();
table_printer data.distance "Distance" string_of_int;
print_newline ();
table_printer data.variables "Variables" (fun (sect, t) -> Format.sprintf "%s %s" (section_string sect) t);
print_newline ();
table_printer data.methods "Methods" func_list;
print_newline ();
table_printer data.refines "Refines" func_list;
print_newline ();
map_printer data.mains "Mains" full_signature_string;
print_newline ();
table_printer data.refinable "Refinable" func_of_list