lib/Automake/Condition.pm

   1 # Copyright (C) 1997, 2001, 2002, 2003, 2006, 2008, 2009  Free Software
   2 # Foundation, Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2, or (at your option)
   7 # any later version.
   8
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 package Automake::Condition;
  18 use strict;
  19 use Carp;
  20
  21 require Exporter;
  22 use vars '@ISA', '@EXPORT_OK';
  23 @ISA = qw/Exporter/;
  24 @EXPORT_OK = qw/TRUE FALSE reduce_and reduce_or/;
  25
  26 =head1 NAME
  27
  28 Automake::Condition - record a conjunction of conditionals
  29
  30 =head1 SYNOPSIS
  31
  32   use Automake::Condition;
  33
  34   # Create a condition to represent "COND1 and not COND2".
  35   my $cond = new Automake::Condition "COND1_TRUE", "COND2_FALSE";
  36   # Create a condition to represent "not COND3".
  37   my $other = new Automake::Condition "COND3_FALSE";
  38
  39   # Create a condition to represent
  40   #   "COND1 and not COND2 and not COND3".
  41   my $both = $cond->merge ($other);
  42
  43   # Likewise, but using a list of conditional strings
  44   my $both2 = $cond->merge_conds ("COND3_FALSE");
  45
  46   # Strip from $both any subconditions which are in $other.
  47   # This is the opposite of merge.
  48   $cond = $both->strip ($other);
  49
  50   # Return the list of conditions ("COND1_TRUE", "COND2_FALSE"):
  51   my @conds = $cond->conds;
  52
  53   # Is $cond always true?  (Not in this example)
  54   if ($cond->true) { ... }
  55
  56   # Is $cond always false? (Not in this example)
  57   if ($cond->false) { ... }
  58
  59   # Return the list of conditionals as a string:
  60   #  "COND1_TRUE COND2_FALSE"
  61   my $str = $cond->string;
  62
  63   # Return the list of conditionals as a human readable string:
  64   #  "COND1 and !COND2"
  65   my $str = $cond->human;
  66
  67   # Return the list of conditionals as a AC_SUBST-style string:
  68   #  "@COND1_TRUE@@COND2_FALSE@"
  69   my $subst = $cond->subst_string;
  70
  71   # Is $cond true when $both is true?  (Yes in this example)
  72   if ($cond->true_when ($both)) { ... }
  73
  74   # Is $cond redundant w.r.t. {$other, $both}?
  75   # (Yes in this example)
  76   if ($cond->redundant_wrt ($other, $both)) { ... }
  77
  78   # Does $cond imply any of {$other, $both}?
  79   # (Not in this example)
  80   if ($cond->implies_any ($other, $both)) { ... }
  81
  82   # Remove superfluous conditionals assuming they will eventually
  83   # be multiplied together.
  84   # (Returns @conds = ($both) in this example, because
  85   # $other and $cond are implied by $both.)
  86   @conds = Automake::Condition::reduce_and ($other, $both, $cond);
  87
  88   # Remove superfluous conditionals assuming they will eventually
  89   # be summed together.
  90   # (Returns @conds = ($cond, $other) in this example, because
  91   # $both is a subset condition of $cond: $cond is true whenever $both
  92   # is true.)
  93   @conds = Automake::Condition::reduce_or ($other, $both, $cond);
  94
  95   # Invert a Condition.  This returns a list of Conditions.
  96   @conds = $both->not;
  97
  98 =head1 DESCRIPTION
  99
 100 A C<Condition> is a conjunction of conditionals (i.e., atomic conditions
 101 defined in F<configure.ac> by C<AM_CONDITIONAL>.  In Automake they
 102 are used to represent the conditions into which F<Makefile> variables and
 103 F<Makefile> rules are defined.
 104
 105 If the variable C<VAR> is defined as
 106
 107   if COND1
 108     if COND2
 109       VAR = value
 110     endif
 111   endif
 112
 113 then it will be associated a C<Condition> created with
 114 the following statement.
 115
 116   new Automake::Condition "COND1_TRUE", "COND2_TRUE";
 117
 118 Remember that a C<Condition> is a I<conjunction> of conditionals, so
 119 the above C<Condition> means C<VAR> is defined when C<COND1>
 120 B<and> C<COND2> are true. There is no way to express disjunctions
 121 (i.e., I<or>s) with this class (but see L<DisjConditions>).
 122
 123 Another point worth to mention is that each C<Condition> object is
 124 unique with respect to its conditionals.  Two C<Condition> objects
 125 created for the same set of conditionals will have the same address.
 126 This makes it easy to compare C<Condition>s: just compare the
 127 references.
 128
 129   my $c1 = new Automake::Condition "COND1_TRUE", "COND2_TRUE";
 130   my $c2 = new Automake::Condition "COND1_TRUE", "COND2_TRUE";
 131   $c1 == $c2;  # True!
 132
 133 =head2 Methods
 134
 135 =over 4
 136
 137 =item C<$cond = new Automake::Condition [@conds]>
 138
 139 Return a C<Condition> objects for the conjunctions of conditionals
 140 listed in C<@conds> as strings.
 141
 142 An item in C<@conds> should be either C<"FALSE">, C<"TRUE">, or have
 143 the form C<"NAME_FALSE"> or C<"NAME_TRUE"> where C<NAME> can be
 144 anything (in practice C<NAME> should be the name of a conditional
 145 declared in F<configure.ac> with C<AM_CONDITIONAL>, but it's not
 146 C<Automake::Condition>'s responsibility to ensure this).
 147
 148 An empty C<@conds> means C<"TRUE">.
 149
 150 As explained previously, the reference (object) returned is unique
 151 with respect to C<@conds>.  For this purpose, duplicate elements are
 152 ignored, and C<@conds> is rewritten as C<("FALSE")> if it contains
 153 C<"FALSE"> or two contradictory conditionals (such as C<"NAME_FALSE">
 154 and C<"NAME_TRUE">.)
 155
 156 Therefore the following two statements create the same object (they
 157 both create the C<"FALSE"> condition).
 158
 159   my $c3 = new Automake::Condition "COND1_TRUE", "COND1_FALSE";
 160   my $c4 = new Automake::Condition "COND2_TRUE", "FALSE";
 161   $c3 == $c4;   # True!
 162   $c3 == FALSE; # True!
 163
 164 =cut
 165
 166 # Keys in this hash are conditional strings. Values are the
 167 # associated object conditions.  This is used by `new' to reuse
 168 # Condition objects with identical conditionals.
 169 use vars '%_condition_singletons';
 170 # Do NOT reset this hash here.  It's already empty by default,
 171 # and any setting would otherwise occur AFTER the `TRUE' and `FALSE'
 172 # constants definitions.
 173 #   %_condition_singletons = ();
 174
 175 sub new ($;@)
 176 {
 177   my ($class, @conds) = @_;
 178   my $self = {
 179     hash => {},
 180   };
 181   bless $self, $class;
 182
 183   for my $cond (@conds)
 184     {
 185       # Catch some common programming errors:
 186       # - A Condition passed to new
 187       confess "`$cond' is a reference, expected a string" if ref $cond;
 188       # - A Condition passed as a string to new
 189       confess "`$cond' does not look like a condition" if $cond =~ /::/;
 190     }
 191
 192   # Accept strings like "FOO BAR" as shorthand for ("FOO", "BAR").
 193   @conds = map { split (' ', $_) } @conds;
 194
 195   for my $cond (@conds)
 196     {
 197       next if $cond eq 'TRUE';
 198
 199       # Detect cases when @conds can be simplified to FALSE.
 200       if (($cond eq 'FALSE' && $#conds > 0)
 201           || ($cond =~ /^(.*)_TRUE$/ && exists $self->{'hash'}{"${1}_FALSE"})
 202           || ($cond =~ /^(.*)_FALSE$/ && exists $self->{'hash'}{"${1}_TRUE"}))
 203         {
 204           return &FALSE;
 205         }
 206
 207       $self->{'hash'}{$cond} = 1;
 208     }
 209
 210   my $key = $self->string;
 211   if (exists $_condition_singletons{$key})
 212     {
 213       return $_condition_singletons{$key};
 214     }
 215   $_condition_singletons{$key} = $self;
 216   return $self;
 217 }
 218
 219 =item C<$newcond = $cond-E<gt>merge (@otherconds)>
 220
 221 Return a new condition which is the conjunction of
 222 C<$cond> and C<@otherconds>.
 223
 224 =cut
 225
 226 sub merge ($@)
 227 {
 228   my ($self, @otherconds) = @_;
 229   new Automake::Condition (map { $_->conds } ($self, @otherconds));
 230 }
 231
 232 =item C<$newcond = $cond-E<gt>merge_conds (@conds)>
 233
 234 Return a new condition which is the conjunction of C<$cond> and
 235 C<@conds>, where C<@conds> is a list of conditional strings, as
 236 passed to C<new>.
 237
 238 =cut
 239
 240 sub merge_conds ($@)
 241 {
 242   my ($self, @conds) = @_;
 243   new Automake::Condition $self->conds, @conds;
 244 }
 245
 246 =item C<$newcond = $cond-E<gt>strip ($minuscond)>
 247
 248 Return a new condition which has all the conditionals of C<$cond>
 249 except those of C<$minuscond>.  This is the opposite of C<merge>.
 250
 251 =cut
 252
 253 sub strip ($$)
 254 {
 255   my ($self, $minus) = @_;
 256   my @res = grep { not $minus->_has ($_) } $self->conds;
 257   return new Automake::Condition @res;
 258 }
 259
 260 =item C<@list = $cond-E<gt>conds>
 261
 262 Return the set of conditionals defining C<$cond>, as strings.  Note that
 263 this might not be exactly the list passed to C<new> (or a
 264 concatenation of such lists if C<merge> was used), because of the
 265 cleanup mentioned in C<new>'s description.
 266
 267 For instance C<$c3-E<gt>conds> will simply return C<("FALSE")>.
 268
 269 =cut
 270
 271 sub conds ($ )
 272 {
 273   my ($self) = @_;
 274   my @conds = keys %{$self->{'hash'}};
 275   return ("TRUE") unless @conds;
 276   return sort @conds;
 277 }
 278
 279 # Undocumented, shouldn't be needed outside of this class.
 280 sub _has ($$)
 281 {
 282   my ($self, $cond) = @_;
 283   return exists $self->{'hash'}{$cond};
 284 }
 285
 286 =item C<$cond-E<gt>false>
 287
 288 Return 1 iff this condition is always false.
 289
 290 =cut
 291
 292 sub false ($ )
 293 {
 294   my ($self) = @_;
 295   return $self->_has ('FALSE');
 296 }
 297
 298 =item C<$cond-E<gt>true>
 299
 300 Return 1 iff this condition is always true.
 301
 302 =cut
 303
 304 sub true ($ )
 305 {
 306   my ($self) = @_;
 307   return 0 == keys %{$self->{'hash'}};
 308 }
 309
 310 =item C<$cond-E<gt>string>
 311
 312 Build a string which denotes the condition.
 313
 314 For instance using the C<$cond> definition from L<SYNOPSYS>,
 315 C<$cond-E<gt>string> will return C<"COND1_TRUE COND2_FALSE">.
 316
 317 =cut
 318
 319 sub string ($ )
 320 {
 321   my ($self) = @_;
 322
 323   return $self->{'string'} if defined $self->{'string'};
 324
 325   my $res = '';
 326   if ($self->false)
 327     {
 328       $res = 'FALSE';
 329     }
 330   else
 331     {
 332       $res = join (' ', $self->conds);
 333     }
 334   $self->{'string'} = $res;
 335   return $res;
 336 }
 337
 338 =item C<$cond-E<gt>human>
 339
 340 Build a human readable string which denotes the condition.
 341
 342 For instance using the C<$cond> definition from L<SYNOPSYS>,
 343 C<$cond-E<gt>string> will return C<"COND1 and !COND2">.
 344
 345 =cut
 346
 347 sub _to_human ($ )
 348 {
 349   my ($s) = @_;
 350   if ($s =~ /^(.*)_(TRUE|FALSE)$/)
 351     {
 352       return (($2 eq 'FALSE') ? '!' : '') . $1;
 353     }
 354   else
 355     {
 356       return $s;
 357     }
 358 }
 359
 360 sub human ($ )
 361 {
 362   my ($self) = @_;
 363
 364   return $self->{'human'} if defined $self->{'human'};
 365
 366   my $res = '';
 367   if ($self->false)
 368     {
 369       $res = 'FALSE';
 370     }
 371   else
 372     {
 373       $res = join (' and ', map { _to_human $_ } $self->conds);
 374     }
 375   $self->{'human'} = $res;
 376   return $res;
 377 }
 378
 379 =item C<$cond-E<gt>subst_string>
 380
 381 Build a C<AC_SUBST>-style string for output in F<Makefile.in>.
 382
 383 For instance using the C<$cond> definition from L<SYNOPSYS>,
 384 C<$cond-E<gt>subst_string> will return C<"@COND1_TRUE@@COND2_FALSE@">.
 385
 386 =cut
 387
 388 sub subst_string ($ )
 389 {
 390   my ($self) = @_;
 391
 392   return $self->{'subst_string'} if defined $self->{'subst_string'};
 393
 394   my $res = '';
 395   if ($self->false)
 396     {
 397       $res = '#';
 398     }
 399   elsif (! $self->true)
 400     {
 401       $res = '@' . join ('@@', sort $self->conds) . '@';
 402     }
 403   $self->{'subst_string'} = $res;
 404   return $res;
 405 }
 406
 407 =item C<$cond-E<gt>true_when ($when)>
 408
 409 Return 1 iff C<$cond> is true when C<$when> is true.
 410 Return 0 otherwise.
 411
 412 Using the definitions from L<SYNOPSYS>, C<$cond> is true
 413 when C<$both> is true, but the converse is wrong.
 414
 415 =cut
 416
 417 sub true_when ($$)
 418 {
 419   my ($self, $when) = @_;
 420
 421   # Nothing is true when FALSE (not even FALSE itself, but it
 422   # shouldn't hurt if you decide to change that).
 423   return 0 if $self->false || $when->false;
 424
 425   # If we are true, we stay true when $when is true :)
 426   return 1 if $self->true;
 427
 428   # $SELF is true under $WHEN if each conditional component of $SELF
 429   # exists in $WHEN.
 430   foreach my $cond ($self->conds)
 431     {
 432       return 0 unless $when->_has ($cond);
 433     }
 434   return 1;
 435 }
 436
 437 =item C<$cond-E<gt>redundant_wrt (@conds)>
 438
 439 Return 1 iff C<$cond> is true for any condition in C<@conds>.
 440 If @conds is empty, return 1 iff C<$cond> is C<FALSE>.
 441 Return 0 otherwise.
 442
 443 =cut
 444
 445 sub redundant_wrt ($@)
 446 {
 447   my ($self, @conds) = @_;
 448
 449   foreach my $cond (@conds)
 450     {
 451       return 1 if $self->true_when ($cond);
 452     }
 453   return $self->false;
 454 }
 455
 456 =item C<$cond-E<gt>implies_any (@conds)>
 457
 458 Return 1 iff C<$cond> implies any of the conditions in C<@conds>.
 459 Return 0 otherwise.
 460
 461 =cut
 462
 463 sub implies_any ($@)
 464 {
 465   my ($self, @conds) = @_;
 466
 467   foreach my $cond (@conds)
 468     {
 469       return 1 if $cond->true_when ($self);
 470     }
 471   return 0;
 472 }
 473
 474 =item C<$cond-E<gt>not>
 475
 476 Return a negation of C<$cond> as a list of C<Condition>s.
 477 This list should be used to construct a C<DisjConditions>
 478 (we cannot return a C<DisjConditions> from C<Automake::Condition>,
 479 because that would make these two packages interdependent).
 480
 481 =cut
 482
 483 sub not ($ )
 484 {
 485   my ($self) = @_;
 486   return @{$self->{'not'}} if defined $self->{'not'};
 487   my @res =
 488     map { new Automake::Condition &conditional_negate ($_) } $self->conds;
 489   $self->{'not'} = [@res];
 490   return @res;
 491 }
 492
 493 =item C<$cond-E<gt>multiply (@conds)>
 494
 495 Assumption: C<@conds> represent a disjunction of conditions.
 496
 497 Return the result of multiplying C<$cond> with that disjunction.
 498 The result will be a list of conditions suitable to construct a
 499 C<DisjConditions>.
 500
 501 =cut
 502
 503 sub multiply ($@)
 504 {
 505   my ($self, @set) = @_;
 506   my %res = ();
 507   for my $cond (@set)
 508     {
 509       my $ans = $self->merge ($cond);
 510       $res{$ans} = $ans;
 511     }
 512
 513   # FALSE can always be removed from a disjunction.
 514   delete $res{FALSE};
 515
 516   # Now, $self is a common factor of the remaining conditions.
 517   # If one of the conditions is $self, we can discard the rest.
 518   return ($self, ())
 519     if exists $res{$self};
 520
 521   return (values %res);
 522 }
 523
 524 =back
 525
 526 =head2 Other helper functions
 527
 528 =over 4
 529
 530 =item C<TRUE>
 531
 532 The C<"TRUE"> conditional.
 533
 534 =item C<FALSE>
 535
 536 The C<"FALSE"> conditional.
 537
 538 =cut
 539
 540 use constant TRUE => new Automake::Condition "TRUE";
 541 use constant FALSE => new Automake::Condition "FALSE";
 542
 543 =item C<reduce_and (@conds)>
 544
 545 Return a subset of @conds with the property that the conjunction of
 546 the subset is the same as the conjunction of @conds.  For example, if
 547 both C<COND1_TRUE COND2_TRUE> and C<COND1_TRUE> are in the list,
 548 discard the latter.  If the input list is empty, return C<(TRUE)>.
 549
 550 =cut
 551
 552 sub reduce_and (@)
 553 {
 554   my (@conds) = @_;
 555   my @ret = ();
 556   my $cond;
 557   while (@conds > 0)
 558     {
 559       $cond = shift @conds;
 560
 561       # FALSE is absorbent.
 562       return FALSE
 563         if $cond == FALSE;
 564
 565       if (! $cond->redundant_wrt (@ret, @conds))
 566         {
 567           push (@ret, $cond);
 568         }
 569     }
 570
 571   return TRUE if @ret == 0;
 572   return @ret;
 573 }
 574
 575 =item C<reduce_or (@conds)>
 576
 577 Return a subset of @conds with the property that the disjunction of
 578 the subset is equivalent to the disjunction of @conds.  For example,
 579 if both C<COND1_TRUE COND2_TRUE> and C<COND1_TRUE> are in the list,
 580 discard the former.  If the input list is empty, return C<(FALSE)>.
 581
 582 =cut
 583
 584 sub reduce_or (@)
 585 {
 586   my (@conds) = @_;
 587   my @ret = ();
 588   my $cond;
 589   while (@conds > 0)
 590     {
 591       $cond = shift @conds;
 592
 593       next
 594        if $cond == FALSE;
 595       return TRUE
 596        if $cond == TRUE;
 597
 598       push (@ret, $cond)
 599        unless $cond->implies_any (@ret, @conds);
 600     }
 601
 602   return FALSE if @ret == 0;
 603   return @ret;
 604 }
 605
 606 =item C<conditional_negate ($condstr)>
 607
 608 Negate a conditional string.
 609
 610 =cut
 611
 612 sub conditional_negate ($)
 613 {
 614   my ($cond) = @_;
 615
 616   $cond =~ s/TRUE$/TRUEO/;
 617   $cond =~ s/FALSE$/TRUE/;
 618   $cond =~ s/TRUEO$/FALSE/;
 619
 620   return $cond;
 621 }
 622
 623 =back
 624
 625 =head1 SEE ALSO
 626
 627 L<Automake::DisjConditions>.
 628
 629 =head1 HISTORY
 630
 631 C<AM_CONDITIONAL>s and supporting code were added to Automake 1.1o by
 632 Ian Lance Taylor <ian@cygnus.org> in 1997.  Since then it has been
 633 improved by Tom Tromey <tromey@redhat.com>, Richard Boulton
 634 <richard@tartarus.org>, Raja R Harinath <harinath@cs.umn.edu>,
 635 Akim Demaille <akim@epita.fr>, and  Alexandre Duret-Lutz <adl@gnu.org>.
 636
 637 =cut
 638
 639 1;
 640
 641 ### Setup "GNU" style for perl-mode and cperl-mode.
 642 ## Local Variables:
 643 ## perl-indent-level: 2
 644 ## perl-continued-statement-offset: 2
 645 ## perl-continued-brace-offset: 0
 646 ## perl-brace-offset: 0
 647 ## perl-brace-imaginary-offset: 0
 648 ## perl-label-offset: -2
 649 ## cperl-indent-level: 2
 650 ## cperl-brace-offset: 0
 651 ## cperl-continued-brace-offset: 0
 652 ## cperl-label-offset: -2
 653 ## cperl-extra-newline-before-brace: t
 654 ## cperl-merge-trailing-else: nil
 655 ## cperl-continued-statement-offset: 2
 656 ## End: