App-UnifdefPlus
view release on metacpan or search on metacpan
lib/UnifdefPlus.pm view on Meta::CPAN
if ( $condition eq $origCondition ) {
print DBGOUT "Not simplifying $condition\n" if ($self->{dbg});
return ($condition, 0);
}
print DBGOUT "simplifying $condition\n" if ($self->{dbg});
my $remainder;
( $condition, $remainder ) =
$self->simplifyExpr( $condition, $MAX_OP_PREC, 0 );
if ( !$condition ) {
print STDERR "Could not parse condition: $condition\n";
return ($origCondition, 0);
}
else {
$self->{wasModified} = 1;
return ($condition . $remainder, 1);
}
}
sub parseParameters {
my $self = shift;
my $lang = $self->{lang};
my $WS = $EXPR->{$lang}->{WHITESPACE};
my $expr = shift;
my $level = 0;
my @params = ();
my $param;
my $paramRss;
my $rsstate = RSS_UNCHANGED;
print DBGOUT " parseParameters(".$expr.")\n" if $self->{dbg};
#assume delimiter is comma
my $remaining=$expr;
while ($remaining!~/($WS)$/) {
my $operand1_ns;
( $param, $remaining, $paramRss, $operand1_ns ) =
$self->simplifyExpr( $remaining, $opPrecidences{","}, $level );
print " -- dbg: simplifyExpr( ".$remaining.") = (".$param.",".$remaining.",".$paramRss.")";
#TBD: do I need to check for whitespace before the comma, or does
# simplifyExpr already take care of it?
$remaining =~ s/^\($WS)(.*)\)$/$2/s;
$param += $1; # associate any trailing whitespaces with previous param
push @params, $param;
$rsstate = max($rsstate,$paramRss);
print " -- dbg: after max: ".$rsstate."\n";
$remaining =~ s/^\,(.*)\)$/$1/s; #strip next comma, and continue
}
return (\@params, $rsstate);
}
sub parseFuncMacro {
my $self = shift;
my $expr = shift;
my $lang = $self->{lang};
my $WS = $EXPR->{$lang}->{WHITESPACE};
if ($expr =~ /^($WS)(\w+)(\s*)(\(.*)$/) {
my $ws_bm = $1;
my $macroName = $2;
my $ws_am = $3;
my $rest = $4;
my ($paramsStr, $remainder) = extract_bracketed( $rest, "()" ) or return;
$paramsStr =~ s/^\((.*)\)$/$1/s;
my ($paramArrRef, $paramRss) = $self->parseParameters($paramsStr);
my @paramArr = @$paramArrRef;
#TBD: check if we can simplify macro:
#Hmm, this is not quite right -- we would not want to
#simplify parameters that are not resolved...
if ($paramRss == RSS_RESOLVED) {
$paramsStr = join(",", @paramArr);
}
return ($ws_bm, $macroName, $ws_am, $paramsStr, $remainder);
}
return;
}
sub simplifyExpr {
my $self = shift;
my $string1 = shift;
my $currentOpPrec = shift;
my $level = shift;
my $lang = $self->{lang};
$level += 1;
my $i = 0;
my $dbgStr = "<".sprintf("%2d",$currentOpPrec).">";
while ( $i < $level ) {
$dbgStr .= " ";
$i++;
}
my $WS = $EXPR->{$lang}->{WHITESPACE};
my $remainder;
my $operand1;
my $operator;
my $operand2;
my $operand1_ns; #operand1 , not-simplified.
my $operand2_ns;
my $ws_bo1; #whitespace before operand1
my $ws_ao1; #whitespace after operand1
my $ws_bo2; #whitespace before operand2
lib/UnifdefPlus.pm view on Meta::CPAN
print DBGOUT "$dbgStr WARNING: raminder2 not null ($remainder2)\n"
if ($remainder2!~/^\s*$/ && $self->{dbg});
print DBGOUT "$dbgStr ns1=\"$operand1_ns\"\n" if $self->{dbg};
$operand1_ns = "(".$ws_ib.$operand1_ns.$remainder2.")";
print DBGOUT "$dbgStr ... ns1=\"$operand1_ns\"\n" if $self->{dbg};
if ( $braceExpr =~ /^($WS)((?:\w+)|(?:defined\s+\w+))($WS)$/s ) {
print DBGOUT "$dbgStr Removing braces on simple term\n" if $self->{dbg};
$operand1 = $2;
$ws_bo1 = $ws_bb;
$ws_ao1 = $3.$remainder2;
$rss_o1 = max(RSS_SIMPLIFIED,$rsstate);
}
else {
print DBGOUT "$dbgStr Not removing braces\n" if $self->{dbg};
$operand1 = "($braceExpr$remainder2)";
$ws_bo1 = $ws_bb;
$ws_ao1 = "";
$rss_o1 = $rsstate;
}
}
#test for not operator:
elsif ( $string1 =~ /^($WS)!($WS)(.*)$/s ) {
$ws_bo1 = $1;
my $ws_an = $2; #whitespace after not
my $notOperand;
my $notOperand_rss;
my $notOperand_ns;
( $notOperand, $remainder, $notOperand_rss, $notOperand_ns ) =
$self->simplifyExpr( $3, $opPrecidences{"!"} + 1, $level )
or return;
$ws_ao1 = "";
$operand1_ns = "!".$ws_an.$notOperand_ns;
if ( $notOperand =~ /^($WS)($FALSE_RESOLVED_PTRN)($WS)$/s ) {
$operand1 = "$TRUE_RESOLVED";
$rss_o1 = RSS_RESOLVED;
}
elsif ( $notOperand =~ /^($WS)($TRUE_RESOLVED_PTRN)($WS)$/s ) {
$operand1 = "$FALSE_RESOLVED";
$rss_o1 = RSS_RESOLVED;
}
elsif ( $notOperand =~ /^($WS)($FALSE_PTRN)($WS)$/s ) {
$operand1 = "$TRUE_SIMPLIFIED";
$rss_o1 = max(RSS_SIMPLIFIED, $notOperand_rss);
}
elsif ( $notOperand =~ /^($WS)($TRUE_PTRN)($WS)$/s ) {
$operand1 = "$FALSE_SIMPLIFIED";
$rss_o1 = max(RSS_SIMPLIFIED, $notOperand_rss);
}
else {
$operand1 = "!" . $ws_an . $notOperand;
$rss_o1 = $notOperand_rss;
}
}
# test for function-like macro:
elsif ( my ($ws_bm, $macro, $ws_am, $params, $remainder2) =
$self->parseFuncMacro($string1)) {
#simplify expression within braces
print DBGOUT "$dbgStr ... macro: .$macro.$params.\n" if $self->{dbg};
my ( $sparams, $remainder3, $sparams_rss, $sparams_ns );
if ( $params =~ /^($WS)$/ ) {
$sparams_ns = $params;
$sparams = $params;
$remainder3 = "";
$sparams_rss = RSS_UNCHANGED;
}
else {
( $sparams, $remainder3, $sparams_rss, $sparams_ns ) =
$self->simplifyExpr( $params, $MAX_OP_PREC, $level ) or return;
}
$operand1_ns = $macro.$ws_am."(".$sparams_ns.$remainder3.")";
$operand1 = $macro.$ws_am."(".$sparams.$remainder3.")";
$ws_bo1 = $ws_bm;
$remainder = $remainder2;
$rss_o1 = $sparams_rss;
}
# get next single term:
elsif ( $string1 =~ /^($WS)(\w+)\b(.*)/s ) {
$ws_bo1 = $1;
$operand1 = $2;
$remainder = $3;
my $braceExpr = "";
$operand1_ns = $operand1;
if ($operand1 =~ /$RESOLVED_PREFIX_PTRN/) {
$rss_o1 = RSS_RESOLVED;
}
else {
$rss_o1 = RSS_UNCHANGED;
}
if (($operand1 eq "defined")
&& ($remainder =~ /((?:$WS)\w+)\b(.*)$/)
) {
$operand1 .= $1;
$operand1_ns = $operand1;
$remainder = $2;
#don't need to worry about resolving here, as resolving all known
#"defined XXX" terms has already been done.
}
}
else {
print DBGOUT "$dbgStr NO MTACH\n" if $self->{dbg};
}
while ( !( $remainder =~ /^($WS)$/s ) ) {
#TBD: base operator regex on operators hash...
if ( $remainder =~ /^($WS)([\!\|\>\<\=&\*\+\-\/\%\^\&\,]+)($WS)(.*)$/s ) {
#my $allops=join('|',quotemeta keys %opPrecidences)
#if ( $remainder =~ /^($WS)($allops)($WS)(.*)$/s ) {
$ws_ao1 = $1;
$operator = $2;
$ws_bo2 = $3;
my $remainder2 = $4;
lib/UnifdefPlus.pm view on Meta::CPAN
my $prefix = shift;
my $paramsRef = shift;
my @params = @$paramsRef;
my $rss = RSS_UNCHANGED;
my @paramsOut=();
my $simplifiedExpr;
for my $paramRef (@params) {
$rss = max($rss, $paramRef->{rss});
if ($self->isMakefileExprBlank($paramRef->{simplified})) {
#we're guarenteed to be blank. All subsequent parameters are moot
return ("",max($rss,RSS_SIMPLIFIED));
last;
} elsif ($self->isMakefileExprNonBlank($paramRef->{simplified}) && ($paramRef != $params[-1])) {
#if we're not last element, skip
} else {
#param is made up of one or more unresolved symbols. Output as is, and continue.
push @paramsOut, $paramRef->{simplified};
}
}
#eliminate known parameters...
$rss = max($rss, RSS_SIMPLIFIED) if ($#paramsOut < $#params);
return ("", $rss) if (scalar(@paramsOut) == 0); #this should tecnically not happen...
return ($paramsOut[0],$rss) if (scalar(@paramsOut) == 1);
my $rtStr = "\$(". $prefix . join(',', @paramsOut) . ")";
return ($rtStr, $rss);
}
sub makefileSimplifyStrip {
#TBD: pass braces in...
my $self = shift;
my $prefix = shift;
my $paramsRef = shift;
my @params = @$paramsRef;
return if (scalar @params != 1);
my $term = $params[0]{simplified};
my $rss = $params[0]{rss};
#strip whitespace at beginning or end
$rss = max($rss, RSS_SIMPLIFIED) if ($term =~ s/^\s++|\s++$//g);
# if term starts or ends with a variable, we can't simplify the strip:
return ("\$(".$prefix.$term.")", $rss) if ($term =~ /^\$/);
if ( $term =~ /\$([^\$]++)$/ ) {
my $tmp = $1;
return ("\$(".$prefix.$term.")", $rss) if $tmp =~ /^\w$/;
my ($brace,$remainder) = extract_bracketed($tmp, '("){"}');
return ("\$(".$prefix.$term.")", $rss) if !$remainder;
}
#term starts and ends in constant -- we can remove the strip keyword:
return ($term,max($rss,RSS_SIMPLIFIED));
}
my %makefileMacroSimplifiers = (
"or" => \&makefileSimplifyOr,
"and" => \&makefileSimplifyAnd,
"strip" => \&makefileSimplifyStrip,
# "if" => \&makefileSimplifyAnd,
);
#returns true if a variable is guarenteed to not be blank (i.e. $(FOO)_xx, will never be blank)
sub isMakefileExprNonBlank {
my $self=shift;
my $expr=shift;
return 1 if !defined $expr;
#tbd: handle " $$"
if ($expr =~ /^(?:\$(?:(?:$PAREN_TOKEN)|(?:\w++)))*([^\$]++)/) {
return 1;
}
return;
}
sub isMakefileExprBlank {
my $self=shift;
my $expr=shift;
#tbd: handle " $$"
if ($expr =~ /^\s*$/) {
return 1;
}
return;
}
sub getParameterList {
#assume delimiter is comma
#my $self = shift;
my $paramsStr = shift;
my @fields = extract_multiple($paramsStr,
[
sub { extract_delimited($_[0],q{'"}) },
sub { extract_bracketed($_[0],q{()}) },
qr/([^,("')]+)/,
qr/(,)/
],
undef);
my @params = ();
my $param = "";
for my $field (@fields) {
if ($field eq ",") {
push @params, $param;
$param = "";
} else {
$param .= $field;
}
}
push @params, $param;
return @params;
}
sub makefileSimplifyExpr {
lib/UnifdefPlus.pm view on Meta::CPAN
} elsif ($remainder =~ s/^($QUOTE_TOKEN)(.*)$/$2/ ) {
$simplifiedExpr.=$1;
} elsif ( $remainder =~ s/^(\\.)(.*)$/$2/ ) {
$simplifiedExpr.=$1;
} elsif ($remainder =~ s/^\$(.*)$/$1/ ) {
#macro
if ($remainder =~ s/^\$(.*)$/$1/) {
#double $ -- not simplifying
$simplifiedExpr.='$$';
} elsif ($remainder =~ s/^(\w)(.*)$/$2/) {
my $macro=$1;
if (defined $self->{undefines}->{$macro}) {
$rss = RSS_RESOLVED;
$simplifiedExpr.="";
} elsif (defined $self->{defines}->{$macro}) {
$rss = RSS_RESOLVED;
$simplifiedExpr.=$self->{defines}{$macro};
} else {
$simplifiedExpr.='$'.$macro;
}
} elsif ($remainder =~ /^([\(\{])/) {
my $openBrace=$1;
my $closeBrace=$braceMatch{$openBrace};
my $braceExpr;
( $braceExpr, $remainder ) = extract_bracketed( $remainder, '("){"}' );
if (!defined $braceExpr) {
print DBGOUT "\n$dbgStr ERROR parsing brace\n";
return;
}
#tbd: handle mismatched braces here
$braceExpr =~ s/^[({](.*)[})]$/$1/; #tbd -- may be more efficient way to do this?
if ($braceExpr =~ /^(\w++)$/) {
my $macro=$1;
if (exists $self->{undefines}->{$macro}) {
$rss = RSS_RESOLVED;
$simplifiedExpr.="";
} elsif (exists $self->{defines}->{$macro}) {
$rss = RSS_RESOLVED;
$simplifiedExpr.=$self->{defines}{$macro};
} else {
$simplifiedExpr.='$'.$openBrace.$macro.$closeBrace;
}
} elsif ($braceExpr =~ /^(\w++):([^=]*=.++)$/) {
#tbd: handle $(var:.o=.c)
$simplifiedExpr.='$'.$openBrace.$braceExpr.$closeBrace;
} elsif ($braceExpr =~ /^(\w++)(\s++)(.*)$/) {
my $macroName = $1;
my $ws1 = $2;
my @parms_ns = getParameterList($3);
my @parms = (); #simplified parms:
my $dummy;
my @parmsOut = ();
$rss = RSS_UNCHANGED;
foreach (@parms_ns) {
my ($simplified,$dummy,$rssParm,$orig) = makefileSimplifyExpr($self, $_,$currentOpPrec,$level);
push @parms, { orig => $_, rss => $rssParm, simplified => $simplified };
}
# OK, now handle function....
if (exists $makefileMacroSimplifiers{$macroName}) {
my $method = $makefileMacroSimplifiers{$macroName};
my ($simplified, $newRss) = $self->$method($macroName.$ws1, \@parms);
$rss = max($rss,$newRss);
if ((!defined $simplified) or ($newRss == RSS_UNCHANGED)) {
$simplifiedExpr .= '$'.$openBrace.$braceExpr.$closeBrace;
} else {
$simplifiedExpr .= $simplified;
}
} else {
# unknown function...
for my $parmRef (@parms) {
$rss = max($rss,$parmRef->{rss});
if ($parmRef->{rss} == RSS_RESOLVED) {
push @parmsOut, $parmRef->{simplified};
} else {
push @parmsOut, $parmRef->{orig};
}
}
$simplifiedExpr .= "\$".$openBrace.$macroName.$ws1.join(",",@parmsOut).$closeBrace;
}
}
#TBD: test for function or known variable, and replace
}
} else {
#no known pattern, leave as is:
print DBGOUT "\n$dbgStr Error simplifying expression .$origExpr. ($remainder) (level=$level)\n"
if $self->{dbg};
return;
}
}
return ( $simplifiedExpr, $remainder, $rss, $origExpr );
}
# makefileSimplifyIf($ifStmt, $condition)
# ifStmnt is one of : ifeq, ifneq, ifdef, ifndef (plus trailing whitespace)
# condition is the text following that.
#
# returns: ($ifStmnt, $simplifiedCond, $rss)
# simplifiedCond is $RESOLVED_TRUE, $RESOLVED_FALSE, or the simplified expression
#
sub makefileSimplifyIf()
{
my $self = shift;
my $ifStmt = shift;
my $condition = shift;
my $lang = $self->{lang};
my $rss = RSS_UNCHANGED;
if($ifStmt =~ /^$EXPR->{$lang}->{IFDEF}|^$EXPR->{$lang}->{IFNDEF}/) {
#TBD: simplify expression?
my $negate = $ifStmt =~ /^$EXPR->{$lang}->{IFNDEF}/;
# TBD: we should expand any of the known variables, but for now, just don't simplify...:
return ($ifStmt, $condition, RSS_UNCHANGED) if $condition =~ /\$/;
my ($var) = $condition =~ /^(\w++)/;
( run in 0.771 second using v1.01-cache-2.11-cpan-d8267643d1d )