Condition.pm 15 KB

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