diff --git a/lib/dot_of_tast.ml b/lib/dot_of_tast.ml
index 77e4e93..1c361f1 100644
--- a/lib/dot_of_tast.ml
+++ b/lib/dot_of_tast.ml
@@ -1,3 +1,55 @@
+(*
+
+   'let' names nets (scoped vars)
+   'fun' names ports (argument vars)
+
+
+
+digraph {
+  compound=true;
+  node [shape=record];
+  edge [decorate=true];
+  rankdir="LR";
+
+  subgraph G {
+    label="let rec fact n = if n = 0 then 1. else float n *. fact (n - 1)";
+
+    cluster=true;
+    labeljust="l";
+    "1.";
+    "if/then/else" [label="{{<1>if|<2>then|<3>else}|<o>}"];
+    "1";
+    "0";
+
+    minus [label="{{<1>|<2>}|<o>-}"];
+
+  float_mult [label="{{<1>|<2>}|<o>*.}"];
+  "float" [label="{<1>|<o>float}"];
+  "(=)" [label="{{<1>|<2>}|<o>=}"];
+  "fun n" [label="{<o>fun|<1>n}"];
+  "factorial" [label="{<1>|<o>factorial}"];
+  
+  
+  "1." -> "if/then/else":2 [label="float"];
+  "fun n":1 -> minus:1 [lhead="cluster_minus" label="int"];
+  "fun n":1 -> "(=)":2 [label="int"];
+  "fun n":1 -> "float":1 [label="int"];
+  "if/then/else" -> "->":o [label="float"];
+  "1" -> minus:2 [lhead="cluster_minus" label="int"];
+  "0" -> "(=)":1 [label="int"];
+  minus:o -> "factorial":1 [label="int"];
+  float_mult:o -> "if/then/else":3 [label="float"];
+  "float":o -> float_mult:1 [label="float"];
+  "(=)":o -> "if/then/else":1 [label="bool"];
+  "factorial":o -> float_mult:2 [label="float"];
+  
+  }
+}
+
+
+   
+ *)
+
 open Merlin_kernel
 open Merlin_utils
 open Ocaml_parsing
@@ -13,59 +65,619 @@ module Log = (val Logs.src_log
                     (Logs.Src.create "dot_of_tast"
                        ~doc:"dot_of_tast.ml logger") : Logs.LOG)
 
-module L = struct
-  let stack = ref []
-  let push l = stack := l :: !stack
-  let peek () = match !stack with [] -> None | x :: _ -> Some x
-  let pop () = match !stack with [] -> () | _ :: xs -> stack := xs
-end
-
 open Graph
 
-module G = struct
-  module EDGE = struct
-    type t = string * Graphviz.DotAttributes.edge list
+module DotAttributes = struct
+  include Graphviz.DotAttributes
 
-    let compare (a, _) (b, _) = String.compare a b
-    let default = ("", [])
-  end
-
-  module VERTEX = struct
-    type t = string * Graphviz.DotAttributes.vertex list
-
-    let compare (a, _) (b, _) = String.compare a b
-    let hash (a, _) = Hashtbl.hash a
-    let equal (a, _) (b, _) = String.equal a b
-  end
-
-  module G = Imperative.Digraph.ConcreteLabeled (VERTEX) (EDGE)
-
-  let vertex_name v =
-    "\"" ^ String.escaped (fst @@ G.V.label v) ^ "\""
-
-  let graph_attributes _ = []
-  let default_vertex_attributes _ = []
-  let vertex_attributes (_label, attr) = attr
-  let default_edge_attributes _ = []
-
-  let edge_attributes (_src, (label, attr), _dst) =
-    if String.equal label "" then attr else `Label label :: attr
-
-  let get_subgraph (_ : G.V.t) :
-      Graphviz.DotAttributes.subgraph option =
-    None
-
-  include G
+  (* the dot spec probably added records after ocamlgraph/src/graphviz.ml was written *)
+  type edge =
+    [ Graphviz.DotAttributes.edge
+    | `HeadportRecord of string
+    | `TailportRecord of string ]
 end
 
-module Dot = Graphviz.Dot (struct
-  include G
-end)
+module Gr = struct
+  open DotAttributes
+
+  module Vertex = struct
+    type t = {
+      name : string;
+      attr : DotAttributes.vertex list;
+      subgraph : DotAttributes.subgraph option;
+    }
+
+    let compare a b = String.compare a.name b.name
+    let hash { name; _ } = Hashtbl.hash name
+    let equal a b = compare a b = 0
+    let label a = a.name
+    let default = { name = ""; attr = []; subgraph = None }
+  end
+
+  module Edge = struct
+    type t = { name : string; attr : DotAttributes.edge list }
+
+    let compare a b = String.compare a.name b.name
+    let default = { name = ""; attr = [] }
+  end
+
+  module G = Imperative.Digraph.ConcreteLabeled (Vertex) (Edge)
+  module B = Builder.I (G)
+  module V = G.V
+  module E = G.E
+
+  type t = G.t * graph list
+
+  let iter_vertex a (b, _) = G.iter_vertex a b
+  let iter_edges_e a (b, _) = G.iter_edges_e a b
+  let add_edge_e (a, _) b = G.add_edge_e a b
+  let vertex_name v = F.str "\"%s\"" (String.escaped (Vertex.label v))
+  let graph_attributes (_g, attr) = attr
+  let default_vertex_attributes _ = [ `Shape `Record ]
+  let vertex_attributes (a : V.t) = a.attr
+  let default_edge_attributes _ = [ `Decorate true ]
+
+  let edge_attributes ((_src, { name; attr; _ }, _dst) : E.t) =
+    if String.equal name "" then attr else `Label name :: attr
+
+  let get_subgraph (v : G.V.t) :
+      Graphviz.DotAttributes.subgraph option =
+    v.subgraph
+
+  let create ?(size = 32) attr = (B.G.create ~size (), attr)
+end
+
+module Dot = struct
+  module X = struct
+    include Gr
+  end
+
+  open Format
+
+  module EN = struct
+    type color = int
+    type color_with_transparency = int32
+
+    let color_to_color_with_transparency color =
+      Int32.add (Int32.shift_left (Int32.of_int color) 8) 0xFFl
+
+    let fprint_color ppf color = fprintf ppf "\"#%06X\"" color
+
+    let fprint_color_with_transparency ppf color =
+      fprintf ppf "\"#%08lX\"" color
+
+    let fprint_string ppf s = fprintf ppf "\"%s\"" s
+    (* let s' = String.escaped s in
+       if s' = s && s <> ""
+       then fprintf ppf "%s" s
+       else fprintf ppf "\"%s\"" s'*)
+
+    let fprint_string_user ppf s =
+      (*  let s = String.escaped s in*)
+      fprintf ppf "\"%s\"" s
+
+    let fprint_htmlstring_user ppf s = fprintf ppf "<%s>" s
+
+    let fprint_square_not_empty printer ppf = function
+      | [] -> ()
+      | l -> fprintf ppf " [%a]" printer l
+
+    type arrow_style =
+      [ `None
+      | `Normal
+      | `Onormal
+      | `Inv
+      | `Dot
+      | `Odot
+      | `Invdot
+      | `Invodot ]
+
+    let fprint_arrow_style ppf = function
+      | `None -> fprintf ppf "none"
+      | `Normal -> fprintf ppf "normal"
+      | `Onormal -> fprintf ppf "onormal"
+      | `Inv -> fprintf ppf "inv"
+      | `Dot -> fprintf ppf "dot"
+      | `Odot -> fprintf ppf "odot"
+      | `Invdot -> fprintf ppf "invdot"
+      | `Invodot -> fprintf ppf "invodot"
+
+    let fprint_dir ppf = function
+      | `TopToBottom -> fprintf ppf "TB"
+      | `BottomToTop -> fprintf ppf "BT"
+      | `LeftToRight -> fprintf ppf "LR"
+      | `RightToLeft -> fprintf ppf "RL"
+
+    type symbseq = COMMA | SEMI
+
+    let fprint_symbseq ppf = function
+      | COMMA -> pp_print_string ppf ","
+      | SEMI -> pp_print_string ppf ";"
+
+    module Attributes = struct
+      module CommonAttributes = struct
+        include Graphviz.CommonAttributes
+        (** Pretty-print. *)
+
+        let fprint_orientation ppf = function
+          | `Portrait -> fprintf ppf "portrait"
+          | `Landscape -> fprintf ppf "landscape"
+
+        let fprint_graph ppf = function
+          | `Center b -> fprintf ppf "center=%i" (if b then 1 else 0)
+          | `Fontcolor a -> fprintf ppf "fontcolor=%a" fprint_color a
+          | `Fontname s -> fprintf ppf "fontname=%a" fprint_string s
+          | `Fontsize i -> fprintf ppf "fontsize=%i" i
+          | `Label s -> fprintf ppf "label=%a" fprint_string_user s
+          | `HtmlLabel s ->
+              fprintf ppf "label=%a" fprint_htmlstring_user s
+          | `Orientation a ->
+              fprintf ppf "orientation=%a" fprint_orientation a
+          | `Page (x, y) -> fprintf ppf "page=\"%f,%f\"" x y
+          | `Pagedir a -> fprintf ppf "pagedir=%a" fprint_dir a
+          | `Size (x, y) -> fprintf ppf "size=\"%f,%f\"" x y
+          | `OrderingOut -> fprintf ppf "ordering=out"
+
+        let fprint_shape ppf = function
+          | `Ellipse -> fprintf ppf "ellipse"
+          | `Box -> fprintf ppf "box"
+          | `Circle -> fprintf ppf "circle"
+          | `Doublecircle -> fprintf ppf "doublecircle"
+          | `Diamond -> fprintf ppf "diamond"
+          | `Plaintext -> fprintf ppf "plaintext"
+          | `Record -> fprintf ppf "record"
+          | `Egg -> fprintf ppf "egg"
+          | `House -> fprintf ppf "house"
+          | `Invhouse -> fprintf ppf "invhouse"
+          | `Trapezium -> fprintf ppf "trapezium"
+          | `Invtrapezium -> fprintf ppf "invtrapezium"
+          | `Triangle -> fprintf ppf "triangle"
+          | `Invtriangle -> fprintf ppf "invtriangle"
+          | `Oval -> fprintf ppf "oval"
+          | `Assembly -> fprintf ppf "assembly"
+          | `Box3d -> fprintf ppf "box3d"
+          | `Cds -> fprintf ppf "cds"
+          | `Component -> fprintf ppf "component"
+          | `Doubleoctagon -> fprintf ppf "doubleoctagon"
+          | `Fivepoverhang -> fprintf ppf "fivepoverhang"
+          | `Folder -> fprintf ppf "folder"
+          | `Insulator -> fprintf ppf "insulator"
+          | `Larrow -> fprintf ppf "larrow"
+          | `Lpromoter -> fprintf ppf "lpromoter"
+          | `Mcircle -> fprintf ppf "mcircle"
+          | `Mdiamond -> fprintf ppf "mdiamond"
+          | `Msquare -> fprintf ppf " msquare"
+          | `Note -> fprintf ppf "note"
+          | `Noverhang -> fprintf ppf "noverhang"
+          | `Parallelogram -> fprintf ppf "parallelogram"
+          | `Primersite -> fprintf ppf "primersite"
+          | `Promoter -> fprintf ppf "promoter"
+          | `Proteasesite -> fprintf ppf "proteasesite"
+          | `Proteinstab -> fprintf ppf "proteinstab"
+          | `Rarrow -> fprintf ppf "rarrow"
+          | `Restrictionsite -> fprintf ppf "restrictionsite"
+          | `Ribosite -> fprintf ppf "ribosite"
+          | `Rnastab -> fprintf ppf "rnastab"
+          | `Rpromoter -> fprintf ppf "rpromoter"
+          | `Signature -> fprintf ppf "signature"
+          | `Star -> fprintf ppf "star"
+          | `Tab -> fprintf ppf "tab"
+          | `Terminator -> fprintf ppf "terminator"
+          | `Threepoverhang -> fprintf ppf "threepoverhang"
+          | `Tripleoctagon -> fprintf ppf "tripleoctagon"
+          | `Underline -> fprintf ppf "underline"
+          | `Utr -> fprintf ppf "utr"
+          | `Polygon (i, f) ->
+              fprintf ppf "polygon, sides=%i, skew=%f" i f
+
+        let rec fprint_string_list ppf = function
+          | [] -> ()
+          | [ hd ] -> fprintf ppf "%s" hd
+          | hd :: tl -> fprintf ppf "%s,%a" hd fprint_string_list tl
+
+        let node_style_str = function
+          | `Rounded -> "rounded"
+          | `Filled -> "filled"
+          | `Solid -> "solid"
+          | `Dashed -> "dashed"
+          | `Dotted -> "dotted"
+          | `Bold -> "bold"
+          | `Invis -> "invis"
+
+        let fprint_style_list sep ppf a =
+          fprintf ppf "style=\"%a\"%a@ " fprint_string_list
+            (List.map node_style_str a)
+            fprint_symbseq sep
+
+        let fprint_vertex ppf = function
+          | `Color a -> fprintf ppf "color=%a" fprint_color a
+          | `ColorWithTransparency a ->
+              fprintf ppf "color=%a" fprint_color_with_transparency a
+          | `Fontcolor a -> fprintf ppf "fontcolor=%a" fprint_color a
+          | `Fontname s -> fprintf ppf "fontname=%a" fprint_string s
+          | `Fontsize i -> fprintf ppf "fontsize=%i" i
+          | `Height f -> fprintf ppf "height=%f" f
+          | `Label s -> fprintf ppf "label=%a" fprint_string_user s
+          | `HtmlLabel s ->
+              fprintf ppf "label=%a" fprint_htmlstring_user s
+          | `Orientation f -> fprintf ppf "orientation=%f" f
+          | `Penwidth f -> fprintf ppf "penwidth=%f" f
+          | `Peripheries i -> fprintf ppf "peripheries=%i" i
+          | `Regular b -> fprintf ppf "regular=%b" b
+          | `Shape a -> fprintf ppf "shape=%a" fprint_shape a
+          | `Style _ -> assert false
+          | `Width f -> fprintf ppf "width=%f" f
+
+        let fprint_arrow_direction ppf = function
+          | `Forward -> fprintf ppf "forward"
+          | `Back -> fprintf ppf "back"
+          | `Both -> fprintf ppf "both"
+          | `None -> fprintf ppf "none"
+
+        let fprint_edge ppf = function
+          | `Color a -> fprintf ppf "color=%a" fprint_color a
+          | `ColorWithTransparency a ->
+              fprintf ppf "color=%a" fprint_color_with_transparency a
+          | `Decorate b -> fprintf ppf "decorate=%b" b
+          | `Dir a -> fprintf ppf "dir=%a" fprint_arrow_direction a
+          | `Fontcolor a -> fprintf ppf "fontcolor=%a" fprint_color a
+          | `Fontname s -> fprintf ppf "fontname=%a" fprint_string s
+          | `Fontsize i -> fprintf ppf "fontsize=%i" i
+          | `Label s -> fprintf ppf "label=%a" fprint_string_user s
+          | `HtmlLabel s ->
+              fprintf ppf "label=%a" fprint_htmlstring_user s
+          | `Labelfontcolor a ->
+              fprintf ppf "labelfontcolor=%a" fprint_color a
+          | `Labelfontname s -> fprintf ppf "labelfontname=\"%s\"" s
+          (* (String.escaped s) *)
+          | `Labelfontsize i -> fprintf ppf "labelfontsize=%i" i
+          | `Penwidth f -> fprintf ppf "penwidth=%f" f
+          | `Style _ -> assert false
+
+        let rec filter_style al sl l =
+          match l with
+          | [] -> (al, sl)
+          | `Style s :: l -> filter_style al (s :: sl) l
+          | a :: l -> filter_style (a :: al) sl l
+
+        (** [fprint_graph_attribute printer ppf list] pretty prints a list of
+      attributes on the formatter [ppf], using the printer [printer] for
+      each attribute.  The list appears between brackets and attributes
+      are speparated by ",".  If the list is empty, nothing is printed. *)
+        let fprint_attributes fprint_style_list fprint_attribute sep
+            ppf list =
+          if list <> [] then (
+            let list, styles = filter_style [] [] list in
+            let rec fprint_attributes_rec ppf = function
+              | [] -> ()
+              | hd :: tl ->
+                  fprintf ppf "%a%a@ " fprint_attribute hd
+                    fprint_symbseq sep;
+                  fprint_attributes_rec ppf tl
+            in
+            fprintf ppf "@[<hov>%a" fprint_attributes_rec list;
+            if styles <> [] then fprint_style_list sep ppf styles;
+            fprintf ppf "@]")
+      end
+
+      include DotAttributes
+      (** {4 Pretty-print of attributes} *)
+
+      let rec fprint_string_list ppf = function
+        | [] -> ()
+        | [ hd ] -> fprintf ppf "%s" hd
+        | hd :: tl -> fprintf ppf "%s,%a" hd fprint_string_list tl
+
+      let fprint_ratio ppf = function
+        | `Float f -> fprintf ppf "%f" f
+        | `Fill -> fprintf ppf "fill"
+        | `Compress -> fprintf ppf "compress"
+        | `Auto -> fprintf ppf "auto"
+
+      let fprint_graph ppf = function
+        | #CommonAttributes.graph as att ->
+            CommonAttributes.fprint_graph ppf att
+        | `Bgcolor a -> fprintf ppf "bgcolor=%a" fprint_color a
+        | `BgcolorWithTransparency a ->
+            fprintf ppf "bgcolor=%a" fprint_color_with_transparency a
+        | `Comment s -> fprintf ppf "comment=%a" fprint_string s
+        | `Concentrate b -> fprintf ppf "concentrate=%b" b
+        | `Fontpath s -> fprintf ppf "fontpath=%a" fprint_string s
+        | `Layers s -> fprintf ppf "layers=%a" fprint_string_list s
+        | `Margin f -> fprintf ppf "margin=%f" f
+        | `Mclimit f -> fprintf ppf "mclimit=%f" f
+        | `Nodesep f -> fprintf ppf "nodesep=%f" f
+        | `Nslimit i -> fprintf ppf "nslimit=%i" i
+        | `Nslimit1 i -> fprintf ppf "nslimit1=%i" i
+        | `Ranksep f -> fprintf ppf "ranksep=%f" f
+        | `Quantum f -> fprintf ppf "quantum=%f" f
+        | `Rankdir a -> fprintf ppf "rankdir=%a" fprint_dir a
+        | `Ratio a -> fprintf ppf "ratio=%a" fprint_ratio a
+        | `Samplepoints i -> fprintf ppf "samplepoints=%i" i
+        | `Url s -> fprintf ppf "URL=\"%s\"" s (*(String.escaped s)*)
+
+      let fprint_vertex ppf = function
+        | #CommonAttributes.vertex as att ->
+            CommonAttributes.fprint_vertex ppf att
+        | `Comment s -> fprintf ppf "comment=%a" fprint_string s
+        | `Distortion f -> fprintf ppf "distortion=%f" f
+        | `Fillcolor a -> fprintf ppf "fillcolor=%a" fprint_color a
+        | `FillcolorWithTransparency a ->
+            fprintf ppf "fillcolor=%a" fprint_color_with_transparency
+              a
+        | `Fixedsize b -> fprintf ppf "fixedsize=%b" b
+        | `Layer s -> fprintf ppf "layer=%a" fprint_string s
+        | `Url s -> fprintf ppf "URL=\"%s\"" s (*(String.escaped s)*)
+        | `Z f -> fprintf ppf "z=%f" f
+
+      let fprint_port ppf = function
+        | `N -> fprintf ppf "n"
+        | `NE -> fprintf ppf "ne"
+        | `E -> fprintf ppf "e"
+        | `SE -> fprintf ppf "se"
+        | `S -> fprintf ppf "s"
+        | `SW -> fprintf ppf "sw"
+        | `W -> fprintf ppf "w"
+        | `NW -> fprintf ppf "nw"
+
+      let fprint_edge ppf = function
+        | #CommonAttributes.edge as att ->
+            CommonAttributes.fprint_edge ppf att
+        | `Arrowhead a ->
+            fprintf ppf "arrowhead=%a" fprint_arrow_style a
+        | `Arrowsize f -> fprintf ppf "arrowsize=%f" f
+        | `Arrowtail a ->
+            fprintf ppf "arrowtail=%a" fprint_arrow_style a
+        | `Comment s -> fprintf ppf "comment=%a" fprint_string s
+        | `Constraint b -> fprintf ppf "constraint=%b" b
+        | `Headlabel s -> fprintf ppf "headlabel=%a" fprint_string s
+        | `Headport a -> fprintf ppf "headport=%a" fprint_port a
+        | `HeadportRecord a ->
+            fprintf ppf "headport=%a" fprint_string a
+        | `Headurl s -> fprintf ppf "headURL=%a" fprint_string s
+        | `Labelangle f -> fprintf ppf "labelangle=%f" f
+        | `Labeldistance f -> fprintf ppf "labeldistance=%f" f
+        | `Labelfloat b -> fprintf ppf "labelfloat=%b" b
+        | `Layer s -> fprintf ppf "layer=%a" fprint_string s
+        | `Minlen i -> fprintf ppf "minlen=%i" i
+        | `Samehead s -> fprintf ppf "samehead=%a" fprint_string s
+        | `Sametail s -> fprintf ppf "sametail=%a" fprint_string s
+        | `Taillabel s -> fprintf ppf "taillabel=%a" fprint_string s
+        | `Tailport a -> fprintf ppf "tailport=%a" fprint_port a
+        | `TailportRecord a ->
+            fprintf ppf "tailport=%a" fprint_string a
+        | `Tailurl s -> fprintf ppf "tailURL=%a" fprint_string s
+        | `Weight i -> fprintf ppf "weight=%i" i
+
+      let fprint_vertex_list =
+        CommonAttributes.fprint_attributes
+          CommonAttributes.fprint_style_list fprint_vertex
+
+      let fprint_edge_list =
+        CommonAttributes.fprint_attributes
+          CommonAttributes.fprint_style_list fprint_edge
+    end
+
+    let name = "dot"
+    let opening = "digraph"
+    let edge_arrow = "->"
+  end
+
+  open Format
+  (** {3 Common attributes} *)
+
+  type color = int
+  type color_with_transparency = int32
+
+  let color_to_color_with_transparency color =
+    Int32.add (Int32.shift_left (Int32.of_int color) 8) 0xFFl
+
+  let fprint_color ppf color = fprintf ppf "\"#%06X\"" color
+
+  let fprint_color_with_transparency ppf color =
+    fprintf ppf "\"#%08lX\"" color
+
+  let fprint_string ppf s = fprintf ppf "\"%s\"" s
+  (* let s' = String.escaped s in
+     if s' = s && s <> ""
+     then fprintf ppf "%s" s
+     else fprintf ppf "\"%s\"" s'*)
+
+  let fprint_string_user ppf s =
+    (*  let s = String.escaped s in*)
+    fprintf ppf "\"%s\"" s
+
+  let fprint_htmlstring_user ppf s = fprintf ppf "<%s>" s
+
+  let fprint_square_not_empty printer ppf = function
+    | [] -> ()
+    | l -> fprintf ppf " [%a]" printer l
+
+  type arrow_style =
+    [ `None
+    | `Normal
+    | `Onormal
+    | `Inv
+    | `Dot
+    | `Odot
+    | `Invdot
+    | `Invodot ]
+
+  let fprint_arrow_style ppf = function
+    | `None -> fprintf ppf "none"
+    | `Normal -> fprintf ppf "normal"
+    | `Onormal -> fprintf ppf "onormal"
+    | `Inv -> fprintf ppf "inv"
+    | `Dot -> fprintf ppf "dot"
+    | `Odot -> fprintf ppf "odot"
+    | `Invdot -> fprintf ppf "invdot"
+    | `Invodot -> fprintf ppf "invodot"
+
+  let fprint_dir ppf = function
+    | `TopToBottom -> fprintf ppf "TB"
+    | `BottomToTop -> fprintf ppf "BT"
+    | `LeftToRight -> fprintf ppf "LR"
+    | `RightToLeft -> fprintf ppf "RL"
+
+  type symbseq = COMMA | SEMI
+
+  let fprint_symbseq ppf = function
+    | COMMA -> pp_print_string ppf ","
+    | SEMI -> pp_print_string ppf ";"
+
+  (* had to copy out of ocamlgraph/src/graphviz.ml because people don't make shit extensible *)
+  let command = ref EN.name
+  let set_command cmd = command := cmd
+
+  exception Error of string
+
+  let handle_error f arg =
+    try f arg
+    with Error msg ->
+      Printf.eprintf "%s: %s failure\n   %s\n" Sys.argv.(0) EN.name
+        msg;
+      flush stderr;
+      exit 2
+
+  (** [fprint_graph_attributes ppf list] pretty prints a list of
+      graph attributes on the formatter [ppf].  Attributes are separated
+      by a ";". *)
+  let fprint_graph_attributes ppf list =
+    List.iter
+      (function
+        | att -> fprintf ppf "%a;@ " EN.Attributes.fprint_graph att)
+      list
+
+  (** [fprint_graph ppf graph] pretty prints the graph [graph] in
+      the CGL language on the formatter [ppf]. *)
+  let fprint_graph ppf graph =
+    let module SG = Map.Make (String) in
+    let subgraphs = ref SG.empty in
+
+    (* Printing nodes. *)
+    let print_nodes ppf =
+      let default_node_attributes =
+        X.default_vertex_attributes graph
+      in
+      if default_node_attributes <> [] then
+        fprintf ppf "node%a;@ "
+          (fprint_square_not_empty
+             (EN.Attributes.fprint_vertex_list COMMA))
+          default_node_attributes;
+
+      X.iter_vertex
+        (function
+          | node ->
+              (match X.get_subgraph node with
+              | None -> ()
+              | Some sg ->
+                  let sg, nodes =
+                    if SG.mem sg.EN.Attributes.sg_name !subgraphs then
+                      SG.find sg.EN.Attributes.sg_name !subgraphs
+                    else (sg, [])
+                  in
+                  subgraphs :=
+                    SG.add sg.EN.Attributes.sg_name
+                      (sg, node :: nodes)
+                      !subgraphs);
+              fprintf ppf "%s%a;@ " (X.vertex_name node)
+                (fprint_square_not_empty
+                   (EN.Attributes.fprint_vertex_list COMMA))
+                (X.vertex_attributes node))
+        graph
+    in
+
+    (* Printing subgraphs *)
+    let rec print_nested_subgraphs ppf = function
+      | [] -> () (* no more work to do, so terminate *)
+      | name :: worklist ->
+          let sg, nodes = SG.find name !subgraphs in
+          let children =
+            SG.filter
+              (fun _ (sg, _) ->
+                sg.EN.Attributes.sg_parent = Some name)
+              !subgraphs
+          in
+          fprintf ppf "@[<v 2>subgraph cluster_%s { %a%t@ %t };@]@\n"
+            name
+            (EN.Attributes.fprint_vertex_list SEMI)
+            sg.EN.Attributes.sg_attributes
+            (fun ppf ->
+              List.iter
+                (fun n -> fprintf ppf "%s;" (X.vertex_name n))
+                nodes)
+            (fun ppf ->
+              print_nested_subgraphs ppf
+                (List.map fst (SG.bindings children)));
+
+          print_nested_subgraphs ppf worklist
+    in
+
+    let print_subgraphs ppf =
+      let root_worklist =
+        SG.filter
+          (fun _ (sg, _) -> sg.EN.Attributes.sg_parent = None)
+          !subgraphs
+      in
+      print_nested_subgraphs ppf
+        (List.map fst (SG.bindings root_worklist))
+    in
+
+    (* Printing edges *)
+    let print_edges ppf =
+      let default_edge_attributes = X.default_edge_attributes graph in
+      if default_edge_attributes <> [] then
+        fprintf ppf "edge%a;@ "
+          (fprint_square_not_empty
+             (EN.Attributes.fprint_edge_list COMMA))
+          default_edge_attributes;
+
+      X.iter_edges_e
+        (function
+          | edge ->
+              fprintf ppf "%s %s %s%a;@ "
+                (X.vertex_name (X.E.src edge))
+                EN.edge_arrow
+                (X.vertex_name (X.E.dst edge))
+                (fprint_square_not_empty
+                   (EN.Attributes.fprint_edge_list COMMA))
+                (X.edge_attributes edge))
+        graph
+    in
+
+    fprintf ppf "@[<v>%s G {@ @[<v 2>  %a" EN.opening
+      fprint_graph_attributes
+      (X.graph_attributes graph);
+    fprintf ppf "%t@ " print_nodes;
+    fprintf ppf "%t@ " print_subgraphs;
+    fprintf ppf "%t@ " print_edges;
+    fprintf ppf "@]}@;@]"
+
+  (** [output_graph oc graph] pretty prints the graph [graph] in the dot
+      language on the channel [oc]. *)
+  let output_graph oc graph =
+    let ppf = formatter_of_out_channel oc in
+    fprint_graph ppf graph;
+    pp_print_flush ppf ()
+end
+
+module Pmapper = struct
+  type t = Ast_mapper.mapper
+
+  let default = Ast_mapper.default_mapper
+
+  let remove_attributes : t =
+    { default with attributes = (fun _m _alist -> []) }
+end
 
 let str_of_exp (exp : Typedtree.expression) =
-  Fmt.str "%a" Pprintast.expression (Untypeast.untype_expression exp)
+  Fmt.str "%a" Pprintast.expression
+    Pmapper.(
+      remove_attributes.expr remove_attributes
+        (Untypeast.untype_expression exp))
 
-let str_of_ident (ident : Ident.t) = Ident.name ident
+let str_of_ident = Ident.name
+(*let unique_str_of_ident = Ident.unique_toplevel_name*)
 
 let pp_value_binding_list ppf (vbl : Typedtree.value_binding list) =
   Fmt.pf ppf "%a"
@@ -73,57 +685,130 @@ let pp_value_binding_list ppf (vbl : Typedtree.value_binding list) =
        (Fmt.list (fun ppf (ident, _loc, _ty) -> Ident.print ppf ident)))
     (Typedtree.let_bound_idents_full vbl)
 
-let str_of_primary_value (exp : Typedtree.expression) =
+let vertex_of_primary_value (exp : Typedtree.expression) : Gr.Vertex.t
+    =
   match exp.exp_desc with
-  | Texp_ident _ | Texp_constant _ -> str_of_exp exp
-  | Texp_apply (exp, _) -> str_of_exp exp
-  | Texp_function { param; _ } ->
-      Fmt.str "fun %s" (str_of_ident param)
-  | Texp_let (_, vbl, _) -> Fmt.str "let %a" pp_value_binding_list vbl
-  | Texp_ifthenelse (_, _, Some _) -> Fmt.str "if/then/else"
-  | Texp_ifthenelse (_, _, None) -> Fmt.str "if/then"
-  | _ -> "????"
+  | Texp_ident _ ->
+      {
+        name = str_of_exp exp;
+        attr = [ `Label (F.str "%s" (str_of_exp exp)) ];
+        subgraph = None;
+      }
+  | Texp_constant _ | Texp_variant _ ->
+      { Gr.Vertex.default with name = str_of_exp exp }
+  | Texp_apply (exp, args) ->
+      let cnt = ref 0 in
+      {
+        Gr.Vertex.default with
+        name = str_of_exp exp;
+        attr =
+          [
+            `Label
+              (F.str "{{%a}|<o>%s}"
+                 (F.list
+                    ~sep:(fun ppf () -> F.string ppf "|")
+                    (fun ppf arg_list ->
+                      match arg_list with
+                      | Asttypes.Nolabel, _exp ->
+                          F.pf ppf "<%d>" !cnt;
+                          cnt := !cnt + 1
+                      | Asttypes.(Labelled s | Optional s), _exp ->
+                          F.pf ppf "<%s>" s))
+                 args (str_of_exp exp));
+          ];
+      }
+  | Texp_function { arg_label = _; param; cases = _; partial = _ } ->
+      {
+        Gr.Vertex.default with
+        name = Fmt.str "fun %s" (str_of_ident param);
+      }
+  | Texp_let (_, vbl, _) ->
+      {
+        Gr.Vertex.default with
+        name = Fmt.str "let %a" pp_value_binding_list vbl;
+      }
+  | Texp_ifthenelse (_, _, Some _) ->
+      {
+        Gr.Vertex.default with
+        (* TODO make unique (with loc?) *)
+        name = "if/then/else";
+        attr = [ `Label "{{<1>if|<2>then|<3>else}|<o>}" ];
+      }
+  | Texp_ifthenelse (_, _, None) ->
+      {
+        Gr.Vertex.default with
+        name = Fmt.str "if/then";
+        attr = [ `Label "{{<1>if|<2>then}|<o>}" ];
+      }
+  | _ ->
+      {
+        Gr.Vertex.default with
+        name = Fmt.str "???? (%s)" (str_of_exp exp);
+      }
 
-let graph_of_impl (s : Typedtree.structure) : G.t =
-  let g = G.create () in
+let graph_of_impl (s : Typedtree.structure) : Gr.t =
+  let g = Gr.create [ `Rankdir `LeftToRight ] in
+  let sdst : (Gr.V.t * int) Stack.t = Stack.create () in
   let iterator =
     {
       Tast_iterator.default_iterator with
       expr =
         (fun iter exp ->
-          match exp.exp_desc with
-          | Texp_ident _ | Texp_constant _ | Texp_apply _
-          | Texp_function _ | Texp_let _ | Texp_ifthenelse _ -> (
-              let src = str_of_primary_value exp in
-              Log.debug (fun m -> m "src: %s" src);
-              L.push (F.str "%s" src);
-              (match exp.exp_desc with
-              | Texp_apply (_exp, list) ->
-                  (* Tast_iterator.default_iterator.expr iter exp *)
-                  (* skip _exp *)
-                  List.iter
-                    (fun (_, o) -> Option.iter (iter.expr iter) o)
-                    list
-              | _ -> Tast_iterator.default_iterator.expr iter exp);
-              L.pop ();
-              match L.peek () with
-              | Some dst ->
-                  Log.debug (fun m -> m "G.add_edge %s %s" src dst);
-                  G.add_edge_e g ((src, []), ("", []), (dst, []))
-              | None -> ())
+          let src = vertex_of_primary_value exp in
+          let srcport = "<o>" in
+          Log.debug (fun m -> m "src: %s" (Gr.Vertex.label src));
+          (match exp.exp_desc with
+          | Texp_apply (_exp, list) ->
+              (* Tast_iterator.default_iterator.expr iter exp *)
+              (* skip _exp *)
+              List.fold_left
+                (fun i (arg_label, expopt) ->
+                  Option.iter
+                    (fun ee ->
+                      Stack.push (src, i) sdst;
+                      iter.expr iter ee;
+                      Stack.pop sdst |> ignore)
+                    expopt;
+                  match arg_label with
+                  | Asttypes.Nolabel -> i + 1
+                  | _ -> i)
+                0 list
+              |> ignore
           | _ ->
+              Stack.push (src, 0) sdst;
+              Tast_iterator.default_iterator.expr iter exp;
+              Stack.pop sdst |> ignore);
+          match Stack.top_opt sdst with
+          | Some (dst, dstport) ->
+              Log.debug (fun m ->
+                  m "G.add_edge %s:%s %s:%s" (Gr.Vertex.label src)
+                    srcport (Gr.Vertex.label dst) (F.str "%d" dstport));
+              Gr.add_edge_e g
+                ( src,
+                  Gr.Edge.
+                    {
+                      name = "";
+                      attr =
+                        [
+                          `HeadportRecord (F.str "%d" dstport);
+                          `TailportRecord srcport;
+                        ];
+                    },
+                  dst )
+          | None -> ())
+        (*
               Tast_iterator.default_iterator.expr iter exp;
               Log.info (fun m ->
                   m "dot_of_impl unknown:@ %a" Pprintast.expression
-                    (Untypeast.untype_expression exp)));
+                    (Untypeast.untype_expression exp))) *);
     }
   in
   iterator.structure iterator s;
   Log.info (fun m ->
-      m "g_of_impl fprint_graph:@ %a" Dot.fprint_graph g);
+      m "g_of_impl Printtyped:@ %a" Printtyped.implementation s);
   g
 
-let merlin_parse str : G.t =
+let merlin_parse str : Gr.t =
   let config, _command_args =
     Mconfig.parse_arguments ~wd:(Sys.getcwd ())
       ~warning:(fun _ -> ())
@@ -145,11 +830,9 @@ let merlin_parse str : G.t =
       Log.info (fun m ->
           m "Printtyped:@ %a" Ocaml_typing.Printtyped.implementation t);
       graph_of_impl t
-  | `Interface _ -> G.create ()
+  | `Interface _ -> Gr.create []
 
 let dot_of_tast ?(fname = "x.dot") str : unit =
   let oc = open_out fname in
-  F.pf
-    (Format.formatter_of_out_channel oc)
-    "%a" Dot.fprint_graph (merlin_parse str);
+  Dot.output_graph oc (merlin_parse str);
   close_out oc
diff --git a/lib/dune b/lib/dune
index 088e10f..c5bb356 100644
--- a/lib/dune
+++ b/lib/dune
@@ -1,4 +1,7 @@
-(library
+(env
+ (dev (flags (:standard -warn-error -A))))
+
+ (library
  (name dot_of_tast)
  (libraries
    logs.fmt