Documented all exceptions and did some general cleanups
[libdai.git] / scripts / regenerate-properties
1 #!/usr/bin/perl
2 #
3 # This file is part of libDAI - http://www.libdai.org/
4 #
5 # libDAI is licensed under the terms of the GNU General Public License version
6 # 2, or (at your option) any later version. libDAI is distributed without any
7 # warranty. See the file COPYING for more details.
8 #
9 # Copyright (C) 2009 Frederik Eaton [frederik at ofb dot net]
10
11
12 use warnings;
13 use strict;
14
15 use Cwd 'abs_path';
16
17 @ARGV == 2 or die "Need 2 arguments";
18
19 my ($header_file,$source_file) = @ARGV;
20 @ARGV=();
21
22 # Regular expressions for nested brackets (uses perl 5.10 features)
23 my ($nested_angle_brackets) = qr/(<(?:[^<>]++|(?1))*>)/;
24 my ($nested_curly_brackets) = qr/({(?:[^{}]++|(?1))*})/;
25 my ($nested_parentheses) = qr/(\((?:[^()]++|(?1))*\))/;
26
27 # Patterns to match generated code blocks
28 my ($gen_code_start_pat, $gen_code_end_pat, $props_start_pat) =
29 (qr(/\*.*GENERATED CODE: DO NOT EDIT.*),
30 qr(/\*.*END OF GENERATED CODE.*\*/),
31 qr(/\*.*PROPERTIES));
32 # Actual delimiters to use for generated code blocks
33 my ($gen_code_start, $gen_code_end) =
34 ("/* {{{ GENERATED CODE: DO NOT EDIT. Created by\n".
35 " $0 $header_file $source_file\n*/\n",
36 "/* }}} END OF GENERATED CODE */\n");
37
38 # Strings to hold text of files
39 my $header_buffer="";
40 my $source_buffer="";
41
42 # ----------------------------------------------------------------
43 # Useful routines
44
45 # remove leading and trailing whitespace
46 sub stripws ($) {
47 my ($s) = @_;
48 $s =~ s/^\s*//s;
49 $s =~ s/\s*$//s;
50 return $s;
51 }
52
53 # split comments and non-comments, returning 2-element array
54 # of (uncommented part, comments)
55 my $comment_pat = qr#(/\*[^*]*\*+(?:[^/*][^*]*\*+)*/|//[^\n]*)|("(?:\\.|[^"\\])*"|'(?:\\.|[^'\\])*'|.[^/"'\\]*)#;
56 sub sepcomment ($) {
57 my ($c) = @_;
58 my ($u) = $c;
59 $u =~ s#$comment_pat#defined $2 ? $2 : ""#gse;
60 $c =~ s#$comment_pat#defined $1 ? $1 : ""#gse;
61 return ($u, $c);
62 }
63
64 # Run diff, return output
65 sub getdiff ($$) {
66 my ($a,$b) = @_;
67 my $diff="";
68 open DIFF, "diff -u \Q$a\E \Q$b\E |"
69 or die "Couldn't run diff";
70 while(<DIFF>) {
71 $diff .= $_;
72 }
73 close DIFF;
74 return $diff;
75 }
76
77 sub myrename ($$) {
78 my ($a,$b) = @_;
79 $b = abs_path $b;
80 rename($a, $b) or die "Couldn't rename $a to $b";
81 }
82
83 sub writefile ($$) {
84 my ($buf, $f) = @_;
85 open OUT, ">", $f or die "Couldn't open $f for writing";
86 print OUT $buf;
87 close OUT;
88 }
89
90 our ($buffer);
91
92 # Step through file, appending lines to buffer
93 # - Lines which match generated code blocks are omitted
94 # - Other lines are passed to the subroutine. They are added to buffer
95 # unless the subroutine returns 1 (e.g. if it has already added them)
96 sub process_file (&$) {
97 my ($sub, $file) = @_;
98 local ($buffer) = "";
99 # step through lines of file, appending each one to buffer
100 open IN, "<", $file or die "Couldn't open $file for reading";
101 while (<IN>) {
102 # delete anything between GENERATED CODE etc.
103 if (/$gen_code_end_pat/) {
104 die "Unmatched generated code block end at $file line $.";
105 } elsif (/$gen_code_start_pat/) {
106 my $s = $.;
107 my $found=0;
108 while (<IN>) {
109 chomp;
110 if (/$gen_code_end_pat/) {
111 $found=1;
112 last;
113 }
114 }
115 die "Unterminated generated code block at $file line $s"
116 unless $found;
117 next;
118 } else {
119 my ($res) = &$sub;
120 next if $res;
121 }
122 $buffer .= $_;
123 }
124 close IN;
125 return $buffer;
126 }
127
128 # Parse a PROPERTIES() block
129 sub process_properties ($$$) {
130 my ($file, $start_line, $props_text) = @_;
131 my ($errline)="$file:$start_line";
132 $props_text =~ s/^.*PROPERTIES\s*($nested_parentheses)//s
133 or die "Malformed PROPERTIES, $errline: expected PROPERTIES(args)";
134 my ($args) = $1;
135 $args =~ s/^\(//g;
136 $args =~ s/\)$//g;
137 my (@args) = split /,/, $args;
138 @args == 2 or die "PROPERTIES needs two arguments at $errline";
139 my ($struct_name, $class) = @args;
140
141 $props_text =~ m/^\s*($nested_curly_brackets)\s*$/s
142 or die "Malformed PROPERTIES, $errline: expected {} after PROPERTIES";
143 my ($body) = $1;
144 $body =~ s/^{(.*)}$/$1/s; # get rid of curly brackets
145 my (@stmts) = split /;\s*\n/s, $body; # split on ";"
146 my (@typedecls) = ();
147 my (@vars) = ();
148 foreach my $s (@stmts) {
149 my ($s, $cmt) = sepcomment $s;
150 $cmt = stripws $cmt;
151 if($s =~ /^\s*$/s) { # extra ";"
152 next;
153 } elsif($s =~ /DAI_ENUM|typedef/) {
154 push @typedecls, [stripws $s, $cmt];
155 } else {
156 $s =~ /^\s*[a-zA-Z_][\w:]+\s*$nested_angle_brackets?/
157 or die "Couldn't match statement $s in PROPERTIES at $errline";
158 my $type = stripws $&;
159 my $name = stripws $';
160 my $default = undef;
161 if($name =~ /^(.*)=(.*)$/) {
162 $name = stripws $1;
163 $default = stripws $2;
164 }
165 push @vars, [$type, $name, $default, $cmt];
166 }
167 }
168
169 my ($stext) = "";
170 my ($text) = <<EOF;
171 struct Properties {
172 EOF
173 my $indent = (' 'x12);
174 for my $d (@typedecls) {
175 my ($decl,$cmt) = @$d;
176 if($cmt ne '') {
177 $text .= join("\n", map { "$indent$_" } split /\n/s, $cmt)."\n";
178 }
179 $text .= "$indent$decl;\n"
180 }
181 for my $v (@vars) {
182 my ($type,$name,$default,$cmt) = @$v;
183 if($cmt ne '') {
184 $text .= join("\n", map { "$indent$_" } split /\n/s, $cmt)."\n"
185 }
186 $text .= "$indent$type $name;\n";
187 }
188
189 $text .= <<EOF;
190
191 /// Set members from PropertySet
192 /** \\throw UNKNOWN_PROPERTY_TYPE if a Property key is not recognized
193 * \\throw NOT_ALL_PROPERTIES_SPECIFIED if an expected Property is missing
194 */
195 void set(const PropertySet &opts);
196 /// Get members into PropertySet
197 PropertySet get() const;
198 /// Convert to a string which can be parsed as a PropertySet
199 std::string toString() const;
200 } $struct_name;
201 EOF
202
203 $stext .= <<EOF;
204 namespace dai {
205
206 void ${class}::Properties::set(const PropertySet &opts)
207 {
208 const std::set<PropertyKey> &keys = opts.keys();
209 std::set<PropertyKey>::const_iterator i;
210 for(i=keys.begin(); i!=keys.end(); i++) {
211 EOF
212 for my $v (@vars) {
213 my ($type,$name,$default,$cmt) = @$v;
214 $stext .= <<EOF;
215 if(*i == "$name") continue;
216 EOF
217 }
218 $stext .= <<EOF;
219 DAI_THROWE(UNKNOWN_PROPERTY_TYPE, "$class: Unknown property " + *i);
220 }
221 EOF
222 for my $v (@vars) {
223 my ($type,$name,$default,$cmt) = @$v;
224 if(!defined $default) {
225 $stext .= <<EOF;
226 if(!opts.hasKey("$name"))
227 DAI_THROWE(NOT_ALL_PROPERTIES_SPECIFIED,"$class: Missing property \\\"$name\\\" for method \\\"\Q$class\E\\\"");
228 EOF
229 }
230
231 }
232 $stext .= <<EOF;
233 EOF
234 for my $v (@vars) {
235 my ($type,$name,$default,$cmt) = @$v;
236 if(defined $default) {
237 $stext .= <<EOF;
238 if(opts.hasKey("$name")) {
239 $name = opts.getStringAs<$type>("$name");
240 } else {
241 $name = $default;
242 }
243 EOF
244 } else {
245 $stext .= <<EOF;
246 $name = opts.getStringAs<$type>("$name");
247 EOF
248 }
249 }
250
251 $stext .= <<EOF;
252 }
253 PropertySet ${class}::Properties::get() const {
254 PropertySet opts;
255 EOF
256
257 for my $v (@vars) {
258 my ($type,$name,$default,$cmt) = @$v;
259 # $text .= qq{opts.set("$name", $name);};
260 $stext .= <<EOF;
261 opts.Set("$name", $name);
262 EOF
263
264 }
265 $stext .= <<EOF;
266 return opts;
267 }
268 string ${class}::Properties::toString() const {
269 stringstream s(stringstream::out);
270 s << "[";
271 EOF
272
273 my ($i)=0;
274 for my $v (@vars) {
275 my ($type,$name,$default,$cmt) = @$v;
276 $i++;
277 my $c = ($i<@vars)?" << \",\"":"";
278 $stext .= <<EOF;
279 s << "$name=" << $name$c;
280 EOF
281 }
282
283 $stext .= <<EOF;
284 s << "]";
285 return s.str();
286 }
287 } // end of namespace dai
288 EOF
289 return ($gen_code_start.$text.$gen_code_end, $gen_code_start.$stext.$gen_code_end);
290 }
291
292 # ----------------------------------------------------------------
293 # Main loop
294
295 $source_buffer = process_file { return 0; } $source_file;
296 $source_buffer =~ s/\n+$//s;
297
298 $header_buffer = process_file {
299 if (/$props_start_pat/) {
300 # when we see something resembling properties, record it, and when we
301 # get to the end, process and emit the generated code
302 my $start_line = $.;
303 my $props_text = $_;
304 while (<IN>) {
305 last if(m(\*/));
306 $props_text .= $_;
307 }
308 $buffer .= $props_text;
309 $buffer .= $_;
310 my ($htext, $stext) = process_properties($header_file, $start_line, $props_text);
311 $buffer .= $htext;
312 $source_buffer .= "\n\n\n".$stext;
313 return 1;
314 }
315 return 0;
316 } $header_file;
317
318 # Write new contents of files to temporary locations
319 my $header_tmp = "$header_file.new";
320 my $source_tmp = "$source_file.new";
321 writefile ($header_buffer, $header_tmp);
322 writefile ($source_buffer, $source_tmp);
323
324 # Get a diff of changes, show it to the user, and ask for confirmation
325 my ($diff);
326 $diff = getdiff ($header_file, $header_tmp);
327 $diff .= getdiff ($source_file, $source_tmp);
328
329 if($diff eq '') {
330 warn "No differences\n";
331 } else {
332 my $pager = $ENV{PAGER} || "less";
333 open PAGER, "|$pager";
334 print PAGER $diff;
335 close PAGER;
336
337 print STDERR "Replace old with new version? (y|N) ";
338 $_=<>;
339 if (/^y/i) {
340 myrename($header_tmp, $header_file);
341 myrename($source_tmp, $source_file);
342 } else {
343 warn "Aborted\n";
344 }
345 }