gistfile1.ml

(** Additions to weedingast.ml, bottom **)

let type_decl_members td = match td.type_decl with
  | Class d -> d.class_members
  | Interface i -> i.interface_members

let decl_name decl = match decl.decl with
  | Field f -> f.field_name.Ast.identifier
  | Method m -> m.method_name.Ast.identifier
  | Constructor c -> c.constructor_name.Ast.identifier


(** Digraph Printer for the Weeding-ast *)
(** Digraph.ml **)
open Printf
open Ast
open Weedingast
module WAst = Weedingast

(* Quick-and-dirty graphviz types *)
type arrow_info = { from_node : string; to_node : string }
type node_info = { name : string; shape : string; }
type graph = { graph_type : string; nodes : node list; }
and node = Arrow of arrow_info | Node of node_info | Subgraph of graph

let rec string_of_graph (graph : graph) : string =
  sprintf "%s {\n" graph.graph_type ^
  let print_node (node : node) =
    match node with
      | Node n -> sprintf "\t%s [shape=\"%s\"];\n" n.name n.shape
      | Arrow a -> sprintf "\t%s -> %s" a.from_node a.to_node
      | Subgraph g -> string_of_graph g
  in (List.fold_left (^) "" (List.map print_node graph.nodes)) ^
  "}\n"

(* WAst -> graph *)

let graph_decl (decl : WAst.decl) : node list =
  Node({ name = "member_"^(WAst.decl_name decl); shape = "circle"}) :: []

let graph_type_decl (type_decl : WAst.type_decl) : graph =
  let type_member_nodes =
    List.fold_left (@) [] (List.map graph_decl (WAst.type_decl_members type_decl))
  in
    { graph_type = "subgraph";
      nodes = Node({name = (type_decl_name type_decl); shape = "box";}) :: type_member_nodes; }

let graph_source_file (sf : WAst.source_file) : graph =
  { graph_type = "digraph"; nodes = Subgraph((graph_type_decl sf.source_file_decl)) :: [] }

let gp_program sfs =
  List.iter (fun sf -> print_string (string_of_graph (graph_source_file sf))) sfs