Send commitlog mailing list submissions to
commitlog@lists.openmoko.org
To subscribe or unsubscribe via the World Wide Web, visit
http://lists.openmoko.org/mailman/listinfo/commitlog
or, via email, send a message with subject or body 'help' to
commitlog-requ...@lists.openmoko.org
You can reach the person managing the list at
commitlog-ow...@lists.openmoko.org
When replying, please edit your Subject line so it is more specific
than "Re: Contents of commitlog digest..."
Today's Topics:
1. r5801 - in trunk/gta02-core/bom: . test test/3
(wer...@docs.openmoko.org)
2. r5802 - in trunk/gta02-core/bom: . test/3
(wer...@docs.openmoko.org)
--- Begin Message ---
Author: werner
Date: 2010-01-28 20:36:30 +0100 (Thu, 28 Jan 2010)
New Revision: 5801
Added:
trunk/gta02-core/bom/test/3/
trunk/gta02-core/bom/test/3/3.sub
trunk/gta02-core/bom/test/3/Makefile
trunk/gta02-core/bom/test/3/print.pl
Modified:
trunk/gta02-core/bom/parser.pl
Log:
Tested .chr/.sub and fixed lots of bugs.
- bom/parser.py (chr): @f was declared in the wrong scope
- bom/parser.py (chr): need more sleep - $1/$2 aren't $`/$'
- bom/parser.py (sub): fixed a gazillion of bugs
- bom/test/3/: test case for .sub files
Modified: trunk/gta02-core/bom/parser.pl
===================================================================
--- trunk/gta02-core/bom/parser.pl 2010-01-28 08:25:08 UTC (rev 5800)
+++ trunk/gta02-core/bom/parser.pl 2010-01-28 19:36:30 UTC (rev 5801)
@@ -117,17 +117,18 @@
sub chr
{
+ my @f;
if (/^\s+/) {
- my @f = split(/\s+/, $');
+ @f = split(/\s+/, $');
} else {
- my @f = split(/\s+/);
+ @f = split(/\s+/);
my $ref = shift @f;
my $num = shift @f;
$last = "$ref $num";
}
for (@f) {
die unless /=/;
- $chr{$last}{uc($1)} = $2;
+ $chr{$last}{uc($`)} = $';
}
}
@@ -143,9 +144,9 @@
# $action_stack[depth]{field} = value
# $may_cont = 0 / 1
# $last
+# $last_action
#
# to do:
-# - test this
# - unit canonicalization
# - glob to RE rewriting for pattern
# - $n expansion for value
@@ -153,14 +154,16 @@
sub sub
{
- /^\s*/;
- my $indent = $&;
+ /^(\s*)/;
+ my $indent = $1;
my @f = split(/\s+/, $');
+ my $f;
my $in = 0; # indentation level
- while (/^./ =~ $indent) {
- if ($& eq " ") {
+ while (length $indent) {
+ my $c = substr($indent, 0, 1, "");
+ if ($c eq " ") {
$in++;
- } elsif ($& eq "\t") {
+ } elsif ($c eq "\t") {
$in = ($in+8) & ~7;
} else {
die;
@@ -169,47 +172,57 @@
if ($may_cont && $in > $last) {
pop(@match);
pop(@action);
+ pop(@end);
} else {
$match_stack[0] = undef;
$action_stack[0] = undef;
+ $last_action = 0;
+ $last = $in;
}
- $last = $in;
- while (@f) {
- my $f = shift @f;
- last if $f eq "->" || $f eq "{" || $f eq "}" || $f eq "!";
- if ($f =~ /=/) {
- $match_stack[0]{"REF"} = $f;
- } else {
- $match_stack[0]{uc($`)} = $';
+ if (!$last_action) {
+ while (@f) {
+ $f = shift @f;
+ last if $f eq "->" || $f eq "{" || $f eq "}" || $f eq "!";
+ if ($f =~ /=/) {
+ $match_stack[0]{uc($`)} = $';
+ } else {
+ $match_stack[0]{"REF"} = $f;
+ }
}
+ $last_action = 1 if $f eq "->";
}
- if ($f eq "->") {
+ if ($last_action) {
while (@f) {
- my $f = shift @f;
+ $f = shift @f;
last if $f eq "{" || $f eq "!";
+ die unless $f =~ /=/;
+ $action_stack[0]{uc($`)} = $';
}
- die unless /=/;
- $action_stack[0]{uc($`)} = $';
}
$may_cont = 0;
if ($f eq "{") {
unshift(@match_stack, undef);
unshift(@action_stack, undef);
+ die "items following {" if @f;
} elsif ($f eq "}") {
shift @match_stack;
shift @action_stack;
+ die "items following }" if @f;
} else {
+ die "items following !" if @f && $f eq "!";
push(@end, $f eq "!");
$may_cont = $f ne "!";
my $n = $#end;
- for $m (@match_stack) {
- for (keys %{ $_ }) {
- $match[$n]{$_} = $m{$_};
+ push(@match, undef);
+ push(@action, undef);
+ for my $m (@match_stack) {
+ for (keys %{ $m }) {
+ $match[$n]{$_} = $m->{$_};
}
}
- for $a (@action_stack) {
- for (keys %{ $_ }) {
- $action[$n]{$_} = $m{$_};
+ for my $a (@action_stack) {
+ for (keys %{ $a }) {
+ $action[$n]{$_} = $a->{$_};
}
}
}
@@ -245,6 +258,7 @@
if (/^#SUB\b/) {
$mode = *sub;
undef $last;
+ undef $last_action;
undef $may_cont;
next;
}
Added: trunk/gta02-core/bom/test/3/3.sub
===================================================================
--- trunk/gta02-core/bom/test/3/3.sub (rev 0)
+++ trunk/gta02-core/bom/test/3/3.sub 2010-01-28 19:36:30 UTC (rev 5801)
@@ -0,0 +1,17 @@
+#SUB
+# note: these rules don't make sense. they just serve to test the parser.
+C* {
+ foo=bar -> a=b
+ foo=bar
+ x=y -> a=c
+ foo=bar
+ x=y ->
+ a=b
+ foo=bar x=y ->
+ a=b !
+ foo=bar x=z -> z=zulu
+ { # indentation required !
+ y=0 -> t=a
+ y=1 -> t=b
+ }
+}
Added: trunk/gta02-core/bom/test/3/Makefile
===================================================================
--- trunk/gta02-core/bom/test/3/Makefile (rev 0)
+++ trunk/gta02-core/bom/test/3/Makefile 2010-01-28 19:36:30 UTC (rev
5801)
@@ -0,0 +1,2 @@
+all:
+ perl -I../.. ./print.pl 3.sub
Added: trunk/gta02-core/bom/test/3/print.pl
===================================================================
--- trunk/gta02-core/bom/test/3/print.pl (rev 0)
+++ trunk/gta02-core/bom/test/3/print.pl 2010-01-28 19:36:30 UTC (rev
5801)
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+require "parser.pl";
+&parse;
+
+for $k (sort keys %chr) {
+ for $p (sort keys %{ $chr{$k} }) {
+ print "chr{$k}{$p} = $chr{$k}{$p}\n";
+ }
+}
+for ($i = 0; $i != @end; $i++) {
+ for (sort keys %{ $match[$i] }) {
+ print "$_=$match[$i]{$_} ";
+ }
+ print "->";
+ for (sort keys %{ $action[$i] }) {
+ print " $_=$action[$i]{$_}";
+ }
+ print $end[$i] ? " !\n" : "\n";
+}
Property changes on: trunk/gta02-core/bom/test/3/print.pl
___________________________________________________________________
Name: svn:executable
+ *
--- End Message ---
--- Begin Message ---
Author: werner
Date: 2010-01-29 10:26:10 +0100 (Fri, 29 Jan 2010)
New Revision: 5802
Modified:
trunk/gta02-core/bom/README
trunk/gta02-core/bom/parser.pl
trunk/gta02-core/bom/test/3/print.pl
Log:
More work on the substitution mechanism. Almost done.
Modified: trunk/gta02-core/bom/README
===================================================================
--- trunk/gta02-core/bom/README 2010-01-28 19:36:30 UTC (rev 5801)
+++ trunk/gta02-core/bom/README 2010-01-29 09:26:10 UTC (rev 5802)
@@ -31,20 +31,91 @@
A substitutions file specifies rules for translating component
parameters in schematics to part characteristics.
-matches -> actions !
+A substitution rule consists of one or more conditions and zero or
+more assignments. The conditions are of the form field=pattern. The
+field can be a per-component fields KiCad provides or any parameter
+set by substitutions.
-matches -> actions {
+KiCad fields are named as follows:
+
+KiCad field Field name
+----------- ----------
+Reference REF (*)
+Value VAL
+FP Footprint
+Field1 F1
+... ...
+
+(*) As a shortcut, REF= can be omitted.
+
+Note that fields with a user-defined name currently still only appear
+as F1, F2, etc.
+
+Field names are case-insensitive.
+
+The pattern is uses a notation similar to filename globbing. There
+are the following special constructs:
+
+- * matches a string of any length
+- ? matches a single character
+- (...) matches the pattern between the parentheses and records the
+ string matched
+- $X marks a value in nXn notation, e.g., 4u7 or 100R. Such values
+ are converted to SI-like notation.
+
+A rule is applied when all conditions are fulfilled. In this case,
+assignments of the form field=value are executed. Strings obtained
+in the match can be included in a value as follows:
+
+- $field and ${field} are replaced by the respective field
+- $field:n and ${field:n} are replaced by the n-th (...) pattern in
+ the match of the respective field
+
+If a rule ends with an exclamation mark, the substitution process stops
+after the rule is applied. Otherwise, further rules are processed.
+
+Examples:
+
+R* val=$R -> R=$val
+
+This rule translates the values of all resistors to SI notation.
+
+D* F1=(*)Vdc -> T=TSV Vdc=F1:1
+
+This rule sets the parameters T and Vdc for Zeners acting as TSVs.
+
+If a set of rules has a common set of conditions or assignments, the
+more compact block notation can be used instead of repeating them for
+each rule:
+
+common-conditions -> common-assignments {
+ rule-specific-conditions -> rule-specific-assignments
...
}
-(...) -> $n or ${n}
-$u -> canonicalize unit
-REF
-FP
-F1
-...
+Rules in a block only match if both the common and the rule-specific
+conditions are met. Then the common and the rule-specific assignments
+are performed. If a condition or an assignment appears both in the
+common and the rule-specific part, only the latter is used.
+Long lines can be wrapped by indenting the continuation lines. Note
+that { and ! are also considered to be part of the same line as the
+rest of the rule. In particular, the following construct wouldn't
+work:
+X=Y
+{
+ ...
+}
+
+However, this would:
+
+X=Y
+ {
+ ...
+}
+
+
Parts list (.par)
------------------
Modified: trunk/gta02-core/bom/parser.pl
===================================================================
--- trunk/gta02-core/bom/parser.pl 2010-01-28 19:36:30 UTC (rev 5801)
+++ trunk/gta02-core/bom/parser.pl 2010-01-29 09:26:10 UTC (rev 5802)
@@ -1,5 +1,8 @@
#!/usr/bin/perl
+use re 'eval';
+
+
sub skip
{
# do nothing
@@ -146,12 +149,162 @@
# $last
# $last_action
#
-# to do:
-# - unit canonicalization
-# - glob to RE rewriting for pattern
-# - $n expansion for value
+
#
+# $cvn_from{internal-handle} = index
+# $cvn_to{internal-handle} = index
+# $cvn_unit{internal-handle} = unit-name
+# $cvn_num = internal-handle
+# $found{field-or-subfield} = string
+
+#
+# We convert each input pattern into two regular expressions: the first matches
+# units in the nXn notation, e.g., 4u7 or 100R. The second matches them in SI
+# notation (sans space).
+#
+# When matching (sub_match), we first apply the first expression. Each time we
+# encounter a unit ($R, $F, etc.), __cvn is called. __cvn stores the index of
+# the unit in %cvn_from and %cvn_to.
+#
+# We then pick these substrings from the input string and convert the units to
+# SI notation. At the same time, we normalize the mantissa. Once done, we run
+# the second expression. This one always matches (hopefully :-)
+#
+# All (...) ranges in the original pattern have been replaced with named
+# capture buffers in the second expression, so all these subfields are now
+# gathered in the $+ array. (The same also happened in the first pass, but we
+# ignore it.)
+#
+# Finally, when expanding a value (sub_expand), we look for $field and
+# $field:index, and expand accordingly.
+#
+
+
+sub __cvn
+{
+ local ($num) = @_;
+
+ $cvn_from{$num} = $-[$#-];
+ $cvn_to{$num} = $+[$#+];
+}
+
+
+sub sub_pattern
+{
+ local ($field, $p) = @_;
+ my $n = 0;
+ $p =~ s/\./\./g;
+ $p =~ s/\+/\\+/g;
+ $p =~ s/\?/./g;
+ $p =~ s/\*/.*/g;
+ my $tmp = "";
+ while ($p =~ /^([^\(]*)\(/) {
+ $n++;
+ $tmp .= "$1(?'${field}__$n'";
+ $p = $';
+ }
+ $p = $tmp.$p;
+ my $q = $p;
+ while ($p =~ /^([^\$]*)\$(.)/) {
+ $p = "$1(\\d+$2\\d*|\\d+[GMkmunpf$2]\\d*)(?{ &__cvn($cvn_num); })$'";
+ $cvn_unit{$cvn_num} = $2;
+ die unless $q =~ /^([^\$]*)\$(.)/;
+ $q = "$1(\\d+(\.\\d+)[GMkmunpf]?$2)$'";
+ $cvn_num++;
+ }
+ return ($p, $q);
+}
+
+
+sub sub_value
+{
+ return $_[0];
+}
+
+
+sub sub_match
+{
+ local ($s, $field, $m1, $m2) = @_;
+
+ #
+ # Perform the first match and record where we saw $<unit> patterns.
+ #
+ undef %cvn_from;
+ undef %cvn_to;
+ return undef unless $s =~ $m1;
+
+ #
+ # Convert the unit patterns to almost-SI notation. (We don't put a space
+ # after the number, but the rest is SI-compliant.)
+ #
+ my $off = 0;
+ for (keys %cvn_from) {
+ my $unit = $cvn_unit{$_};
+ my $from = $cvn_from{$_}+$off;
+ my $len = $cvn_to{$_}-$cvn_from{$_};
+ die unless substr($s, $from, $len) =~
+ /(\d+)$unit(\d*)|(\d+)([GMkmunpf])(\d*)/;
+
+ #
+ # Normalize to \d+.\d*
+ #
+ my $v = "$1$3.$2$5";
+ my $exp = $4 eq "" ? " " : $4;
+
+ #
+ # Mantissa must be < 1000.
+ # Do the math as string operation to avoid rounding errors.
+ #
+ while ($v =~ /(\d+)(\d{3})\./) {
+ $v = "$1.$2$'";
+ $exp =~ tr/GMk munpf/TGMk munp/;
+ }
+
+ #
+ # Mantissa must be >= 1.
+ #
+ while ($v =~ /\b0\.(\d+)/) {
+ if (length $1 < 3) {
+ $v = $1.("0" x (3-length $1)).".";
+ } else {
+ $v = substr($1, 0, 3).".".substr($1, 3);
+ }
+ $exp =~ tr/GMk munpf/Mk munpa/;
+ }
+ $exp =~ s/ //;
+ $v =~ s/\.$//;
+ $v = $v.$exp.$unit;
+ $off += length($v)-$len;
+ substr($s, $from, $len, $v);
+ }
+
+ #
+ # Run the second match on the string to process any (...) patterns
+ #
+ $found{$field} = $s;
+ die $m2 unless $s =~ $m2;
+ for (keys %+) {
+ $found{$_} = $+{$_};
+ }
+ return $s;
+}
+
+
+sub sub_expand
+{
+ local ($s) = @_;
+
+ while ($s =~
/^([^\$]*)\$([[:alpha:]]\w*)(:(\d+))?|^([^\$]*)\${([[:alpha:]]\w*)(:(\d+))?}/) {
+ my $name = "$2$5";
+ $name .= "__$4$7" if defined($4) || defined($7);
+ die "don't know \"$name\"" unless defined $found{$name};
+ $s = $1.$found{$name}.$';
+ }
+ return $s;
+}
+
+
sub sub
{
/^(\s*)/;
@@ -184,9 +337,9 @@
$f = shift @f;
last if $f eq "->" || $f eq "{" || $f eq "}" || $f eq "!";
if ($f =~ /=/) {
- $match_stack[0]{uc($`)} = $';
+ $match_stack[0]{uc($`)} = [ &sub_pattern(uc($`), $') ];
} else {
- $match_stack[0]{"REF"} = $f;
+ $match_stack[0]{"REF"} = [ &sub_pattern("REF", $f) ];
}
}
$last_action = 1 if $f eq "->";
@@ -196,7 +349,7 @@
$f = shift @f;
last if $f eq "{" || $f eq "!";
die unless $f =~ /=/;
- $action_stack[0]{uc($`)} = $';
+ $action_stack[0]{uc($`)} = &sub_value($');
}
}
$may_cont = 0;
@@ -215,12 +368,12 @@
my $n = $#end;
push(@match, undef);
push(@action, undef);
- for my $m (@match_stack) {
+ for my $m (reverse @match_stack) {
for (keys %{ $m }) {
$match[$n]{$_} = $m->{$_};
}
}
- for my $a (@action_stack) {
+ for my $a (reverse @action_stack) {
for (keys %{ $a }) {
$action[$n]{$_} = $a->{$_};
}
Modified: trunk/gta02-core/bom/test/3/print.pl
===================================================================
--- trunk/gta02-core/bom/test/3/print.pl 2010-01-28 19:36:30 UTC (rev
5801)
+++ trunk/gta02-core/bom/test/3/print.pl 2010-01-29 09:26:10 UTC (rev
5802)
@@ -9,7 +9,8 @@
}
for ($i = 0; $i != @end; $i++) {
for (sort keys %{ $match[$i] }) {
- print "$_=$match[$i]{$_} ";
+ @m = @{ $match[$i]{$_} };
+ print "$_=$m[0]/$m[1] ";
}
print "->";
for (sort keys %{ $action[$i] }) {
--- End Message ---
_______________________________________________
commitlog mailing list
commitlog@lists.openmoko.org
http://lists.openmoko.org/mailman/listinfo/commitlog
