# Copyright (C) 1997-2023 Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program. If not, see . package Automake::Condition; use 5.010; use strict; use warnings FATAL => 'all'; use Carp; use Exporter; our @ISA = qw (Exporter); our @EXPORT_OK = qw (TRUE FALSE reduce_and reduce_or); =head1 NAME Automake::Condition - record a conjunction of conditionals =head1 SYNOPSIS use Automake::Condition; # Create a condition to represent "COND1 and not COND2". my $cond = new Automake::Condition "COND1_TRUE", "COND2_FALSE"; # Create a condition to represent "not COND3". my $other = new Automake::Condition "COND3_FALSE"; # Create a condition to represent # "COND1 and not COND2 and not COND3". my $both = $cond->merge ($other); # Likewise, but using a list of conditional strings my $both2 = $cond->merge_conds ("COND3_FALSE"); # Strip from $both any subconditions which are in $other. # This is the opposite of merge. $cond = $both->strip ($other); # Return the list of conditions ("COND1_TRUE", "COND2_FALSE"): my @conds = $cond->conds; # Is $cond always true? (Not in this example) if ($cond->true) { ... } # Is $cond always false? (Not in this example) if ($cond->false) { ... } # Return the list of conditionals as a string: # "COND1_TRUE COND2_FALSE" my $str = $cond->string; # Return the list of conditionals as a human readable string: # "COND1 and !COND2" my $str = $cond->human; # Return the list of conditionals as a AC_SUBST-style string: # "@COND1_TRUE@@COND2_FALSE@" my $subst = $cond->subst_string; # Is $cond true when $both is true? (Yes in this example) if ($cond->true_when ($both)) { ... } # Is $cond redundant w.r.t. {$other, $both}? # (Yes in this example) if ($cond->redundant_wrt ($other, $both)) { ... } # Does $cond imply any of {$other, $both}? # (Not in this example) if ($cond->implies_any ($other, $both)) { ... } # Remove superfluous conditionals assuming they will eventually # be multiplied together. # (Returns @conds = ($both) in this example, because # $other and $cond are implied by $both.) @conds = Automake::Condition::reduce_and ($other, $both, $cond); # Remove superfluous conditionals assuming they will eventually # be summed together. # (Returns @conds = ($cond, $other) in this example, because # $both is a subset condition of $cond: $cond is true whenever $both # is true.) @conds = Automake::Condition::reduce_or ($other, $both, $cond); # Invert a Condition. This returns a list of Conditions. @conds = $both->not; =head1 DESCRIPTION A C is a conjunction of conditionals (i.e., atomic conditions defined in F by C. In Automake they are used to represent the conditions into which F variables and F rules are defined. If the variable C is defined as if COND1 if COND2 VAR = value endif endif then it will be associated a C created with the following statement. new Automake::Condition "COND1_TRUE", "COND2_TRUE"; Remember that a C is a I of conditionals, so the above C means C is defined when C B C are true. There is no way to express disjunctions (i.e., Is) with this class (but see L). Another point worth to mention is that each C object is unique with respect to its conditionals. Two C objects created for the same set of conditionals will have the same address. This makes it easy to compare Cs: just compare the references. my $c1 = new Automake::Condition "COND1_TRUE", "COND2_TRUE"; my $c2 = new Automake::Condition "COND1_TRUE", "COND2_TRUE"; $c1 == $c2; # True! =head2 Methods =over 4 =item C<$cond = new Automake::Condition [@conds]> Return a C objects for the conjunctions of conditionals listed in C<@conds> as strings. An item in C<@conds> should be either C<"FALSE">, C<"TRUE">, or have the form C<"NAME_FALSE"> or C<"NAME_TRUE"> where C can be anything (in practice C should be the name of a conditional declared in F with C, but it's not C's responsibility to ensure this). An empty C<@conds> means C<"TRUE">. As explained previously, the reference (object) returned is unique with respect to C<@conds>. For this purpose, duplicate elements are ignored, and C<@conds> is rewritten as C<("FALSE")> if it contains C<"FALSE"> or two contradictory conditionals (such as C<"NAME_FALSE"> and C<"NAME_TRUE">.) Therefore the following two statements create the same object (they both create the C<"FALSE"> condition). my $c3 = new Automake::Condition "COND1_TRUE", "COND1_FALSE"; my $c4 = new Automake::Condition "COND2_TRUE", "FALSE"; $c3 == $c4; # True! $c3 == FALSE; # True! =cut # Keys in this hash are conditional strings. Values are the # associated object conditions. This is used by 'new' to reuse # Condition objects with identical conditionals. our %_condition_singletons; # Do NOT reset this hash here. It's already empty by default, # and any setting would otherwise occur AFTER the 'TRUE' and 'FALSE' # constants definitions. # %_condition_singletons = (); sub new ($;@) { my ($class, @conds) = @_; my $self = { hash => {}, }; bless $self, $class; for my $cond (@conds) { # Catch some common programming errors: # - A Condition passed to new confess "'$cond' is a reference, expected a string" if ref $cond; # - A Condition passed as a string to new confess "'$cond' does not look like a condition" if $cond =~ /::/; } # Accept strings like "FOO BAR" as shorthand for ("FOO", "BAR"). @conds = map { split (' ', $_) } @conds; for my $cond (@conds) { next if $cond eq 'TRUE'; # Detect cases when @conds can be simplified to FALSE. if (($cond eq 'FALSE' && $#conds > 0) || ($cond =~ /^(.*)_TRUE$/ && exists $self->{'hash'}{"${1}_FALSE"}) || ($cond =~ /^(.*)_FALSE$/ && exists $self->{'hash'}{"${1}_TRUE"})) { return &FALSE; } $self->{'hash'}{$cond} = 1; } my $key = $self->string; if (exists $_condition_singletons{$key}) { return $_condition_singletons{$key}; } $_condition_singletons{$key} = $self; return $self; } =item C<$newcond = $cond-Emerge (@otherconds)> Return a new condition which is the conjunction of C<$cond> and C<@otherconds>. =cut sub merge ($@) { my ($self, @otherconds) = @_; new Automake::Condition (map { $_->conds } ($self, @otherconds)); } =item C<$newcond = $cond-Emerge_conds (@conds)> Return a new condition which is the conjunction of C<$cond> and C<@conds>, where C<@conds> is a list of conditional strings, as passed to C. =cut sub merge_conds ($@) { my ($self, @conds) = @_; new Automake::Condition $self->conds, @conds; } =item C<$newcond = $cond-Estrip ($minuscond)> Return a new condition which has all the conditionals of C<$cond> except those of C<$minuscond>. This is the opposite of C. =cut sub strip ($$) { my ($self, $minus) = @_; my @res = grep { not $minus->_has ($_) } $self->conds; return new Automake::Condition @res; } =item C<@list = $cond-Econds> Return the set of conditionals defining C<$cond>, as strings. Note that this might not be exactly the list passed to C (or a concatenation of such lists if C was used), because of the cleanup mentioned in C's description. For instance C<$c3-Econds> will simply return C<("FALSE")>. =cut sub conds ($ ) { my ($self) = @_; my @conds = keys %{$self->{'hash'}}; return ("TRUE") unless @conds; return sort @conds; } # Undocumented, shouldn't be needed outside of this class. sub _has ($$) { my ($self, $cond) = @_; return exists $self->{'hash'}{$cond}; } =item C<$cond-Efalse> Return 1 iff this condition is always false. =cut sub false ($ ) { my ($self) = @_; return $self->_has ('FALSE'); } =item C<$cond-Etrue> Return 1 iff this condition is always true. =cut sub true ($ ) { my ($self) = @_; return 0 == keys %{$self->{'hash'}}; } =item C<$cond-Estring> Build a string which denotes the condition. For instance using the C<$cond> definition from L, C<$cond-Estring> will return C<"COND1_TRUE COND2_FALSE">. =cut sub string ($ ) { my ($self) = @_; return $self->{'string'} if defined $self->{'string'}; my $res = ''; if ($self->false) { $res = 'FALSE'; } else { $res = join (' ', $self->conds); } $self->{'string'} = $res; return $res; } =item C<$cond-Ehuman> Build a human readable string which denotes the condition. For instance using the C<$cond> definition from L, C<$cond-Estring> will return C<"COND1 and !COND2">. =cut sub _to_human ($ ) { my ($s) = @_; if ($s =~ /^(.*)_(TRUE|FALSE)$/) { return (($2 eq 'FALSE') ? '!' : '') . $1; } else { return $s; } } sub human ($ ) { my ($self) = @_; return $self->{'human'} if defined $self->{'human'}; my $res = ''; if ($self->false) { $res = 'FALSE'; } else { $res = join (' and ', map { _to_human $_ } $self->conds); } $self->{'human'} = $res; return $res; } =item C<$cond-Esubst_string> Build a C-style string for output in F. For instance using the C<$cond> definition from L, C<$cond-Esubst_string> will return C<"@COND1_TRUE@@COND2_FALSE@">. =cut sub subst_string ($ ) { my ($self) = @_; return $self->{'subst_string'} if defined $self->{'subst_string'}; my $res = ''; if ($self->false) { $res = '#'; } elsif (! $self->true) { $res = '@' . join ('@@', sort $self->conds) . '@'; } $self->{'subst_string'} = $res; return $res; } =item C<$cond-Etrue_when ($when)> Return 1 iff C<$cond> is true when C<$when> is true. Return 0 otherwise. Using the definitions from L, C<$cond> is true when C<$both> is true, but the converse is wrong. =cut sub true_when ($$) { my ($self, $when) = @_; # Nothing is true when FALSE (not even FALSE itself, but it # shouldn't hurt if you decide to change that). return 0 if $self->false || $when->false; # If we are true, we stay true when $when is true :) return 1 if $self->true; # $SELF is true under $WHEN if each conditional component of $SELF # exists in $WHEN. foreach my $cond ($self->conds) { return 0 unless $when->_has ($cond); } return 1; } =item C<$cond-Eredundant_wrt (@conds)> Return 1 iff C<$cond> is true for any condition in C<@conds>. If @conds is empty, return 1 iff C<$cond> is C. Return 0 otherwise. =cut sub redundant_wrt ($@) { my ($self, @conds) = @_; foreach my $cond (@conds) { return 1 if $self->true_when ($cond); } return $self->false; } =item C<$cond-Eimplies_any (@conds)> Return 1 iff C<$cond> implies any of the conditions in C<@conds>. Return 0 otherwise. =cut sub implies_any ($@) { my ($self, @conds) = @_; foreach my $cond (@conds) { return 1 if $cond->true_when ($self); } return 0; } =item C<$cond-Enot> Return a negation of C<$cond> as a list of Cs. This list should be used to construct a C (we cannot return a C from C, because that would make these two packages interdependent). =cut sub not ($ ) { my ($self) = @_; return @{$self->{'not'}} if defined $self->{'not'}; my @res = map { new Automake::Condition &conditional_negate ($_) } $self->conds; $self->{'not'} = [@res]; return @res; } =item C<$cond-Emultiply (@conds)> Assumption: C<@conds> represent a disjunction of conditions. Return the result of multiplying C<$cond> with that disjunction. The result will be a list of conditions suitable to construct a C. =cut sub multiply ($@) { my ($self, @set) = @_; my %res = (); for my $cond (@set) { my $ans = $self->merge ($cond); $res{$ans} = $ans; } # FALSE can always be removed from a disjunction. delete $res{FALSE}; # Now, $self is a common factor of the remaining conditions. # If one of the conditions is $self, we can discard the rest. return ($self, ()) if exists $res{$self}; return (values %res); } =back =head2 Other helper functions =over 4 =item C The C<"TRUE"> conditional. =item C The C<"FALSE"> conditional. =cut use constant TRUE => new Automake::Condition "TRUE"; use constant FALSE => new Automake::Condition "FALSE"; =item C Return a subset of @conds with the property that the conjunction of the subset is the same as the conjunction of @conds. For example, if both C and C are in the list, discard the latter. If the input list is empty, return C<(TRUE)>. =cut sub reduce_and (@) { my (@conds) = @_; my @ret = (); my $cond; while (@conds > 0) { $cond = shift @conds; # FALSE is absorbent. return FALSE if $cond == FALSE; if (! $cond->redundant_wrt (@ret, @conds)) { push (@ret, $cond); } } return TRUE if @ret == 0; return @ret; } =item C Return a subset of @conds with the property that the disjunction of the subset is equivalent to the disjunction of @conds. For example, if both C and C are in the list, discard the former. If the input list is empty, return C<(FALSE)>. =cut sub reduce_or (@) { my (@conds) = @_; my @ret = (); my $cond; while (@conds > 0) { $cond = shift @conds; next if $cond == FALSE; return TRUE if $cond == TRUE; push (@ret, $cond) unless $cond->implies_any (@ret, @conds); } return FALSE if @ret == 0; return @ret; } =item C Negate a conditional string. =cut sub conditional_negate ($) { my ($cond) = @_; $cond =~ s/TRUE$/TRUEO/; $cond =~ s/FALSE$/TRUE/; $cond =~ s/TRUEO$/FALSE/; return $cond; } =back =head1 SEE ALSO L. =head1 HISTORY Cs and supporting code were added to Automake 1.1o by Ian Lance Taylor in 1997. Since then it has been improved by Tom Tromey , Richard Boulton , Raja R Harinath , Akim Demaille , and Alexandre Duret-Lutz . =cut 1;