- let rec aux (Node l as orig) =
- let j = !c in
- Pp.node ("node"^string_of_int j) ~attrs:(["shape","record";
- "label",String.concat "|"
- (HExtlib.list_mapi
- (fun (x,_) i -> "<f"^string_of_int i^">" ^ T.pp x)
- l)] @ if orig == where then ["style","rounded"] else []) fmt;
- ignore(HExtlib.list_mapi
- (fun (_,t) i ->
- incr c;
- let k = !c in
- Pp.edge
- ("node"^string_of_int j^":f"^string_of_int i)
- ("node"^string_of_int k) fmt;
- aux t)
- l)
+ let skip = Node (Obj.magic (),[]) in
+ let rec aux_t = function
+ | Nil ->
+ Pp.node ("node"^string_of_int !c) ~attrs:["shape","point"] fmt
+ | Node (s,l) ->
+ let j = !c in
+ Pp.node ("node"^string_of_int j) ~attrs:["shape","record";
+ "label",String.concat "|"
+ (HExtlib.list_mapi
+ (fun (x,_) i -> "<f"^string_of_int i^"> " ^ ppg x)
+ l)] fmt;
+ pps s ("node"^string_of_int j) fmt;
+ ignore(HExtlib.list_mapi
+ (fun (_,t) i -> if t != skip then begin
+ incr c;
+ let k = !c in
+ Pp.edge
+ ("node"^string_of_int j^":f"^string_of_int i)
+ ("node"^string_of_int k) fmt;
+ aux_t t end)
+ l)
+ in
+ let rec aux pos =
+ match pos with
+ | Top -> ()
+ | Ctx(ctx,s,l,x,r) ->
+ let t = Node(s,(List.rev l)@[x,skip]@r) in
+ let cur = !c in
+ aux_t t;
+ incr c;
+ if ctx <> Top then
+ Pp.edge
+ ("node"^string_of_int !c)
+ ("node"^string_of_int cur^":f"^string_of_int( List.length l))
+ fmt;
+ aux ctx