r5802 - in trunk/gta02-core/bom: . test/3
werner at docs.openmoko.org
werner at docs.openmoko.org
Fri Jan 29 10:26:11 CET 2010
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] }) {
More information about the commitlog
mailing list
