OpenPKG CVS Repository
http://cvs.openpkg.org/
____________________________________________________________________________
Server: cvs.openpkg.org Name: Michael van Elst
Root: /e/openpkg/cvs Email: [EMAIL PROTECTED]
Module: openpkg-re Date: 12-Nov-2002 12:23:28
Branch: HEAD Handle: 2002111211232700
Modified files:
openpkg-re openpkg-index
Log:
store conditions in UPN
support && and ! in #if (no operator precedences between || and &&)
added comments
Summary:
Revision Changes Path
1.3 +80 -15 openpkg-re/openpkg-index
____________________________________________________________________________
Index: openpkg-re/openpkg-index
============================================================
$ cvs diff -u -r1.2 -r1.3 openpkg-index
--- openpkg-re/openpkg-index 12 Nov 2002 08:15:36 -0000 1.2
+++ openpkg-re/openpkg-index 12 Nov 2002 11:23:27 -0000 1.3
@@ -60,10 +60,41 @@
return $v;
}
-sub paren ($) {
- my($s) = @_;
- $s = "($s)" if $s !~ /^\(/ && $s =~ / & | \|/;
- return $s;
+sub upn ($) {
+ my($t) = @_;
+ my(@tok) = $t =~ /(\(|\)|\&\&|\|\||\!|\S+)/g;
+ my(@out,$op,$o);
+ my(@save);
+
+ $op = [];
+ foreach (@tok) {
+ if ($_ eq '(') {
+ push @save, $op;
+ $op = [];
+ } elsif ($_ eq ')') {
+ die "FATAL: unresolved operators in: @tok\n" if @$op;
+ $op = pop @save
+ or die "FATAL: parenthesis stack underflow in: @tok\n";
+ while ($o = pop @$op) {
+ push @out, $o->[0];
+ last if $o->[1];
+ }
+ } elsif ($_ eq '&&') {
+ push @$op, [ '+', 1 ] ;
+ } elsif ($_ eq '||') {
+ push @$op, [ '|', 1 ] ;
+ } elsif ($_ eq '!') {
+ push @$op, [ '!', 0 ];
+ } elsif (/^\%\{(\S*?)\}$/) {
+ push @out, $1;
+ while ($o = pop @$op) {
+ push @out, $o->[0];
+ last if $o->[1]; # binop
+ }
+ }
+ }
+
+ return join (' ',@out);
}
#
@@ -95,6 +126,10 @@
$s =~ s/^#\{\!\?([^:]*):\s*%(.*?)\s*\}\s*$/#ifndef $1\n#$2\n#endif/mg;
$s =~ s/^#\{\!\?([^:]*):\s*(.*?)\s*\}\s*$/#ifndef $1\n$2\n#endif/mg;
+ #
+ # guess what parameters are external conditions by scanning
+ # for "default" sections.
+ #
$re = '^\#ifndef\s+[\w\_]+\s*\n((?:\#define\s+[\w\_]+\s.*\n)+)\#endif\n';
@defs = $s =~ /$re/gm;
foreach (@defs) {
@@ -114,29 +149,52 @@
$v = vsub(\%var,$l);
if (($p) = $v =~ /^\#if\s+(.*?)\s*$/) {
+
+ #
+ # normalize #if expressions
+ # "%{variable}" == "yes"
+ # "%{variable}" == "no"
+ # operators ! && ||
+ #
$term = '';
- while ($p =~ /(?:(\|\|)|"\%\{([^}]+)\}"\s*==\s*"(yes|no)")/g) {
+ while ($p =~
/(?:(\!|\|\||\&\&|\(|\))|"\%\{([^}]+)\}"\s*==\s*"(yes|no)")/g) {
if (defined $1) {
- $term .= ' | ';
+ $term .= " $1 ";
} elsif (exists $evar{$2}) {
- $term .= ($3 eq 'no' ? '!' : '').vsub(\%evar,$evar{$2});
+ $term .= ($3 eq 'no' ? '! ' : '').vsub(\%evar,$evar{$2});
} else {
die "ERROR: unknown conditional: $l\n== $v\n";
}
}
+
+ #
+ # join with previous conditions for this #if/#endif block
+ #
if ($term ne '') {
- push @term, paren($term);
- $cond = join(' + ',sort @term).'';
+ push @term, "( $term )";
+ $cond = join(' && ',sort @term).'';
}
} elsif ($v =~ /^\#endif\s*$/) {
+ #
+ # unwind last #if expression
+ #
pop @term;
$cond = join(' + ',sort @term).'';
+
} elsif ($v =~ /^\#(?:define)\s*(\S+)\s*(.*?)\s*$/) {
+
+ #
+ # define conditional variables
+ # truth-value becomes current condition
+ #
+ # define internal variables
+ # -> store for subsequent substitution
+ #
if (exists $evar{$1}) {
if ($2 eq 'yes') {
- $evar{$1} = paren($cond);
+ $evar{$1} = "( \%\{$1\} || ( $cond ) )";
} elsif ($2 eq 'no') {
- $evar{$1} = '!'.paren($cond);
+ $evar{$1} = "( %\{$1\} && ! ( $cond ) )";
} else {
die "ERROR: logic too complex: $l\n== $v\n";
}
@@ -144,6 +202,10 @@
$var{$1} = $2;
}
} elsif ($v =~ /^\s*([^\#]\S*)\s*:\s*(.*?)\s*$/) {
+
+ #
+ # store attribute=value for current condition
+ #
push @{$attr{$1}->{$cond}}, commasep($1,$2);
}
}
@@ -230,14 +292,15 @@
#
sub xml_tag ($$$;$) {
my($i,$a,$k,$tag) = @_;
- my($out,$cond);
+ my($out,$cond,$upn);
return "" unless exists $a->{$k};
$tag = $k unless defined $tag;
$out = '';
foreach $cond (sort keys %{$a->{$k}}) {
+ $upn = e(upn($cond));
$out .= (' ' x $i).
- ($cond ne '' ? "<$tag cond=\"$cond\">" : "<$tag>").
+ ($cond ne '' ? "<$tag cond=\"$upn\">" : "<$tag>").
join("\n", map { e($_) } @{$a->{$k}->{$cond}}).
"</$tag>\n";
}
@@ -253,14 +316,15 @@
#
sub xml_bag ($$$;$) {
my($i,$a,$k,$tag) = @_;
- my($out,$cond);
+ my($out,$cond,$upn);
return "" unless exists $a->{$k};
$tag = $k unless defined $tag;
$out = '';
foreach $cond (sort keys %{$a->{$k}}) {
+ $upn = e(upn($cond));
$out .= (' ' x $i).
- ($cond ne '' ? "<$tag cond=\"$cond\">\n" : "<$tag>\n").
+ ($cond ne '' ? "<$tag cond=\"$upn\">\n" : "<$tag>\n").
(' ' x ($i+2))."<rdf:bag>\n".
join("",
map { (' ' x ($i+4))."<rdf:li>".e($_)."</rdf:li>\n" }
@@ -361,3 +425,4 @@
}
}
xml_foot(\*STDOUT);
+
______________________________________________________________________
The OpenPKG Project www.openpkg.org
CVS Repository Commit List [EMAIL PROTECTED]
