DisjConditions.pm 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557
  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::DisjConditions;
  13. use 5.006;
  14. use strict;
  15. use Carp;
  16. use Automake::Condition qw/TRUE FALSE/;
  17. =head1 NAME
  18. Automake::DisjConditions - record a disjunction of Conditions
  19. =head1 SYNOPSIS
  20. use Automake::Condition;
  21. use Automake::DisjConditions;
  22. # Create a Condition to represent "COND1 and not COND2".
  23. my $cond = new Automake::Condition "COND1_TRUE", "COND2_FALSE";
  24. # Create a Condition to represent "not COND3".
  25. my $other = new Automake::Condition "COND3_FALSE";
  26. # Create a DisjConditions to represent
  27. # "(COND1 and not COND2) or (not COND3)"
  28. my $set = new Automake::DisjConditions $cond, $other;
  29. # Return the list of Conditions involved in $set.
  30. my @conds = $set->conds;
  31. # Return one of the Condition involved in $set.
  32. my $cond = $set->one_cond;
  33. # Return true iff $set is always true (i.e. its subconditions
  34. # cover all cases).
  35. if ($set->true) { ... }
  36. # Return false iff $set is always false (i.e. is empty, or contains
  37. # only false conditions).
  38. if ($set->false) { ... }
  39. # Return a string representing the DisjConditions.
  40. # "COND1_TRUE COND2_FALSE | COND3_FALSE"
  41. my $str = $set->string;
  42. # Return a human readable string representing the DisjConditions.
  43. # "(COND1 and !COND2) or (!COND3)"
  44. my $str = $set->human;
  45. # Merge (OR) several DisjConditions.
  46. my $all = $set->merge($set2, $set3, ...)
  47. # Invert a DisjConditions, i.e., create a new DisjConditions
  48. # that complements $set.
  49. my $inv = $set->invert;
  50. # Multiply two DisjConditions.
  51. my $prod = $set1->multiply ($set2);
  52. # Return the subconditions of a DisjConditions with respect to
  53. # a Condition. See the description for a real example.
  54. my $subconds = $set->sub_conditions ($cond);
  55. # Check whether a new definition in condition $cond would be
  56. # ambiguous w.r.t. existing definitions in $set.
  57. ($msg, $ambig_cond) = $set->ambiguous_p ($what, $cond);
  58. =head1 DESCRIPTION
  59. A C<DisjConditions> is a disjunction of C<Condition>s. In Automake
  60. they are used to represent the conditions into which Makefile
  61. variables and Makefile rules are defined.
  62. If the variable C<VAR> is defined as
  63. if COND1
  64. if COND2
  65. VAR = value1
  66. endif
  67. endif
  68. if !COND3
  69. if COND4
  70. VAR = value2
  71. endif
  72. endif
  73. then it will be associated a C<DisjConditions> created with
  74. the following statement.
  75. new Automake::DisjConditions
  76. (new Automake::Condition ("COND1_TRUE", "COND2_TRUE"),
  77. new Automake::Condition ("COND3_FALSE", "COND4_TRUE"));
  78. As you can see, a C<DisjConditions> is made from a list of
  79. C<Condition>s. Since C<DisjConditions> is a disjunction, and
  80. C<Condition> is a conjunction, the above can be read as
  81. follows.
  82. (COND1 and COND2) or ((not COND3) and COND4)
  83. That's indeed the condition in which C<VAR> has a value.
  84. Like C<Condition> objects, a C<DisjConditions> object is unique
  85. with respect to its conditions. Two C<DisjConditions> objects created
  86. for the same set of conditions will have the same address. This makes
  87. it easy to compare C<DisjConditions>s: just compare the references.
  88. =head2 Methods
  89. =over 4
  90. =item C<$set = new Automake::DisjConditions [@conds]>
  91. Create a C<DisjConditions> object from the list of C<Condition>
  92. objects passed in arguments.
  93. If the C<@conds> list is empty, the C<DisjConditions> is assumed to be
  94. false.
  95. As explained previously, the reference (object) returned is unique
  96. with respect to C<@conds>. For this purpose, duplicate elements are
  97. ignored.
  98. =cut
  99. # Keys in this hash are DisjConditions strings. Values are the
  100. # associated object DisjConditions. This is used by 'new' to reuse
  101. # DisjConditions objects with identical conditions.
  102. use vars '%_disjcondition_singletons';
  103. sub new ($;@)
  104. {
  105. my ($class, @conds) = @_;
  106. my @filtered_conds = ();
  107. for my $cond (@conds)
  108. {
  109. confess "'$cond' isn't a reference" unless ref $cond;
  110. confess "'$cond' isn't an Automake::Condition"
  111. unless $cond->isa ("Automake::Condition");
  112. # This is a disjunction of conditions, so we drop
  113. # false conditions. We'll always treat an "empty"
  114. # DisjConditions as false for this reason.
  115. next if $cond->false;
  116. push @filtered_conds, $cond;
  117. }
  118. my $string;
  119. if (@filtered_conds)
  120. {
  121. @filtered_conds = sort { $a->string cmp $b->string } @filtered_conds;
  122. $string = join (' | ', map { $_->string } @filtered_conds);
  123. }
  124. else
  125. {
  126. $string = 'FALSE';
  127. }
  128. # Return any existing identical DisjConditions.
  129. my $me = $_disjcondition_singletons{$string};
  130. return $me if $me;
  131. # Else, create a new DisjConditions.
  132. # Store conditions as keys AND as values, because blessed
  133. # objects are converted to strings when used as keys (so
  134. # at least we still have the value when we need to call
  135. # a method).
  136. my %h = map {$_ => $_} @filtered_conds;
  137. my $self = {
  138. hash => \%h,
  139. string => $string,
  140. conds => \@filtered_conds,
  141. };
  142. bless $self, $class;
  143. $_disjcondition_singletons{$string} = $self;
  144. return $self;
  145. }
  146. =item C<CLONE>
  147. Internal special subroutine to fix up the self hashes in
  148. C<%_disjcondition_singletons> upon thread creation. C<CLONE> is invoked
  149. automatically with ithreads from Perl 5.7.2 or later, so if you use this
  150. module with earlier versions of Perl, it is not thread-safe.
  151. =cut
  152. sub CLONE
  153. {
  154. foreach my $self (values %_disjcondition_singletons)
  155. {
  156. my %h = map { $_ => $_ } @{$self->{'conds'}};
  157. $self->{'hash'} = \%h;
  158. }
  159. }
  160. =item C<@conds = $set-E<gt>conds>
  161. Return the list of C<Condition> objects involved in C<$set>.
  162. =cut
  163. sub conds ($ )
  164. {
  165. my ($self) = @_;
  166. return @{$self->{'conds'}};
  167. }
  168. =item C<$cond = $set-E<gt>one_cond>
  169. Return one C<Condition> object involved in C<$set>.
  170. =cut
  171. sub one_cond ($)
  172. {
  173. my ($self) = @_;
  174. return (%{$self->{'hash'}},)[1];
  175. }
  176. =item C<$et = $set-E<gt>false>
  177. Return 1 iff the C<DisjConditions> object is always false (i.e., if it
  178. is empty, or if it contains only false C<Condition>s). Return 0
  179. otherwise.
  180. =cut
  181. sub false ($ )
  182. {
  183. my ($self) = @_;
  184. return 0 == keys %{$self->{'hash'}};
  185. }
  186. =item C<$et = $set-E<gt>true>
  187. Return 1 iff the C<DisjConditions> object is always true (i.e. covers all
  188. conditions). Return 0 otherwise.
  189. =cut
  190. sub true ($ )
  191. {
  192. my ($self) = @_;
  193. return $self->invert->false;
  194. }
  195. =item C<$str = $set-E<gt>string>
  196. Build a string which denotes the C<DisjConditions>.
  197. =cut
  198. sub string ($ )
  199. {
  200. my ($self) = @_;
  201. return $self->{'string'};
  202. }
  203. =item C<$cond-E<gt>human>
  204. Build a human readable string which denotes the C<DisjConditions>.
  205. =cut
  206. sub human ($ )
  207. {
  208. my ($self) = @_;
  209. return $self->{'human'} if defined $self->{'human'};
  210. my $res = '';
  211. if ($self->false)
  212. {
  213. $res = 'FALSE';
  214. }
  215. else
  216. {
  217. my @c = $self->conds;
  218. if (1 == @c)
  219. {
  220. $res = $c[0]->human;
  221. }
  222. else
  223. {
  224. $res = '(' . join (') or (', map { $_->human } $self->conds) . ')';
  225. }
  226. }
  227. $self->{'human'} = $res;
  228. return $res;
  229. }
  230. =item C<$newcond = $cond-E<gt>merge (@otherconds)>
  231. Return a new C<DisjConditions> which is the disjunction of
  232. C<$cond> and C<@otherconds>. Items in C<@otherconds> can be
  233. @C<Condition>s or C<DisjConditions>.
  234. =cut
  235. sub merge ($@)
  236. {
  237. my ($self, @otherconds) = @_;
  238. new Automake::DisjConditions (
  239. map { $_->isa ("Automake::DisjConditions") ? $_->conds : $_ }
  240. ($self, @otherconds));
  241. }
  242. =item C<$prod = $set1-E<gt>multiply ($set2)>
  243. Multiply two conditional sets.
  244. my $set1 = new Automake::DisjConditions
  245. (new Automake::Condition ("A_TRUE"),
  246. new Automake::Condition ("B_TRUE"));
  247. my $set2 = new Automake::DisjConditions
  248. (new Automake::Condition ("C_FALSE"),
  249. new Automake::Condition ("D_FALSE"));
  250. C<$set1-E<gt>multiply ($set2)> will return
  251. new Automake::DisjConditions
  252. (new Automake::Condition ("A_TRUE", "C_FALSE"),
  253. new Automake::Condition ("B_TRUE", "C_FALSE"),;
  254. new Automake::Condition ("A_TRUE", "D_FALSE"),
  255. new Automake::Condition ("B_TRUE", "D_FALSE"));
  256. The argument can also be a C<Condition>.
  257. =cut
  258. # Same as multiply() but take a list of Conditionals as second argument.
  259. # We use this in invert().
  260. sub _multiply ($@)
  261. {
  262. my ($self, @set) = @_;
  263. my @res = map { $_->multiply (@set) } $self->conds;
  264. return new Automake::DisjConditions (Automake::Condition::reduce_or @res);
  265. }
  266. sub multiply ($$)
  267. {
  268. my ($self, $set) = @_;
  269. return $self->_multiply ($set) if $set->isa('Automake::Condition');
  270. return $self->_multiply ($set->conds);
  271. }
  272. =item C<$inv = $set-E<gt>invert>
  273. Invert a C<DisjConditions>. Return a C<DisjConditions> which is true
  274. when C<$set> is false, and vice-versa.
  275. my $set = new Automake::DisjConditions
  276. (new Automake::Condition ("A_TRUE", "B_TRUE"),
  277. new Automake::Condition ("A_FALSE", "B_FALSE"));
  278. Calling C<$set-E<gt>invert> will return the following C<DisjConditions>.
  279. new Automake::DisjConditions
  280. (new Automake::Condition ("A_TRUE", "B_FALSE"),
  281. new Automake::Condition ("A_FALSE", "B_TRUE"));
  282. We implement the inversion by a product-of-sums to sum-of-products
  283. conversion using repeated multiplications. Because of the way we
  284. implement multiplication, the result of inversion is in canonical
  285. prime implicant form.
  286. =cut
  287. sub invert($ )
  288. {
  289. my ($self) = @_;
  290. return $self->{'invert'} if defined $self->{'invert'};
  291. # The invert of an empty DisjConditions is TRUE.
  292. my $res = new Automake::DisjConditions TRUE;
  293. # !((a.b)+(c.d)+(e.f))
  294. # = (!a+!b).(!c+!d).(!e+!f)
  295. # We develop this into a sum of product iteratively, starting from TRUE:
  296. # 1) TRUE
  297. # 2) TRUE.!a + TRUE.!b
  298. # 3) TRUE.!a.!c + TRUE.!b.!c + TRUE.!a.!d + TRUE.!b.!d
  299. # 4) TRUE.!a.!c.!e + TRUE.!b.!c.!e + TRUE.!a.!d.!e + TRUE.!b.!d.!e
  300. # + TRUE.!a.!c.!f + TRUE.!b.!c.!f + TRUE.!a.!d.!f + TRUE.!b.!d.!f
  301. foreach my $cond ($self->conds)
  302. {
  303. $res = $res->_multiply ($cond->not);
  304. }
  305. # Cache result.
  306. $self->{'invert'} = $res;
  307. # It's tempting to also set $res->{'invert'} to $self, but that
  308. # is a bad idea as $self hasn't been normalized in any way.
  309. # (Different inputs can produce the same inverted set.)
  310. return $res;
  311. }
  312. =item C<$self-E<gt>simplify>
  313. Return a C<Disjunction> which is a simplified canonical form of C<$self>.
  314. This canonical form contains only prime implicants, but it can contain
  315. non-essential prime implicants.
  316. =cut
  317. sub simplify ($)
  318. {
  319. my ($self) = @_;
  320. return $self->invert->invert;
  321. }
  322. =item C<$self-E<gt>sub_conditions ($cond)>
  323. Return the subconditions of C<$self> that contains C<$cond>, with
  324. C<$cond> stripped. More formally, return C<$res> such that
  325. C<$res-E<gt>multiply ($cond) == $self-E<gt>multiply ($cond)> and
  326. C<$res> does not mention any of the variables in C<$cond>.
  327. For instance, consider:
  328. my $a = new Automake::DisjConditions
  329. (new Automake::Condition ("A_TRUE", "B_TRUE"),
  330. new Automake::Condition ("A_TRUE", "C_FALSE"),
  331. new Automake::Condition ("A_TRUE", "B_FALSE", "C_TRUE"),
  332. new Automake::Condition ("A_FALSE"));
  333. my $b = new Automake::DisjConditions
  334. (new Automake::Condition ("A_TRUE", "B_FALSE"));
  335. Calling C<$a-E<gt>sub_conditions ($b)> will return the following
  336. C<DisjConditions>.
  337. new Automake::DisjConditions
  338. (new Automake::Condition ("C_FALSE"), # From A_TRUE C_FALSE
  339. new Automake::Condition ("C_TRUE")); # From A_TRUE B_FALSE C_TRUE"
  340. =cut
  341. sub sub_conditions ($$)
  342. {
  343. my ($self, $subcond) = @_;
  344. # Make $subcond blindingly apparent in the DisjConditions.
  345. # For instance '$b->multiply($a->conds)' (from the POD example) is:
  346. # (new Automake::Condition ("FALSE"),
  347. # new Automake::Condition ("A_TRUE", "B_FALSE", "C_FALSE"),
  348. # new Automake::Condition ("A_TRUE", "B_FALSE", "C_TRUE"),
  349. # new Automake::Condition ("FALSE"))
  350. my @prodconds = $subcond->multiply ($self->conds);
  351. # Now, strip $subcond from the remaining (i.e., non-false) Conditions.
  352. my @res = map { $_->false ? () : $_->strip ($subcond) } @prodconds;
  353. return new Automake::DisjConditions @res;
  354. }
  355. =item C<($string, $ambig_cond) = $condset-E<gt>ambiguous_p ($what, $cond)>
  356. Check for an ambiguous condition. Return an error message and the
  357. other condition involved if we have an ambiguity. Return an empty
  358. string and FALSE otherwise.
  359. C<$what> is the name of the thing being defined, to use in the error
  360. message. C<$cond> is the C<Condition> under which it is being
  361. defined. C<$condset> is the C<DisjConditions> under which it had
  362. already been defined.
  363. =cut
  364. sub ambiguous_p ($$$)
  365. {
  366. my ($self, $var, $cond) = @_;
  367. # Note that these rules don't consider the following
  368. # example as ambiguous.
  369. #
  370. # if COND1
  371. # FOO = foo
  372. # endif
  373. # if COND2
  374. # FOO = bar
  375. # endif
  376. #
  377. # It's up to the user to not define COND1 and COND2
  378. # simultaneously.
  379. return ("$var multiply defined in condition " . $cond->human, $cond)
  380. if exists $self->{'hash'}{$cond};
  381. foreach my $vcond ($self->conds)
  382. {
  383. return ("$var was already defined in condition " . $vcond->human
  384. . ", which includes condition ". $cond->human, $vcond)
  385. if $vcond->true_when ($cond);
  386. return ("$var was already defined in condition " . $vcond->human
  387. . ", which is included in condition " . $cond->human, $vcond)
  388. if $cond->true_when ($vcond);
  389. }
  390. return ('', FALSE);
  391. }
  392. =head1 SEE ALSO
  393. L<Automake::Condition>.
  394. =head1 HISTORY
  395. C<AM_CONDITIONAL>s and supporting code were added to Automake 1.1o by
  396. Ian Lance Taylor <ian@cygnus.org> in 1997. Since then it has been
  397. improved by Tom Tromey <tromey@redhat.com>, Richard Boulton
  398. <richard@tartarus.org>, Raja R Harinath <harinath@cs.umn.edu>, Akim
  399. Demaille <akim@epita.fr>, Pavel Roskin <proski@gnu.org>, and
  400. Alexandre Duret-Lutz <adl@gnu.org>.
  401. =cut
  402. 1;
  403. ### Setup "GNU" style for perl-mode and cperl-mode.
  404. ## Local Variables:
  405. ## perl-indent-level: 2
  406. ## perl-continued-statement-offset: 2
  407. ## perl-continued-brace-offset: 0
  408. ## perl-brace-offset: 0
  409. ## perl-brace-imaginary-offset: 0
  410. ## perl-label-offset: -2
  411. ## cperl-indent-level: 2
  412. ## cperl-brace-offset: 0
  413. ## cperl-continued-brace-offset: 0
  414. ## cperl-label-offset: -2
  415. ## cperl-extra-newline-before-brace: t
  416. ## cperl-merge-trailing-else: nil
  417. ## cperl-continued-statement-offset: 2
  418. ## End: