1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
(*
* Graph: generic graph library
* Copyright (C) 2004
* Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles
*
* This software is free software; you can redistribute it and/or
* modify it under the terms of the GNU Library General Public
* License version 2, as published by the Free Software Foundation.
*
* This software is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*
* See the GNU Library General Public License version 2 for more details
* (enclosed in the file LGPL).
*)
(* $Id: gml.mll,v 1.3 2005/07/06 13:20:31 conchon Exp $ *)
{
open Lexing
type value =
| Int of int
| Float of float
| String of string
| List of value_list
and value_list = (string * value) list
}
let space = [' ' '\t' '\r' '\n']+
let ident = ['a'-'z' 'A'-'Z'] ['a'-'z' 'A'-'Z' '0'-'9']*
let digit = ['0'-'9']
let sign = '-' | '+'
let integer = sign? digit+
let mantissa = 'E' sign? digit+
let real = sign? digit* '.' digit* mantissa?
let in_string = [^ '"']*
rule file = parse
| space
{ file lexbuf }
| (ident as key) space
{ let v = value lexbuf in
(key, v) :: file lexbuf }
| eof
{ [] }
| _ as c
{ failwith ("Gml: invalid character " ^ String.make 1 c) }
and value_list = parse
| space
{ value_list lexbuf }
| (ident as key) space
{ let v = value lexbuf in
(key, v) :: value_list lexbuf }
| ']'
{ [] }
| _ as c
{ failwith ("Gml: invalid character " ^ String.make 1 c) }
and value = parse
| integer as i
{ Int (int_of_string i) }
| real as r
{ Float (float_of_string r) }
| '"' (in_string as s) '"'
{ String s }
| '['
{ let l = value_list lexbuf in List l }
| _ as c
{ failwith ("Gml: invalid character " ^ String.make 1 c) }
{
let parse f =
let c = open_in f in
let lb = from_channel c in
let v = file lb in
close_in c;
v
module Parse
(B : Builder.S)
(L : sig val node : value_list -> B.G.V.label
val edge : value_list -> B.G.E.label end) =
struct
let create_graph l =
let nodes = Hashtbl.create 97 in
let g = B.empty () in
(* 1st pass: create the nodes *)
let g =
List.fold_left
(fun g v -> match v with
| "node", List l ->
let n = B.G.V.create (L.node l) in
begin
try
let id = List.assoc "id" l in Hashtbl.add nodes id n
with Not_found ->
()
end;
B.add_vertex g n
| _ ->
g)
g l
in
(* 2nd pass: add the edges *)
List.fold_left
(fun g v -> match v with
| "edge", List l ->
begin try
let source = List.assoc "source" l in
let target = List.assoc "target" l in
let nsource = Hashtbl.find nodes source in
let ntarget = Hashtbl.find nodes target in
let e = B.G.E.create nsource (L.edge l) ntarget in
B.add_edge_e g e
with Not_found ->
g
end
| _ ->
g)
g l
let parse f =
match parse f with
| ["graph", List l] -> create_graph l
| _ -> invalid_arg "Gml.Parse.parse: not a graph file"
end
module Print
(G : sig
module V : sig
type t
val hash : t -> int
val equal : t -> t -> bool
type label
val label : t -> label
end
module E : sig
type t
type label
val src : t -> V.t
val dst : t -> V.t
val label : t -> label
end
type t
val iter_vertex : (V.t -> unit) -> t -> unit
val iter_edges_e : (E.t -> unit) -> t -> unit
end)
(L : sig
val node : G.V.label -> value_list
val edge : G.E.label -> value_list
end) =
struct
open Format
module H = Hashtbl.Make(G.V)
let print fmt g =
let nodes = H.create 97 in
let cpt = ref 0 in
let id n =
try H.find nodes n
with Not_found -> incr cpt; let id = !cpt in H.add nodes n id; id
in
fprintf fmt "@[graph [@\n";
let rec value fmt = function
| Int n -> fprintf fmt "%d" n
| Float f -> fprintf fmt "%f" f
| String s -> fprintf fmt "\"%s\"" s
| List l -> fprintf fmt "[@\n @[%a@]@\n]" value_list l
and value_list fmt = function
| [] -> ()
| [s,v] -> fprintf fmt "%s %a" s value v
| (s,v) :: l -> fprintf fmt "%s %a@\n" s value v; value_list fmt l
in
G.iter_vertex
(fun v ->
fprintf fmt " @[node [@\n id %d@\n @[%a@]@\n]@]@\n"
(id v) value_list (L.node (G.V.label v)))
g;
G.iter_edges_e
(fun e ->
fprintf fmt
" @[edge [@\n source %d@\n target %d@\n @[%a@]@\n]@]@\n"
(id (G.E.src e)) (id (G.E.dst e))
value_list (L.edge (G.E.label e)))
g;
fprintf fmt "]@\n"
end
}
|