[Frederik Eaton] CBP and BBP now use automatically generated properties (using script...

diff --git a/scripts/regenerate-properties b/scripts/regenerate-properties
new file mode 100755 (executable)
index 0000000..565bf4b
--- /dev/null
+++ b/scripts/regenerate-properties
@@ -0,0 +1,342 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Cwd 'abs_path';
+
+@ARGV == 2 or die "Need 2 arguments";
+
+my ($header_file,$source_file) = @ARGV;
+@ARGV=();
+
+# Regular expressions for nested brackets (uses perl 5.10 features)
+my ($nested_angle_brackets) = qr/(<(?:[^<>]++|(?1))*>)/;
+my ($nested_curly_brackets) = qr/({(?:[^{}]++|(?1))*})/;
+my ($nested_parentheses) = qr/(\((?:[^()]++|(?1))*\))/;
+
+# Patterns to match generated code blocks
+my ($gen_code_start_pat, $gen_code_end_pat, $props_start_pat) =
+  (qr(/\*.*GENERATED CODE: DO NOT EDIT.*),
+   qr(/\*.*END OF GENERATED CODE.*\*/),
+   qr(/\*.*PROPERTIES));
+# Actual delimiters to use for generated code blocks
+my ($gen_code_start, $gen_code_end) =
+  ("/* {{{ GENERATED CODE: DO NOT EDIT. Created by \n".
+   "    $0 $header_file $source_file \n*/\n",
+   "/* }}} END OF GENERATED CODE */\n");
+
+# Strings to hold text of files
+my $header_buffer="";
+my $source_buffer="";
+
+# ----------------------------------------------------------------
+# Useful routines
+
+# remove leading and trailing whitespace
+sub stripws ($) {
+  my ($s) = @_;
+  $s =~ s/^\s*//s;
+  $s =~ s/\s*$//s;
+  return $s;
+}
+
+# split comments and non-comments, returning 2-element array
+# of (uncommented part, comments)
+my $comment_pat = qr#(/\*[^*]*\*+(?:[^/*][^*]*\*+)*/|//[^\n]*)|("(?:\\.|[^"\\])*"|'(?:\\.|[^'\\])*'|.[^/"'\\]*)#;
+sub sepcomment ($) {
+  my ($c) = @_;
+  my ($u) = $c;
+  $u =~ s#$comment_pat#defined $2 ? $2 : ""#gse;
+  $c =~ s#$comment_pat#defined $1 ? $1 : ""#gse;
+  return ($u, $c);
+}
+
+# Run diff, return output
+sub getdiff ($$) {
+  my ($a,$b) = @_;
+my $diff="";
+open DIFF, "diff -u \Q$a\E \Q$b\E |"
+  or die "Couldn't run diff";
+while(<DIFF>) {
+  $diff .= $_;
+}
+close DIFF;
+  return $diff;
+}
+
+sub myrename ($$) {
+  my ($a,$b) = @_;
+  $b = abs_path $b;
+  rename($a, $b) or die "Couldn't rename $a to $b";
+}
+
+sub writefile ($$) {
+  my ($buf, $f) = @_;
+  open OUT, ">", $f or die "Couldn't open $f for writing";
+  print OUT $buf;
+  close OUT;
+}
+
+our ($buffer);
+
+# Step through file, appending lines to buffer
+# - Lines which match generated code blocks are omitted
+# - Other lines are passed to the subroutine. They are added to buffer
+# unless the subroutine returns 1 (e.g. if it has already added them)
+sub process_file (&$) {
+  my ($sub, $file) = @_;
+  local ($buffer) = "";
+  # step through lines of file, appending each one to buffer
+  open IN, "<", $file or die "Couldn't open $file for reading";
+  while (<IN>) {
+    # delete anything between GENERATED CODE etc.
+    if (/$gen_code_end_pat/) {
+      die "Unmatched generated code block end at $file line $.";
+    } elsif (/$gen_code_start_pat/) {
+      my $s = $.;
+      my $found=0;
+      while (<IN>) {
+        chomp;
+        if (/$gen_code_end_pat/) {
+          $found=1;
+          last;
+        }
+      }
+      die "Unterminated generated code block at $file line $s"
+        unless $found;
+      next;
+    } else {
+      my ($res) = &$sub;
+      next if $res;
+    }
+    $buffer .= $_;
+  }
+  close IN;
+  return $buffer;
+}
+
+# Parse a PROPERTIES() block
+sub process_properties ($$$) {
+  my ($file, $start_line, $props_text) = @_;
+  my ($errline)="$file:$start_line";
+  $props_text =~ s/^.*PROPERTIES\s*($nested_parentheses)//s
+    or die "Malformed PROPERTIES, $errline: expected PROPERTIES(args)";
+  my ($args) = $1;
+  $args =~ s/^\(//g;
+  $args =~ s/\)$//g;
+  my (@args) = split /,/, $args;
+  @args == 2 or die "PROPERTIES needs two arguments at $errline";
+  my ($struct_name, $class) = @args;
+
+  $props_text =~ m/^\s*($nested_curly_brackets)\s*$/s
+    or die "Malformed PROPERTIES, $errline: expected {} after PROPERTIES";
+  my ($body) = $1;
+  $body =~ s/^{(.*)}$/$1/s; # get rid of curly brackets
+  my (@stmts) = split /;\s*\n/s, $body; # split on ";"
+  my (@typedecls) = ();
+  my (@vars) = ();
+  foreach my $s (@stmts) {
+    my ($s, $cmt) = sepcomment $s;
+    $cmt = stripws $cmt;
+    if($s =~ /^\s*$/s) { # extra ";"
+      next;
+    } elsif($s =~ /DAI_ENUM|typedef/) {
+      push @typedecls, [stripws $s, $cmt];
+    } else {
+      $s =~ /^\s*[a-zA-Z_][\w:]+\s*$nested_angle_brackets?/
+        or die "Couldn't match statement $s in PROPERTIES at $errline";
+      my $type = stripws $&;
+      my $name = stripws $';
+      my $default = undef;
+      if($name =~ /^(.*)=(.*)$/) {
+        $name = stripws $1;
+        $default = stripws $2;
+      }
+      push @vars, [$type, $name, $default, $cmt];
+    }
+  }
+  
+  my ($stext) = "";
+  my ($text) = <<EOF;
+    struct Properties {
+EOF
+  my $indent = (' 'x8);
+  for my $d (@typedecls) {
+    my ($decl,$cmt) = @$d;
+    if($cmt ne '') {
+      $text .= join("\n", map { "$indent$_" } split /\n/s, $cmt)."\n";
+    }
+    $text .= "$indent$decl;\n"
+  }
+  for my $v (@vars) {
+    my ($type,$name,$default,$cmt) = @$v;
+    if($cmt ne '') {
+      $text .= join("\n", map { "$indent$_" } split /\n/s, $cmt)."\n"
+    }
+    $text .= "$indent$type $name;\n";
+  }
+
+  $text .= <<EOF;
+
+        /// Set members from PropertySet
+        void set(const PropertySet &opts);
+        /// Get members into PropertySet
+        PropertySet get() const;
+        /// Convert to a string which can be parsed as a PropertySet
+        std::string toString() const;
+    } $struct_name;
+EOF
+
+  $stext .= <<EOF;
+namespace dai {
+
+void ${class}::Properties::set(const PropertySet &opts)
+{
+    const std::set<PropertyKey> &keys = opts.allKeys();
+    std::set<PropertyKey>::const_iterator i;
+    bool die=false;
+    for(i=keys.begin(); i!=keys.end(); i++) {
+EOF
+  for my $v (@vars) {
+    my ($type,$name,$default,$cmt) = @$v;
+    $stext .= <<EOF;
+        if(*i == "$name") continue;
+EOF
+  }
+  $stext .= <<EOF;
+        cerr << "$class: Unknown property " << *i << endl;
+        die=true;
+    }
+    if(die) {
+        DAI_THROW(UNKNOWN_PROPERTY_TYPE);
+    }
+EOF
+  for my $v (@vars) {
+    my ($type,$name,$default,$cmt) = @$v;
+    if(!defined $default) {
+      $stext .= <<EOF;
+    if(!opts.hasKey("$name")) {
+        cerr << "$class: Missing property \\\"$name\\\" for method \\\"\Q$class\E\\\"" << endl;
+        die=true;
+    }
+EOF
+    }
+
+  }
+  $stext .= <<EOF;
+    if(die) {
+        DAI_THROW(NOT_ALL_PROPERTIES_SPECIFIED);
+    }
+EOF
+  for my $v (@vars) {
+    my ($type,$name,$default,$cmt) = @$v;
+    if(defined $default) {
+      $stext .= <<EOF;
+    if(opts.hasKey("$name")) {
+        $name = opts.getStringAs<$type>("$name");
+    } else {
+        $name = $default;
+    }
+EOF
+    } else {
+      $stext .= <<EOF;
+    $name = opts.getStringAs<$type>("$name");
+EOF
+    }
+  }
+
+  $stext .= <<EOF;
+}
+PropertySet ${class}::Properties::get() const {
+    PropertySet opts;
+EOF
+
+  for my $v (@vars) {
+    my ($type,$name,$default,$cmt) = @$v;
+#     $text .= qq{opts.set("$name", $name);};
+    $stext .= <<EOF;
+    opts.Set("$name", $name);
+EOF
+
+  }
+  $stext .= <<EOF;
+    return opts;
+}
+string ${class}::Properties::toString() const {
+    stringstream s(stringstream::out);
+    s << "[";
+EOF
+
+  my ($i)=0;
+  for my $v (@vars) {
+    my ($type,$name,$default,$cmt) = @$v;
+    $i++;
+    my $c = ($i<@vars)?" << \",\"":"";
+      $stext .= <<EOF;
+    s << "$name=" << $name$c;
+EOF
+  }
+
+  $stext .= <<EOF;
+    s << "]";
+    return s.str();
+}
+} // end of namespace dai
+EOF
+  return ($gen_code_start.$text.$gen_code_end, $gen_code_start.$stext.$gen_code_end);
+}
+
+# ----------------------------------------------------------------
+# Main loop
+
+$source_buffer = process_file { return 0; } $source_file;
+$source_buffer =~ s/\n+$//s;
+
+$header_buffer = process_file { 
+  if (/$props_start_pat/) {
+    # when we see something resembling properties, record it, and when we
+    # get to the end, process and emit the generated code
+    my $start_line = $.;
+    my $props_text = $_;
+    while (<IN>) {
+      last if(m(\*/));
+      $props_text .= $_;
+    }
+    $buffer .= $props_text;
+    $buffer .= $_;
+    my ($htext, $stext) = process_properties($header_file, $start_line, $props_text);
+    $buffer .= $htext;
+    $source_buffer .= "\n\n\n".$stext;
+    return 1;
+  }
+  return 0;
+} $header_file;
+
+# Write new contents of files to temporary locations
+my $header_tmp = "$header_file.new";
+my $source_tmp = "$source_file.new";
+writefile ($header_buffer, $header_tmp);
+writefile ($source_buffer, $source_tmp);
+
+# Get a diff of changes, show it to the user, and ask for confirmation
+my ($diff);
+$diff = getdiff ($header_file, $header_tmp);
+$diff .= getdiff ($source_file, $source_tmp);
+
+if($diff eq '') {
+  warn "No differences\n";
+} else {
+  my $pager = $ENV{PAGER} || "less";
+  open PAGER, "|$pager";
+  print PAGER $diff;
+  close PAGER;
+
+  print STDERR "Replace old with new version? (y|N) ";
+  $_=<>;
+  if (/^y/i) {
+    myrename($header_tmp, $header_file);
+    myrename($source_tmp, $source_file);
+  } else {
+    warn "Aborted\n";
+  }
+}