1:- encoding(utf8).
    2
    3/*  Part of SWI-Prolog
    4
    5    Author:        Markus Triska
    6    E-mail:        triska@metalevel.at
    7    WWW:           http://www.swi-prolog.org
    8    Copyright (C): 2007-2017 Markus Triska
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   38   Thanks to Tom Schrijvers for his "bounds.pl", the first finite
   39   domain constraint solver included with SWI-Prolog. I've learned a
   40   lot from it and could even use some of the code for this solver.
   41   The propagation queue idea is taken from "prop.pl", a prototype
   42   solver also written by Tom. Highlights of the present solver:
   43
   44   Symbolic constants for infinities
   45   ---------------------------------
   46
   47   ?- X #>= 0, Y #=< 0.
   48   %@ X in 0..sup,
   49   %@ Y in inf..0.
   50
   51   No artificial limits (using GMP)
   52   ---------------------------------
   53
   54   ?- N #= 2^66, X #\= N.
   55   %@ N = 73786976294838206464,
   56   %@ X in inf..73786976294838206463\/73786976294838206465..sup.
   57
   58   Often stronger propagation
   59   ---------------------------------
   60
   61   ?- Y #= abs(X), Y #\= 3, Z * Z #= 4.
   62   %@ Y in 0..2\/4..sup,
   63   %@ Y#=abs(X),
   64   %@ X in inf.. -4\/ -2..2\/4..sup,
   65   %@ Z in -2\/2.
   66
   67   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   68
   69   Development of this library has moved to SICStus Prolog. If you
   70   need any additional features or want to help, please file an issue at:
   71
   72                    https://github.com/triska/clpz
   73                    ==============================
   74
   75- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   76
   77:- module(clpfd, [
   78                  op(760, yfx, #<==>),
   79                  op(750, xfy, #==>),
   80                  op(750, yfx, #<==),
   81                  op(740, yfx, #\/),
   82                  op(730, yfx, #\),
   83                  op(720, yfx, #/\),
   84                  op(710,  fy, #\),
   85                  op(700, xfx, #>),
   86                  op(700, xfx, #<),
   87                  op(700, xfx, #>=),
   88                  op(700, xfx, #=<),
   89                  op(700, xfx, #=),
   90                  op(700, xfx, #\=),
   91                  op(700, xfx, in),
   92                  op(700, xfx, ins),
   93                  op(450, xfx, ..), % should bind more tightly than \/
   94                  (#>)/2,
   95                  (#<)/2,
   96                  (#>=)/2,
   97                  (#=<)/2,
   98                  (#=)/2,
   99                  (#\=)/2,
  100                  (#\)/1,
  101                  (#<==>)/2,
  102                  (#==>)/2,
  103                  (#<==)/2,
  104                  (#\/)/2,
  105                  (#\)/2,
  106                  (#/\)/2,
  107                  (in)/2,
  108                  (ins)/2,
  109                  all_different/1,
  110                  all_distinct/1,
  111                  sum/3,
  112                  scalar_product/4,
  113                  tuples_in/2,
  114                  labeling/2,
  115                  label/1,
  116                  indomain/1,
  117                  lex_chain/1,
  118                  serialized/2,
  119                  global_cardinality/2,
  120                  global_cardinality/3,
  121                  circuit/1,
  122                  cumulative/1,
  123                  cumulative/2,
  124                  disjoint2/1,
  125                  element/3,
  126                  automaton/3,
  127                  automaton/8,
  128                  transpose/2,
  129                  zcompare/3,
  130                  chain/2,
  131                  fd_var/1,
  132                  fd_inf/2,
  133                  fd_sup/2,
  134                  fd_size/2,
  135                  fd_dom/2
  136                 ]).  137
  138:- public                               % called from goal_expansion
  139        clpfd_equal/2,
  140        clpfd_geq/2.  141
  142:- use_module(library(apply)).  143:- use_module(library(apply_macros)).  144:- use_module(library(assoc)).  145:- use_module(library(error)).  146:- use_module(library(lists)).  147:- use_module(library(pairs)).  148
  149:- op(700, xfx, cis).  150:- op(700, xfx, cis_geq).  151:- op(700, xfx, cis_gt).  152:- op(700, xfx, cis_leq).  153:- op(700, xfx, cis_lt).  154
  155/** <module> CLP(FD): Constraint Logic Programming over Finite Domains
  156
  157**Development of this library has moved to SICStus Prolog.**
  158
  159Please see [**CLP(Z)**](https://github.com/triska/clpz) for more
  160information.
  161
  162## Introduction			{#clpfd-intro}
  163
  164This library provides CLP(FD): Constraint Logic Programming over
  165Finite Domains. This is an instance of the general [CLP(_X_)
  166scheme](<#clp>), extending logic programming with reasoning over
  167specialised domains. CLP(FD) lets us reason about **integers** in a
  168way that honors the relational nature of Prolog.
  169
  170Read [**The Power of Prolog**](https://www.metalevel.at/prolog) to
  171understand how this library is meant to be used in practice.
  172
  173There are two major use cases of CLP(FD) constraints:
  174
  175    1. [**declarative integer arithmetic**](<#clpfd-integer-arith>)
  176    2. solving **combinatorial problems** such as planning, scheduling
  177       and allocation tasks.
  178
  179The predicates of this library can be classified as:
  180
  181    * _arithmetic_ constraints like #=/2, #>/2 and #\=/2 [](<#clpfd-arithmetic>)
  182    * the _membership_ constraints in/2 and ins/2 [](<#clpfd-membership>)
  183    * the _enumeration_ predicates indomain/1, label/1 and labeling/2 [](<#clpfd-enumeration>)
  184    * _combinatorial_ constraints like all_distinct/1 and global_cardinality/2 [](<#clpfd-global>)
  185    * _reification_ predicates such as #<==>/2 [](<#clpfd-reification-predicates>)
  186    * _reflection_ predicates such as fd_dom/2 [](<#clpfd-reflection-predicates>)
  187
  188In most cases, [_arithmetic constraints_](<#clpfd-arith-constraints>)
  189are the only predicates you will ever need from this library. When
  190reasoning over integers, simply replace low-level arithmetic
  191predicates like `(is)/2` and `(>)/2` by the corresponding CLP(FD)
  192constraints like #=/2 and #>/2 to honor and preserve declarative
  193properties of your programs. For satisfactory performance, arithmetic
  194constraints are implicitly rewritten at compilation time so that
  195low-level fallback predicates are automatically used whenever
  196possible.
  197
  198Almost all Prolog programs also reason about integers. Therefore, it
  199is highly advisable that you make CLP(FD) constraints available in all
  200your programs. One way to do this is to put the following directive in
  201your =|<config>/init.pl|= initialisation file:
  202
  203==
  204:- use_module(library(clpfd)).
  205==
  206
  207All example programs that appear in the CLP(FD) documentation assume
  208that you have done this.
  209
  210Important concepts and principles of this library are illustrated by
  211means of usage examples that are available in a public git repository:
  212[**github.com/triska/clpfd**](https://github.com/triska/clpfd)
  213
  214If you are used to the complicated operational considerations that
  215low-level arithmetic primitives necessitate, then moving to CLP(FD)
  216constraints may, due to their power and convenience, at first feel to
  217you excessive and almost like cheating. It _isn't_. Constraints are an
  218integral part of all popular Prolog systems, and they are designed
  219to help you eliminate and avoid the use of low-level and less general
  220primitives by providing declarative alternatives that are meant to be
  221used instead.
  222
  223When teaching Prolog, CLP(FD) constraints should be introduced
  224_before_ explaining low-level arithmetic predicates and their
  225procedural idiosyncrasies. This is because constraints are easy to
  226explain, understand and use due to their purely relational nature. In
  227contrast, the modedness and directionality of low-level arithmetic
  228primitives are impure limitations that are better deferred to more
  229advanced lectures.
  230
  231We recommend the following reference (PDF:
  232[metalevel.at/swiclpfd.pdf](https://www.metalevel.at/swiclpfd.pdf)) for
  233citing this library in scientific publications:
  234
  235==
  236@inproceedings{Triska12,
  237  author    = {Markus Triska},
  238  title     = {The Finite Domain Constraint Solver of {SWI-Prolog}},
  239  booktitle = {FLOPS},
  240  series    = {LNCS},
  241  volume    = {7294},
  242  year      = {2012},
  243  pages     = {307-316}
  244}
  245==
  246
  247More information about CLP(FD) constraints and their implementation is
  248contained in: [**metalevel.at/drt.pdf**](https://www.metalevel.at/drt.pdf)
  249
  250The best way to discuss applying, improving and extending CLP(FD)
  251constraints is to use the dedicated `clpfd` tag on
  252[stackoverflow.com](http://stackoverflow.com). Several of the world's
  253foremost CLP(FD) experts regularly participate in these discussions
  254and will help you for free on this platform.
  255
  256## Arithmetic constraints		{#clpfd-arith-constraints}
  257
  258In modern Prolog systems, *arithmetic constraints* subsume and
  259supersede low-level predicates over integers. The main advantage of
  260arithmetic constraints is that they are true _relations_ and can be
  261used in all directions. For most programs, arithmetic constraints are
  262the only predicates you will ever need from this library.
  263
  264The most important arithmetic constraint is #=/2, which subsumes both
  265`(is)/2` and `(=:=)/2` over integers. Use #=/2 to make your programs
  266more general. See [declarative integer
  267arithmetic](<#clpfd-integer-arith>).
  268
  269In total, the arithmetic constraints are:
  270
  271    | Expr1 `#=`  Expr2  | Expr1 equals Expr2                       |
  272    | Expr1 `#\=` Expr2  | Expr1 is not equal to Expr2              |
  273    | Expr1 `#>=` Expr2  | Expr1 is greater than or equal to Expr2  |
  274    | Expr1 `#=<` Expr2  | Expr1 is less than or equal to Expr2     |
  275    | Expr1 `#>` Expr2   | Expr1 is greater than Expr2              |
  276    | Expr1 `#<` Expr2   | Expr1 is less than Expr2                 |
  277
  278`Expr1` and `Expr2` denote *arithmetic expressions*, which are:
  279
  280    | _integer_          | Given value                          |
  281    | _variable_         | Unknown integer                      |
  282    | ?(_variable_)      | Unknown integer                      |
  283    | -Expr              | Unary minus                          |
  284    | Expr + Expr        | Addition                             |
  285    | Expr * Expr        | Multiplication                       |
  286    | Expr - Expr        | Subtraction                          |
  287    | Expr ^ Expr        | Exponentiation                       |
  288    | min(Expr,Expr)     | Minimum of two expressions           |
  289    | max(Expr,Expr)     | Maximum of two expressions           |
  290    | Expr `mod` Expr    | Modulo induced by floored division   |
  291    | Expr `rem` Expr    | Modulo induced by truncated division |
  292    | abs(Expr)          | Absolute value                       |
  293    | Expr // Expr       | Truncated integer division           |
  294    | Expr div Expr      | Floored integer division             |
  295
  296where `Expr` again denotes an arithmetic expression.
  297
  298The bitwise operations `(\)/1`, `(/\)/2`, `(\/)/2`, `(>>)/2`,
  299`(<<)/2`, `lsb/1`, `msb/1`, `popcount/1` and `(xor)/2` are also
  300supported.
  301
  302## Declarative integer arithmetic		{#clpfd-integer-arith}
  303
  304The [_arithmetic constraints_](<#clpfd-arith-constraints>)   #=/2,  #>/2
  305etc. are meant  to  be  used   _instead_  of  the  primitives  `(is)/2`,
  306`(=:=)/2`, `(>)/2` etc. over integers. Almost   all Prolog programs also
  307reason about integers. Therefore, it  is   recommended  that you put the
  308following directive in your =|<config>/init.pl|=  initialisation file to
  309make CLP(FD) constraints available in all your programs:
  310
  311==
  312:- use_module(library(clpfd)).
  313==
  314
  315Throughout the following, it is assumed that you have done this.
  316
  317The most basic use of CLP(FD) constraints is _evaluation_ of
  318arithmetic expressions involving integers. For example:
  319
  320==
  321?- X #= 1+2.
  322X = 3.
  323==
  324
  325This could in principle also be achieved with the lower-level
  326predicate `(is)/2`. However, an important advantage of arithmetic
  327constraints is their purely relational nature: Constraints can be used
  328in _all directions_, also if one or more of their arguments are only
  329partially instantiated. For example:
  330
  331==
  332?- 3 #= Y+2.
  333Y = 1.
  334==
  335
  336This relational nature makes CLP(FD) constraints easy to explain and
  337use, and well suited for beginners and experienced Prolog programmers
  338alike. In contrast, when using low-level integer arithmetic, we get:
  339
  340==
  341?- 3 is Y+2.
  342ERROR: is/2: Arguments are not sufficiently instantiated
  343
  344?- 3 =:= Y+2.
  345ERROR: =:=/2: Arguments are not sufficiently instantiated
  346==
  347
  348Due to the necessary operational considerations, the use of these
  349low-level arithmetic predicates is considerably harder to understand
  350and should therefore be deferred to more advanced lectures.
  351
  352For supported expressions, CLP(FD) constraints are drop-in
  353replacements of these low-level arithmetic predicates, often yielding
  354more general programs. See [`n_factorial/2`](<#clpfd-factorial>) for an
  355example.
  356
  357This library uses goal_expansion/2 to automatically rewrite
  358constraints at compilation time so that low-level arithmetic
  359predicates are _automatically_ used whenever possible. For example,
  360the predicate:
  361
  362==
  363positive_integer(N) :- N #>= 1.
  364==
  365
  366is executed as if it were written as:
  367
  368==
  369positive_integer(N) :-
  370        (   integer(N)
  371        ->  N >= 1
  372        ;   N #>= 1
  373        ).
  374==
  375
  376This illustrates why the performance of CLP(FD) constraints is almost
  377always completely satisfactory when they are used in modes that can be
  378handled by low-level arithmetic. To disable the automatic rewriting,
  379set the Prolog flag `clpfd_goal_expansion` to `false`.
  380
  381If you are used to the complicated operational considerations that
  382low-level arithmetic primitives necessitate, then moving to CLP(FD)
  383constraints may, due to their power and convenience, at first feel to
  384you excessive and almost like cheating. It _isn't_. Constraints are an
  385integral part of all popular Prolog systems, and they are designed
  386to help you eliminate and avoid the use of low-level and less general
  387primitives by providing declarative alternatives that are meant to be
  388used instead.
  389
  390
  391## Example: Factorial relation {#clpfd-factorial}
  392
  393We illustrate the benefit of using #=/2 for more generality with a
  394simple example.
  395
  396Consider first a rather conventional definition of `n_factorial/2`,
  397relating each natural number _N_ to its factorial _F_:
  398
  399==
  400n_factorial(0, 1).
  401n_factorial(N, F) :-
  402        N #> 0,
  403        N1 #= N - 1,
  404        n_factorial(N1, F1),
  405        F #= N * F1.
  406==
  407
  408This program uses CLP(FD) constraints _instead_ of low-level
  409arithmetic throughout, and everything that _would have worked_ with
  410low-level arithmetic _also_ works with CLP(FD) constraints, retaining
  411roughly the same performance. For example:
  412
  413==
  414?- n_factorial(47, F).
  415F = 258623241511168180642964355153611979969197632389120000000000 ;
  416false.
  417==
  418
  419Now the point: Due to the increased flexibility and generality of
  420CLP(FD) constraints, we are free to _reorder_ the goals as follows:
  421
  422==
  423n_factorial(0, 1).
  424n_factorial(N, F) :-
  425        N #> 0,
  426        N1 #= N - 1,
  427        F #= N * F1,
  428        n_factorial(N1, F1).
  429==
  430
  431In this concrete case, _termination_ properties of the predicate are
  432improved. For example, the following queries now both terminate:
  433
  434==
  435?- n_factorial(N, 1).
  436N = 0 ;
  437N = 1 ;
  438false.
  439
  440?- n_factorial(N, 3).
  441false.
  442==
  443
  444To make the predicate terminate if _any_ argument is instantiated, add
  445the (implied) constraint `F #\= 0` before the recursive call.
  446Otherwise, the query `n_factorial(N, 0)` is the only non-terminating
  447case of this kind.
  448
  449The value of CLP(FD) constraints does _not_ lie in completely freeing
  450us from _all_ procedural phenomena. For example, the two programs do
  451not even have the same _termination properties_ in all cases.
  452Instead, the primary benefit of CLP(FD) constraints is that they allow
  453you to try different execution orders and apply [**declarative
  454debugging**](https://www.metalevel.at/prolog/debugging)
  455techniques _at all_!  Reordering goals (and clauses) can significantly
  456impact the performance of Prolog programs, and you are free to try
  457different variants if you use declarative approaches. Moreover, since
  458all CLP(FD) constraints _always terminate_, placing them earlier can
  459at most _improve_, never worsen, the termination properties of your
  460programs. An additional benefit of CLP(FD) constraints is that they
  461eliminate the complexity of introducing `(is)/2` and `(=:=)/2` to
  462beginners, since _both_ predicates are subsumed by #=/2 when reasoning
  463over integers.
  464
  465In the case above, the clauses are mutually exclusive _if_ the first
  466argument is sufficiently instantiated. To make the predicate
  467deterministic in such cases while retaining its generality, you can
  468use zcompare/3 to _reify_ a comparison, making the different cases
  469distinguishable by pattern matching. For example, in this concrete
  470case and others like it, you can use `zcompare(Comp, 0, N)` to obtain as
  471`Comp` the symbolic outcome (`<`, `=`, `>`) of 0 compared to N.
  472
  473## Combinatorial constraints  {#clpfd-combinatorial}
  474
  475In addition to subsuming and replacing low-level arithmetic
  476predicates, CLP(FD) constraints are often used to solve combinatorial
  477problems such as planning, scheduling and allocation tasks. Among the
  478most frequently used *combinatorial constraints* are all_distinct/1,
  479global_cardinality/2 and cumulative/2. This library also provides
  480several other constraints like disjoint2/1 and automaton/8, which are
  481useful in more specialized applications.
  482
  483## Domains                             {#clpfd-domains}
  484
  485Each CLP(FD) variable has an associated set of admissible integers,
  486which we call the variable's *domain*. Initially, the domain of each
  487CLP(FD) variable is the set of _all_ integers. CLP(FD) constraints
  488like #=/2, #>/2 and #\=/2 can at most reduce, and never extend, the
  489domains of their arguments. The constraints in/2 and ins/2 let us
  490explicitly state domains of CLP(FD) variables. The process of
  491determining and adjusting domains of variables is called constraint
  492*propagation*, and it is performed automatically by this library. When
  493the domain of a variable contains only one element, then the variable
  494is automatically unified to that element.
  495
  496Domains are taken into account when further constraints are stated,
  497and by enumeration predicates like labeling/2.
  498
  499## Example: Sudoku {#clpfd-sudoku}
  500
  501As another example, consider _Sudoku_: It is a popular puzzle
  502over integers that can be easily solved with CLP(FD) constraints.
  503
  504==
  505sudoku(Rows) :-
  506        length(Rows, 9), maplist(same_length(Rows), Rows),
  507        append(Rows, Vs), Vs ins 1..9,
  508        maplist(all_distinct, Rows),
  509        transpose(Rows, Columns),
  510        maplist(all_distinct, Columns),
  511        Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
  512        blocks(As, Bs, Cs),
  513        blocks(Ds, Es, Fs),
  514        blocks(Gs, Hs, Is).
  515
  516blocks([], [], []).
  517blocks([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
  518        all_distinct([N1,N2,N3,N4,N5,N6,N7,N8,N9]),
  519        blocks(Ns1, Ns2, Ns3).
  520
  521problem(1, [[_,_,_,_,_,_,_,_,_],
  522            [_,_,_,_,_,3,_,8,5],
  523            [_,_,1,_,2,_,_,_,_],
  524            [_,_,_,5,_,7,_,_,_],
  525            [_,_,4,_,_,_,1,_,_],
  526            [_,9,_,_,_,_,_,_,_],
  527            [5,_,_,_,_,_,_,7,3],
  528            [_,_,2,_,1,_,_,_,_],
  529            [_,_,_,_,4,_,_,_,9]]).
  530==
  531
  532Sample query:
  533
  534==
  535?- problem(1, Rows), sudoku(Rows), maplist(writeln, Rows).
  536[9,8,7,6,5,4,3,2,1]
  537[2,4,6,1,7,3,9,8,5]
  538[3,5,1,9,2,8,7,4,6]
  539[1,2,8,5,3,7,6,9,4]
  540[6,3,4,8,9,2,1,5,7]
  541[7,9,5,4,6,1,8,3,2]
  542[5,1,9,2,8,6,4,7,3]
  543[4,7,2,3,1,9,5,6,8]
  544[8,6,3,7,4,5,2,1,9]
  545Rows = [[9, 8, 7, 6, 5, 4, 3, 2|...], ... , [...|...]].
  546==
  547
  548In this concrete case, the constraint solver is strong enough to find
  549the unique solution without any search. For the general case, see
  550[search](<#clpfd-search>).
  551
  552
  553## Residual goals				{#clpfd-residual-goals}
  554
  555Here is an example session with a few queries and their answers:
  556
  557==
  558?- X #> 3.
  559X in 4..sup.
  560
  561?- X #\= 20.
  562X in inf..19\/21..sup.
  563
  564?- 2*X #= 10.
  565X = 5.
  566
  567?- X*X #= 144.
  568X in -12\/12.
  569
  570?- 4*X + 2*Y #= 24, X + Y #= 9, [X,Y] ins 0..sup.
  571X = 3,
  572Y = 6.
  573
  574?- X #= Y #<==> B, X in 0..3, Y in 4..5.
  575B = 0,
  576X in 0..3,
  577Y in 4..5.
  578==
  579
  580The answers emitted by the toplevel are called _residual programs_,
  581and the goals that comprise each answer are called **residual goals**.
  582In each case above, and as for all pure programs, the residual program
  583is declaratively equivalent to the original query. From the residual
  584goals, it is clear that the constraint solver has deduced additional
  585domain restrictions in many cases.
  586
  587To inspect residual goals, it is best to let the toplevel display them
  588for us. Wrap the call of your predicate into call_residue_vars/2 to
  589make sure that all constrained variables are displayed. To make the
  590constraints a variable is involved in available as a Prolog term for
  591further reasoning within your program, use copy_term/3. For example:
  592
  593==
  594?- X #= Y + Z, X in 0..5, copy_term([X,Y,Z], [X,Y,Z], Gs).
  595Gs = [clpfd: (X in 0..5), clpfd: (Y+Z#=X)],
  596X in 0..5,
  597Y+Z#=X.
  598==
  599
  600This library also provides _reflection_ predicates (like fd_dom/2,
  601fd_size/2 etc.) with which we can inspect a variable's current
  602domain. These predicates can be useful if you want to implement your
  603own labeling strategies.
  604
  605## Core relations and search    {#clpfd-search}
  606
  607Using CLP(FD) constraints to solve combinatorial tasks typically
  608consists of two phases:
  609
  610    1. **Modeling**. In this phase, all relevant constraints are stated.
  611    2. **Search**. In this phase, _enumeration predicates_ are used
  612       to search for concrete solutions.
  613
  614It is good practice to keep the modeling part, via a dedicated
  615predicate called the *core relation*, separate from the actual
  616search for solutions. This lets us observe termination and
  617determinism properties of the core relation in isolation from the
  618search, and more easily try different search strategies.
  619
  620As an example of a constraint satisfaction problem, consider the
  621cryptoarithmetic puzzle SEND + MORE = MONEY, where different letters
  622denote distinct integers between 0 and 9. It can be modeled in CLP(FD)
  623as follows:
  624
  625==
  626puzzle([S,E,N,D] + [M,O,R,E] = [M,O,N,E,Y]) :-
  627        Vars = [S,E,N,D,M,O,R,Y],
  628        Vars ins 0..9,
  629        all_different(Vars),
  630                  S*1000 + E*100 + N*10 + D +
  631                  M*1000 + O*100 + R*10 + E #=
  632        M*10000 + O*1000 + N*100 + E*10 + Y,
  633        M #\= 0, S #\= 0.
  634==
  635
  636Notice that we are _not_ using labeling/2 in this predicate, so that
  637we can first execute and observe the modeling part in isolation.
  638Sample query and its result (actual variables replaced for
  639readability):
  640
  641==
  642?- puzzle(As+Bs=Cs).
  643As = [9, A2, A3, A4],
  644Bs = [1, 0, B3, A2],
  645Cs = [1, 0, A3, A2, C5],
  646A2 in 4..7,
  647all_different([9, A2, A3, A4, 1, 0, B3, C5]),
  64891*A2+A4+10*B3#=90*A3+C5,
  649A3 in 5..8,
  650A4 in 2..8,
  651B3 in 2..8,
  652C5 in 2..8.
  653==
  654
  655From this answer, we see that this core relation _terminates_ and is in
  656fact _deterministic_. Moreover, we see from the residual goals that
  657the constraint solver has deduced more stringent bounds for all
  658variables. Such observations are only possible if modeling and search
  659parts are cleanly separated.
  660
  661Labeling can then be used to search for solutions in a separate
  662predicate or goal:
  663
  664==
  665?- puzzle(As+Bs=Cs), label(As).
  666As = [9, 5, 6, 7],
  667Bs = [1, 0, 8, 5],
  668Cs = [1, 0, 6, 5, 2] ;
  669false.
  670==
  671
  672In this case, it suffices to label a subset of variables to find the
  673puzzle's unique solution, since the constraint solver is strong enough
  674to reduce the domains of remaining variables to singleton sets. In
  675general though, it is necessary to label all variables to obtain
  676ground solutions.
  677
  678## Example: Eight queens puzzle {#clpfd-n-queens}
  679
  680We illustrate the concepts of the preceding sections by means of the
  681so-called _eight queens puzzle_. The task is to place 8 queens on an
  6828x8 chessboard such that none of the queens is under attack. This
  683means that no two queens share the same row, column or diagonal.
  684
  685To express this puzzle via CLP(FD) constraints, we must first pick a
  686suitable representation. Since CLP(FD) constraints reason over
  687_integers_, we must find a way to map the positions of queens to
  688integers. Several such mappings are conceivable, and it is not
  689immediately obvious which we should use. On top of that, different
  690constraints can be used to express the desired relations. For such
  691reasons, _modeling_ combinatorial problems via CLP(FD) constraints
  692often necessitates some creativity and has been described as more of
  693an art than a science.
  694
  695In our concrete case, we observe that there must be exactly one queen
  696per column. The following representation therefore suggests itself: We
  697are looking for 8 integers, one for each column, where each integer
  698denotes the _row_ of the queen that is placed in the respective
  699column, and which are subject to certain constraints.
  700
  701In fact, let us now generalize the task to the so-called _N queens
  702puzzle_, which is obtained by replacing 8 by _N_ everywhere it occurs
  703in the above description. We implement the above considerations in the
  704**core relation** `n_queens/2`, where the first argument is the number
  705of queens (which is identical to the number of rows and columns of the
  706generalized chessboard), and the second argument is a list of _N_
  707integers that represents a solution in the form described above.
  708
  709==
  710n_queens(N, Qs) :-
  711        length(Qs, N),
  712        Qs ins 1..N,
  713        safe_queens(Qs).
  714
  715safe_queens([]).
  716safe_queens([Q|Qs]) :- safe_queens(Qs, Q, 1), safe_queens(Qs).
  717
  718safe_queens([], _, _).
  719safe_queens([Q|Qs], Q0, D0) :-
  720        Q0 #\= Q,
  721        abs(Q0 - Q) #\= D0,
  722        D1 #= D0 + 1,
  723        safe_queens(Qs, Q0, D1).
  724==
  725
  726Note that all these predicates can be used in _all directions_: We
  727can use them to _find_ solutions, _test_ solutions and _complete_
  728partially instantiated solutions.
  729
  730The original task can be readily solved with the following query:
  731
  732==
  733?- n_queens(8, Qs), label(Qs).
  734Qs = [1, 5, 8, 6, 3, 7, 2, 4] .
  735==
  736
  737Using suitable labeling strategies, we can easily find solutions with
  73880 queens and more:
  739
  740==
  741?- n_queens(80, Qs), labeling([ff], Qs).
  742Qs = [1, 3, 5, 44, 42, 4, 50, 7, 68|...] .
  743
  744?- time((n_queens(90, Qs), labeling([ff], Qs))).
  745% 5,904,401 inferences, 0.722 CPU in 0.737 seconds (98% CPU)
  746Qs = [1, 3, 5, 50, 42, 4, 49, 7, 59|...] .
  747==
  748
  749Experimenting with different search strategies is easy because we have
  750separated the core relation from the actual search.
  751
  752
  753
  754## Optimisation    {#clpfd-optimisation}
  755
  756We can use labeling/2 to minimize or maximize the value of a CLP(FD)
  757expression, and generate solutions in increasing or decreasing order
  758of the value. See the labeling options `min(Expr)` and `max(Expr)`,
  759respectively.
  760
  761Again, to easily try different labeling options in connection with
  762optimisation, we recommend to introduce a dedicated predicate for
  763posting constraints, and to use `labeling/2` in a separate goal. This
  764way, we can observe properties of the core relation in isolation,
  765and try different labeling options without recompiling our code.
  766
  767If necessary, we can use `once/1` to commit to the first optimal
  768solution. However, it is often very valuable to see alternative
  769solutions that are _also_ optimal, so that we can choose among optimal
  770solutions by other criteria. For the sake of
  771[**purity**](https://www.metalevel.at/prolog/purity) and
  772completeness, we recommend to avoid `once/1` and other constructs that
  773lead to impurities in CLP(FD) programs.
  774
  775Related to optimisation with CLP(FD) constraints are
  776[`library(simplex)`](http://eu.swi-prolog.org/man/simplex.html) and
  777CLP(Q) which reason about _linear_ constraints over rational numbers.
  778
  779## Reification				{#clpfd-reification}
  780
  781The constraints in/2, #=/2, #\=/2, #</2, #>/2, #=</2, and #>=/2 can be
  782_reified_, which means reflecting their truth values into Boolean
  783values represented by the integers 0 and 1. Let P and Q denote
  784reifiable constraints or Boolean variables, then:
  785
  786    | #\ Q      | True iff Q is false                  |
  787    | P #\/ Q   | True iff either P or Q               |
  788    | P #/\ Q   | True iff both P and Q                |
  789    | P #\ Q    | True iff either P or Q, but not both |
  790    | P #<==> Q | True iff P and Q are equivalent      |
  791    | P #==> Q  | True iff P implies Q                 |
  792    | P #<== Q  | True iff Q implies P                 |
  793
  794The constraints of this table are reifiable as well.
  795
  796When reasoning over Boolean variables, also consider using
  797CLP(B) constraints as provided by
  798[`library(clpb)`](http://eu.swi-prolog.org/man/clpb.html).
  799
  800## Enabling monotonic CLP(FD)		{#clpfd-monotonicity}
  801
  802In the default execution mode, CLP(FD) constraints still exhibit some
  803non-relational properties. For example, _adding_ constraints can yield
  804new solutions:
  805
  806==
  807?-          X #= 2, X = 1+1.
  808false.
  809
  810?- X = 1+1, X #= 2, X = 1+1.
  811X = 1+1.
  812==
  813
  814This behaviour is highly problematic from a logical point of view, and
  815it may render declarative debugging techniques inapplicable.
  816
  817Set the Prolog flag `clpfd_monotonic` to `true` to make CLP(FD)
  818**monotonic**: This means that _adding_ new constraints _cannot_ yield
  819new solutions. When this flag is `true`, we must wrap variables that
  820occur in arithmetic expressions with the functor `(?)/1` or `(#)/1`. For
  821example:
  822
  823==
  824?- set_prolog_flag(clpfd_monotonic, true).
  825true.
  826
  827?- #(X) #= #(Y) + #(Z).
  828#(Y)+ #(Z)#= #(X).
  829
  830?-          X #= 2, X = 1+1.
  831ERROR: Arguments are not sufficiently instantiated
  832==
  833
  834The wrapper can be omitted for variables that are already constrained
  835to integers.
  836
  837## Custom constraints			{#clpfd-custom-constraints}
  838
  839We can define custom constraints. The mechanism to do this is not yet
  840finalised, and we welcome suggestions and descriptions of use cases
  841that are important to you.
  842
  843As an example of how it can be done currently, let us define a new
  844custom constraint `oneground(X,Y,Z)`, where Z shall be 1 if at least
  845one of X and Y is instantiated:
  846
  847==
  848:- multifile clpfd:run_propagator/2.
  849
  850oneground(X, Y, Z) :-
  851        clpfd:make_propagator(oneground(X, Y, Z), Prop),
  852        clpfd:init_propagator(X, Prop),
  853        clpfd:init_propagator(Y, Prop),
  854        clpfd:trigger_once(Prop).
  855
  856clpfd:run_propagator(oneground(X, Y, Z), MState) :-
  857        (   integer(X) -> clpfd:kill(MState), Z = 1
  858        ;   integer(Y) -> clpfd:kill(MState), Z = 1
  859        ;   true
  860        ).
  861==
  862
  863First, clpfd:make_propagator/2 is used to transform a user-defined
  864representation of the new constraint to an internal form. With
  865clpfd:init_propagator/2, this internal form is then attached to X and
  866Y. From now on, the propagator will be invoked whenever the domains of
  867X or Y are changed. Then, clpfd:trigger_once/1 is used to give the
  868propagator its first chance for propagation even though the variables'
  869domains have not yet changed. Finally, clpfd:run_propagator/2 is
  870extended to define the actual propagator. As explained, this predicate
  871is automatically called by the constraint solver. The first argument
  872is the user-defined representation of the constraint as used in
  873clpfd:make_propagator/2, and the second argument is a mutable state
  874that can be used to prevent further invocations of the propagator when
  875the constraint has become entailed, by using clpfd:kill/1. An example
  876of using the new constraint:
  877
  878==
  879?- oneground(X, Y, Z), Y = 5.
  880Y = 5,
  881Z = 1,
  882X in inf..sup.
  883==
  884
  885## Applications   {#clpfd-applications}
  886
  887CLP(FD) applications that we find particularly impressive and worth
  888studying include:
  889
  890  * Michael Hendricks uses CLP(FD) constraints for flexible reasoning
  891    about _dates_ and _times_ in the
  892    [`julian`](http://www.swi-prolog.org/pack/list?p=julian) package.
  893  * Julien Cumin uses CLP(FD) constraints for integer arithmetic in
  894    [=Brachylog=](https://github.com/JCumin/Brachylog).
  895
  896## Acknowledgments {#clpfd-acknowledgments}
  897
  898This library gives you a glimpse of what [**SICStus
  899Prolog**](https://sicstus.sics.se/) can do. The API is intentionally
  900mostly compatible with that of SICStus Prolog, so that you can easily
  901switch to a much more feature-rich and much faster CLP(FD) system when
  902you need it. I thank [Mats Carlsson](https://www.sics.se/~matsc/), the
  903designer and main implementor of SICStus Prolog, for his elegant
  904example. I first encountered his system as part of the excellent
  905[**GUPU**](http://www.complang.tuwien.ac.at/ulrich/gupu/) teaching
  906environment by [Ulrich
  907Neumerkel](http://www.complang.tuwien.ac.at/ulrich/). Ulrich was also
  908the first and most determined tester of the present system, filing
  909hundreds of comments and suggestions for improvement. [Tom
  910Schrijvers](https://people.cs.kuleuven.be/~tom.schrijvers/) has
  911contributed several constraint libraries to SWI-Prolog, and I learned
  912a lot from his coding style and implementation examples. [Bart
  913Demoen](https://people.cs.kuleuven.be/~bart.demoen/) was a driving
  914force behind the implementation of attributed variables in SWI-Prolog,
  915and this library could not even have started without his prior work
  916and contributions. Thank you all!
  917
  918## CLP(FD) predicate index			{#clpfd-predicate-index}
  919
  920In the following, each CLP(FD) predicate is described in more detail.
  921
  922We recommend the following link to refer to this manual:
  923
  924http://eu.swi-prolog.org/man/clpfd.html
  925
  926@author [Markus Triska](https://www.metalevel.at)
  927*/
  928
  929:- create_prolog_flag(clpfd_monotonic, false, []).  930
  931/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  932   A bound is either:
  933
  934   n(N):    integer N
  935   inf:     infimum of Z (= negative infinity)
  936   sup:     supremum of Z (= positive infinity)
  937- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  938
  939is_bound(n(N)) :- integer(N).
  940is_bound(inf).
  941is_bound(sup).
  942
  943defaulty_to_bound(D, P) :- ( integer(D) -> P = n(D) ; P = D ).
  944
  945/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  946   Compactified is/2 and predicates for several arithmetic expressions
  947   with infinities, tailored for the modes needed by this solver.
  948- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  949
  950goal_expansion(A cis B, Expansion) :-
  951        phrase(cis_goals(B, A), Goals),
  952        list_goal(Goals, Expansion).
  953goal_expansion(A cis_lt B, B cis_gt A).
  954goal_expansion(A cis_leq B, B cis_geq A).
  955goal_expansion(A cis_geq B, cis_leq_numeric(B, N)) :- nonvar(A), A = n(N).
  956goal_expansion(A cis_geq B, cis_geq_numeric(A, N)) :- nonvar(B), B = n(N).
  957goal_expansion(A cis_gt B, cis_lt_numeric(B, N))   :- nonvar(A), A = n(N).
  958goal_expansion(A cis_gt B, cis_gt_numeric(A, N))   :- nonvar(B), B = n(N).
  959
  960% cis_gt only works for terms of depth 0 on both sides
  961cis_gt(sup, B0) :- B0 \== sup.
  962cis_gt(n(N), B) :- cis_lt_numeric(B, N).
  963
  964cis_lt_numeric(inf, _).
  965cis_lt_numeric(n(B), A) :- B < A.
  966
  967cis_gt_numeric(sup, _).
  968cis_gt_numeric(n(B), A) :- B > A.
  969
  970cis_geq(inf, inf).
  971cis_geq(sup, _).
  972cis_geq(n(N), B) :- cis_leq_numeric(B, N).
  973
  974cis_leq_numeric(inf, _).
  975cis_leq_numeric(n(B), A) :- B =< A.
  976
  977cis_geq_numeric(sup, _).
  978cis_geq_numeric(n(B), A) :- B >= A.
  979
  980cis_min(inf, _, inf).
  981cis_min(sup, B, B).
  982cis_min(n(N), B, Min) :- cis_min_(B, N, Min).
  983
  984cis_min_(inf, _, inf).
  985cis_min_(sup, N, n(N)).
  986cis_min_(n(B), A, n(M)) :- M is min(A,B).
  987
  988cis_max(sup, _, sup).
  989cis_max(inf, B, B).
  990cis_max(n(N), B, Max) :- cis_max_(B, N, Max).
  991
  992cis_max_(inf, N, n(N)).
  993cis_max_(sup, _, sup).
  994cis_max_(n(B), A, n(M)) :- M is max(A,B).
  995
  996cis_plus(inf, _, inf).
  997cis_plus(sup, _, sup).
  998cis_plus(n(A), B, Plus) :- cis_plus_(B, A, Plus).
  999
 1000cis_plus_(sup, _, sup).
 1001cis_plus_(inf, _, inf).
 1002cis_plus_(n(B), A, n(S)) :- S is A + B.
 1003
 1004cis_minus(inf, _, inf).
 1005cis_minus(sup, _, sup).
 1006cis_minus(n(A), B, M) :- cis_minus_(B, A, M).
 1007
 1008cis_minus_(inf, _, sup).
 1009cis_minus_(sup, _, inf).
 1010cis_minus_(n(B), A, n(M)) :- M is A - B.
 1011
 1012cis_uminus(inf, sup).
 1013cis_uminus(sup, inf).
 1014cis_uminus(n(A), n(B)) :- B is -A.
 1015
 1016cis_abs(inf, sup).
 1017cis_abs(sup, sup).
 1018cis_abs(n(A), n(B)) :- B is abs(A).
 1019
 1020cis_times(inf, B, P) :-
 1021        (   B cis_lt n(0) -> P = sup
 1022        ;   B cis_gt n(0) -> P = inf
 1023        ;   P = n(0)
 1024        ).
 1025cis_times(sup, B, P) :-
 1026        (   B cis_gt n(0) -> P = sup
 1027        ;   B cis_lt n(0) -> P = inf
 1028        ;   P = n(0)
 1029        ).
 1030cis_times(n(N), B, P) :- cis_times_(B, N, P).
 1031
 1032cis_times_(inf, A, P)     :- cis_times(inf, n(A), P).
 1033cis_times_(sup, A, P)     :- cis_times(sup, n(A), P).
 1034cis_times_(n(B), A, n(P)) :- P is A * B.
 1035
 1036cis_exp(inf, n(Y), R) :-
 1037        (   even(Y) -> R = sup
 1038        ;   R = inf
 1039        ).
 1040cis_exp(sup, _, sup).
 1041cis_exp(n(N), Y, R) :- cis_exp_(Y, N, R).
 1042
 1043cis_exp_(n(Y), N, n(R)) :- R is N^Y.
 1044cis_exp_(sup, _, sup).
 1045cis_exp_(inf, _, inf).
 1046
 1047cis_goals(V, V)          --> { var(V) }, !.
 1048cis_goals(n(N), n(N))    --> [].
 1049cis_goals(inf, inf)      --> [].
 1050cis_goals(sup, sup)      --> [].
 1051cis_goals(sign(A0), R)   --> cis_goals(A0, A), [cis_sign(A, R)].
 1052cis_goals(abs(A0), R)    --> cis_goals(A0, A), [cis_abs(A, R)].
 1053cis_goals(-A0, R)        --> cis_goals(A0, A), [cis_uminus(A, R)].
 1054cis_goals(A0+B0, R)      -->
 1055        cis_goals(A0, A),
 1056        cis_goals(B0, B),
 1057        [cis_plus(A, B, R)].
 1058cis_goals(A0-B0, R)      -->
 1059        cis_goals(A0, A),
 1060        cis_goals(B0, B),
 1061        [cis_minus(A, B, R)].
 1062cis_goals(min(A0,B0), R) -->
 1063        cis_goals(A0, A),
 1064        cis_goals(B0, B),
 1065        [cis_min(A, B, R)].
 1066cis_goals(max(A0,B0), R) -->
 1067        cis_goals(A0, A),
 1068        cis_goals(B0, B),
 1069        [cis_max(A, B, R)].
 1070cis_goals(A0*B0, R)      -->
 1071        cis_goals(A0, A),
 1072        cis_goals(B0, B),
 1073        [cis_times(A, B, R)].
 1074cis_goals(div(A0,B0), R) -->
 1075        cis_goals(A0, A),
 1076        cis_goals(B0, B),
 1077        [cis_div(A, B, R)].
 1078cis_goals(A0//B0, R)     -->
 1079        cis_goals(A0, A),
 1080        cis_goals(B0, B),
 1081        [cis_slash(A, B, R)].
 1082cis_goals(A0^B0, R)      -->
 1083        cis_goals(A0, A),
 1084        cis_goals(B0, B),
 1085        [cis_exp(A, B, R)].
 1086
 1087list_goal([], true).
 1088list_goal([G|Gs], Goal) :- foldl(list_goal_, Gs, G, Goal).
 1089
 1090list_goal_(G, G0, (G0,G)).
 1091
 1092cis_sign(sup, n(1)).
 1093cis_sign(inf, n(-1)).
 1094cis_sign(n(N), n(S)) :- S is sign(N).
 1095
 1096cis_div(sup, Y, Z)  :- ( Y cis_geq n(0) -> Z = sup ; Z = inf ).
 1097cis_div(inf, Y, Z)  :- ( Y cis_geq n(0) -> Z = inf ; Z = sup ).
 1098cis_div(n(X), Y, Z) :- cis_div_(Y, X, Z).
 1099
 1100cis_div_(sup, _, n(0)).
 1101cis_div_(inf, _, n(0)).
 1102cis_div_(n(Y), X, Z) :-
 1103        (   Y =:= 0 -> (  X >= 0 -> Z = sup ; Z = inf )
 1104        ;   Z0 is X // Y, Z = n(Z0)
 1105        ).
 1106
 1107cis_slash(sup, _, sup).
 1108cis_slash(inf, _, inf).
 1109cis_slash(n(N), B, S) :- cis_slash_(B, N, S).
 1110
 1111cis_slash_(sup, _, n(0)).
 1112cis_slash_(inf, _, n(0)).
 1113cis_slash_(n(B), A, n(S)) :- S is A // B.
 1114
 1115
 1116/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1117   A domain is a finite set of disjoint intervals. Internally, domains
 1118   are represented as trees. Each node is one of:
 1119
 1120   empty: empty domain.
 1121
 1122   split(N, Left, Right)
 1123      - split on integer N, with Left and Right domains whose elements are
 1124        all less than and greater than N, respectively. The domain is the
 1125        union of Left and Right, i.e., N is a hole.
 1126
 1127   from_to(From, To)
 1128      - interval (From-1, To+1); From and To are bounds
 1129
 1130   Desiderata: rebalance domains; singleton intervals.
 1131- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1132
 1133/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1134   Type definition and inspection of domains.
 1135- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1136
 1137check_domain(D) :-
 1138        (   var(D) -> instantiation_error(D)
 1139        ;   is_domain(D) -> true
 1140        ;   domain_error(clpfd_domain, D)
 1141        ).
 1142
 1143is_domain(empty).
 1144is_domain(from_to(From,To)) :-
 1145        is_bound(From), is_bound(To),
 1146        From cis_leq To.
 1147is_domain(split(S, Left, Right)) :-
 1148        integer(S),
 1149        is_domain(Left), is_domain(Right),
 1150        all_less_than(Left, S),
 1151        all_greater_than(Right, S).
 1152
 1153all_less_than(empty, _).
 1154all_less_than(from_to(From,To), S) :-
 1155        From cis_lt n(S), To cis_lt n(S).
 1156all_less_than(split(S0,Left,Right), S) :-
 1157        S0 < S,
 1158        all_less_than(Left, S),
 1159        all_less_than(Right, S).
 1160
 1161all_greater_than(empty, _).
 1162all_greater_than(from_to(From,To), S) :-
 1163        From cis_gt n(S), To cis_gt n(S).
 1164all_greater_than(split(S0,Left,Right), S) :-
 1165        S0 > S,
 1166        all_greater_than(Left, S),
 1167        all_greater_than(Right, S).
 1168
 1169default_domain(from_to(inf,sup)).
 1170
 1171domain_infimum(from_to(I, _), I).
 1172domain_infimum(split(_, Left, _), I) :- domain_infimum(Left, I).
 1173
 1174domain_supremum(from_to(_, S), S).
 1175domain_supremum(split(_, _, Right), S) :- domain_supremum(Right, S).
 1176
 1177domain_num_elements(empty, n(0)).
 1178domain_num_elements(from_to(From,To), Num) :- Num cis To - From + n(1).
 1179domain_num_elements(split(_, Left, Right), Num) :-
 1180        domain_num_elements(Left, NL),
 1181        domain_num_elements(Right, NR),
 1182        Num cis NL + NR.
 1183
 1184domain_direction_element(from_to(n(From), n(To)), Dir, E) :-
 1185        (   Dir == up -> between(From, To, E)
 1186        ;   between(From, To, E0),
 1187            E is To - (E0 - From)
 1188        ).
 1189domain_direction_element(split(_, D1, D2), Dir, E) :-
 1190        (   Dir == up ->
 1191            (   domain_direction_element(D1, Dir, E)
 1192            ;   domain_direction_element(D2, Dir, E)
 1193            )
 1194        ;   (   domain_direction_element(D2, Dir, E)
 1195            ;   domain_direction_element(D1, Dir, E)
 1196            )
 1197        ).
 1198
 1199/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1200   Test whether domain contains a given integer.
 1201- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1202
 1203domain_contains(from_to(From,To), I) :- From cis_leq n(I), n(I) cis_leq To.
 1204domain_contains(split(S, Left, Right), I) :-
 1205        (   I < S -> domain_contains(Left, I)
 1206        ;   I > S -> domain_contains(Right, I)
 1207        ).
 1208
 1209/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1210   Test whether a domain contains another domain.
 1211- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1212
 1213domain_subdomain(Dom, Sub) :- domain_subdomain(Dom, Dom, Sub).
 1214
 1215domain_subdomain(from_to(_,_), Dom, Sub) :-
 1216        domain_subdomain_fromto(Sub, Dom).
 1217domain_subdomain(split(_, _, _), Dom, Sub) :-
 1218        domain_subdomain_split(Sub, Dom, Sub).
 1219
 1220domain_subdomain_split(empty, _, _).
 1221domain_subdomain_split(from_to(From,To), split(S,Left0,Right0), Sub) :-
 1222        (   To cis_lt n(S) -> domain_subdomain(Left0, Left0, Sub)
 1223        ;   From cis_gt n(S) -> domain_subdomain(Right0, Right0, Sub)
 1224        ).
 1225domain_subdomain_split(split(_,Left,Right), Dom, _) :-
 1226        domain_subdomain(Dom, Dom, Left),
 1227        domain_subdomain(Dom, Dom, Right).
 1228
 1229domain_subdomain_fromto(empty, _).
 1230domain_subdomain_fromto(from_to(From,To), from_to(From0,To0)) :-
 1231        From0 cis_leq From, To0 cis_geq To.
 1232domain_subdomain_fromto(split(_,Left,Right), Dom) :-
 1233        domain_subdomain_fromto(Left, Dom),
 1234        domain_subdomain_fromto(Right, Dom).
 1235
 1236/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1237   Remove an integer from a domain. The domain is traversed until an
 1238   interval is reached from which the element can be removed, or until
 1239   it is clear that no such interval exists.
 1240- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1241
 1242domain_remove(empty, _, empty).
 1243domain_remove(from_to(L0, U0), X, D) :- domain_remove_(L0, U0, X, D).
 1244domain_remove(split(S, Left0, Right0), X, D) :-
 1245        (   X =:= S -> D = split(S, Left0, Right0)
 1246        ;   X < S ->
 1247            domain_remove(Left0, X, Left1),
 1248            (   Left1 == empty -> D = Right0
 1249            ;   D = split(S, Left1, Right0)
 1250            )
 1251        ;   domain_remove(Right0, X, Right1),
 1252            (   Right1 == empty -> D = Left0
 1253            ;   D = split(S, Left0, Right1)
 1254            )
 1255        ).
 1256
 1257%?- domain_remove(from_to(n(0),n(5)), 3, D).
 1258
 1259domain_remove_(inf, U0, X, D) :-
 1260        (   U0 == n(X) -> U1 is X - 1, D = from_to(inf, n(U1))
 1261        ;   U0 cis_lt n(X) -> D = from_to(inf,U0)
 1262        ;   L1 is X + 1, U1 is X - 1,
 1263            D = split(X, from_to(inf, n(U1)), from_to(n(L1),U0))
 1264        ).
 1265domain_remove_(n(N), U0, X, D) :- domain_remove_upper(U0, N, X, D).
 1266
 1267domain_remove_upper(sup, L0, X, D) :-
 1268        (   L0 =:= X -> L1 is X + 1, D = from_to(n(L1),sup)
 1269        ;   L0 > X -> D = from_to(n(L0),sup)
 1270        ;   L1 is X + 1, U1 is X - 1,
 1271            D = split(X, from_to(n(L0),n(U1)), from_to(n(L1),sup))
 1272        ).
 1273domain_remove_upper(n(U0), L0, X, D) :-
 1274        (   L0 =:= U0, X =:= L0 -> D = empty
 1275        ;   L0 =:= X -> L1 is X + 1, D = from_to(n(L1), n(U0))
 1276        ;   U0 =:= X -> U1 is X - 1, D = from_to(n(L0), n(U1))
 1277        ;   between(L0, U0, X) ->
 1278            U1 is X - 1, L1 is X + 1,
 1279            D = split(X, from_to(n(L0), n(U1)), from_to(n(L1), n(U0)))
 1280        ;   D = from_to(n(L0),n(U0))
 1281        ).
 1282
 1283/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1284   Remove all elements greater than / less than a constant.
 1285- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1286
 1287domain_remove_greater_than(empty, _, empty).
 1288domain_remove_greater_than(from_to(From0,To0), G, D) :-
 1289        (   From0 cis_gt n(G) -> D = empty
 1290        ;   To cis min(To0,n(G)), D = from_to(From0,To)
 1291        ).
 1292domain_remove_greater_than(split(S,Left0,Right0), G, D) :-
 1293        (   S =< G ->
 1294            domain_remove_greater_than(Right0, G, Right),
 1295            (   Right == empty -> D = Left0
 1296            ;   D = split(S, Left0, Right)
 1297            )
 1298        ;   domain_remove_greater_than(Left0, G, D)
 1299        ).
 1300
 1301domain_remove_smaller_than(empty, _, empty).
 1302domain_remove_smaller_than(from_to(From0,To0), V, D) :-
 1303        (   To0 cis_lt n(V) -> D = empty
 1304        ;   From cis max(From0,n(V)), D = from_to(From,To0)
 1305        ).
 1306domain_remove_smaller_than(split(S,Left0,Right0), V, D) :-
 1307        (   S >= V ->
 1308            domain_remove_smaller_than(Left0, V, Left),
 1309            (   Left == empty -> D = Right0
 1310            ;   D = split(S, Left, Right0)
 1311            )
 1312        ;   domain_remove_smaller_than(Right0, V, D)
 1313        ).
 1314
 1315
 1316/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1317   Remove a whole domain from another domain. (Set difference.)
 1318- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1319
 1320domain_subtract(Dom0, Sub, Dom) :- domain_subtract(Dom0, Dom0, Sub, Dom).
 1321
 1322domain_subtract(empty, _, _, empty).
 1323domain_subtract(from_to(From0,To0), Dom, Sub, D) :-
 1324        (   Sub == empty -> D = Dom
 1325        ;   Sub = from_to(From,To) ->
 1326            (   From == To -> From = n(X), domain_remove(Dom, X, D)
 1327            ;   From cis_gt To0 -> D = Dom
 1328            ;   To cis_lt From0 -> D = Dom
 1329            ;   From cis_leq From0 ->
 1330                (   To cis_geq To0 -> D = empty
 1331                ;   From1 cis To + n(1),
 1332                    D = from_to(From1, To0)
 1333                )
 1334            ;   To1 cis From - n(1),
 1335                (   To cis_lt To0 ->
 1336                    From = n(S),
 1337                    From2 cis To + n(1),
 1338                    D = split(S,from_to(From0,To1),from_to(From2,To0))
 1339                ;   D = from_to(From0,To1)
 1340                )
 1341            )
 1342        ;   Sub = split(S, Left, Right) ->
 1343            (   n(S) cis_gt To0 -> domain_subtract(Dom, Dom, Left, D)
 1344            ;   n(S) cis_lt From0 -> domain_subtract(Dom, Dom, Right, D)
 1345            ;   domain_subtract(Dom, Dom, Left, D1),
 1346                domain_subtract(D1, D1, Right, D)
 1347            )
 1348        ).
 1349domain_subtract(split(S, Left0, Right0), _, Sub, D) :-
 1350        domain_subtract(Left0, Left0, Sub, Left),
 1351        domain_subtract(Right0, Right0, Sub, Right),
 1352        (   Left == empty -> D = Right
 1353        ;   Right == empty -> D = Left
 1354        ;   D = split(S, Left, Right)
 1355        ).
 1356
 1357/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1358   Complement of a domain
 1359- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1360
 1361domain_complement(D, C) :-
 1362        default_domain(Default),
 1363        domain_subtract(Default, D, C).
 1364
 1365/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1366   Convert domain to a list of disjoint intervals From-To.
 1367- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1368
 1369domain_intervals(D, Is) :- phrase(domain_intervals(D), Is).
 1370
 1371domain_intervals(split(_, Left, Right)) -->
 1372        domain_intervals(Left), domain_intervals(Right).
 1373domain_intervals(empty)                 --> [].
 1374domain_intervals(from_to(From,To))      --> [From-To].
 1375
 1376/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1377   To compute the intersection of two domains D1 and D2, we choose D1
 1378   as the reference domain. For each interval of D1, we compute how
 1379   far and to which values D2 lets us extend it.
 1380- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1381
 1382domains_intersection(D1, D2, Intersection) :-
 1383        domains_intersection_(D1, D2, Intersection),
 1384        Intersection \== empty.
 1385
 1386domains_intersection_(empty, _, empty).
 1387domains_intersection_(from_to(L0,U0), D2, Dom) :-
 1388        narrow(D2, L0, U0, Dom).
 1389domains_intersection_(split(S,Left0,Right0), D2, Dom) :-
 1390        domains_intersection_(Left0, D2, Left1),
 1391        domains_intersection_(Right0, D2, Right1),
 1392        (   Left1 == empty -> Dom = Right1
 1393        ;   Right1 == empty -> Dom = Left1
 1394        ;   Dom = split(S, Left1, Right1)
 1395        ).
 1396
 1397narrow(empty, _, _, empty).
 1398narrow(from_to(L0,U0), From0, To0, Dom) :-
 1399        From1 cis max(From0,L0), To1 cis min(To0,U0),
 1400        (   From1 cis_gt To1 -> Dom = empty
 1401        ;   Dom = from_to(From1,To1)
 1402        ).
 1403narrow(split(S, Left0, Right0), From0, To0, Dom) :-
 1404        (   To0 cis_lt n(S) -> narrow(Left0, From0, To0, Dom)
 1405        ;   From0 cis_gt n(S) -> narrow(Right0, From0, To0, Dom)
 1406        ;   narrow(Left0, From0, To0, Left1),
 1407            narrow(Right0, From0, To0, Right1),
 1408            (   Left1 == empty -> Dom = Right1
 1409            ;   Right1 == empty -> Dom = Left1
 1410            ;   Dom = split(S, Left1, Right1)
 1411            )
 1412        ).
 1413
 1414/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1415   Union of 2 domains.
 1416- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1417
 1418domains_union(D1, D2, Union) :-
 1419        domain_intervals(D1, Is1),
 1420        domain_intervals(D2, Is2),
 1421        append(Is1, Is2, IsU0),
 1422        merge_intervals(IsU0, IsU1),
 1423        intervals_to_domain(IsU1, Union).
 1424
 1425/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1426   Shift the domain by an offset.
 1427- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1428
 1429domain_shift(empty, _, empty).
 1430domain_shift(from_to(From0,To0), O, from_to(From,To)) :-
 1431        From cis From0 + n(O), To cis To0 + n(O).
 1432domain_shift(split(S0, Left0, Right0), O, split(S, Left, Right)) :-
 1433        S is S0 + O,
 1434        domain_shift(Left0, O, Left),
 1435        domain_shift(Right0, O, Right).
 1436
 1437/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1438   The new domain contains all values of the old domain,
 1439   multiplied by a constant multiplier.
 1440- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1441
 1442domain_expand(D0, M, D) :-
 1443        (   M < 0 ->
 1444            domain_negate(D0, D1),
 1445            M1 is abs(M),
 1446            domain_expand_(D1, M1, D)
 1447        ;   M =:= 1 -> D = D0
 1448        ;   domain_expand_(D0, M, D)
 1449        ).
 1450
 1451domain_expand_(empty, _, empty).
 1452domain_expand_(from_to(From0, To0), M, from_to(From,To)) :-
 1453        From cis From0*n(M),
 1454        To cis To0*n(M).
 1455domain_expand_(split(S0, Left0, Right0), M, split(S, Left, Right)) :-
 1456        S is M*S0,
 1457        domain_expand_(Left0, M, Left),
 1458        domain_expand_(Right0, M, Right).
 1459
 1460/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1461   similar to domain_expand/3, tailored for truncated division: an
 1462   interval [From,To] is extended to [From*M, ((To+1)*M - 1)], i.e.,
 1463   to all values that truncated integer-divided by M yield a value
 1464   from interval.
 1465- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1466
 1467domain_expand_more(D0, M, D) :-
 1468        %format("expanding ~w by ~w\n", [D0,M]),
 1469        (   M < 0 -> domain_negate(D0, D1), M1 is abs(M)
 1470        ;   D1 = D0, M1 = M
 1471        ),
 1472        domain_expand_more_(D1, M1, D).
 1473        %format("yield: ~w\n", [D]).
 1474
 1475domain_expand_more_(empty, _, empty).
 1476domain_expand_more_(from_to(From0, To0), M, from_to(From,To)) :-
 1477        (   From0 cis_leq n(0) ->
 1478            From cis (From0-n(1))*n(M) + n(1)
 1479        ;   From cis From0*n(M)
 1480        ),
 1481        (   To0 cis_lt n(0) ->
 1482            To cis To0*n(M)
 1483        ;   To cis (To0+n(1))*n(M) - n(1)
 1484        ).
 1485domain_expand_more_(split(S0, Left0, Right0), M, split(S, Left, Right)) :-
 1486        S is M*S0,
 1487        domain_expand_more_(Left0, M, Left),
 1488        domain_expand_more_(Right0, M, Right).
 1489
 1490/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1491   Scale a domain down by a constant multiplier. Assuming (//)/2.
 1492- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1493
 1494domain_contract(D0, M, D) :-
 1495        %format("contracting ~w by ~w\n", [D0,M]),
 1496        (   M < 0 -> domain_negate(D0, D1), M1 is abs(M)
 1497        ;   D1 = D0, M1 = M
 1498        ),
 1499        domain_contract_(D1, M1, D).
 1500
 1501domain_contract_(empty, _, empty).
 1502domain_contract_(from_to(From0, To0), M, from_to(From,To)) :-
 1503        (   From0 cis_geq n(0) ->
 1504            From cis (From0 + n(M) - n(1)) // n(M)
 1505        ;   From cis From0 // n(M)
 1506        ),
 1507        (   To0 cis_geq n(0) ->
 1508            To cis To0 // n(M)
 1509        ;   To cis (To0 - n(M) + n(1)) // n(M)
 1510        ).
 1511domain_contract_(split(_,Left0,Right0), M, D) :-
 1512        %  Scaled down domains do not necessarily retain any holes of
 1513        %  the original domain.
 1514        domain_contract_(Left0, M, Left),
 1515        domain_contract_(Right0, M, Right),
 1516        domains_union(Left, Right, D).
 1517
 1518/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1519   Similar to domain_contract, tailored for division, i.e.,
 1520   {21,23} contracted by 4 is 5. It contracts "less".
 1521- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1522
 1523domain_contract_less(D0, M, D) :-
 1524        (   M < 0 -> domain_negate(D0, D1), M1 is abs(M)
 1525        ;   D1 = D0, M1 = M
 1526        ),
 1527        domain_contract_less_(D1, M1, D).
 1528
 1529domain_contract_less_(empty, _, empty).
 1530domain_contract_less_(from_to(From0, To0), M, from_to(From,To)) :-
 1531        From cis From0 // n(M), To cis To0 // n(M).
 1532domain_contract_less_(split(_,Left0,Right0), M, D) :-
 1533        %  Scaled down domains do not necessarily retain any holes of
 1534        %  the original domain.
 1535        domain_contract_less_(Left0, M, Left),
 1536        domain_contract_less_(Right0, M, Right),
 1537        domains_union(Left, Right, D).
 1538
 1539/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1540   Negate the domain. Left and Right sub-domains and bounds switch sides.
 1541- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1542
 1543domain_negate(empty, empty).
 1544domain_negate(from_to(From0, To0), from_to(From, To)) :-
 1545        From cis -To0, To cis -From0.
 1546domain_negate(split(S0, Left0, Right0), split(S, Left, Right)) :-
 1547        S is -S0,
 1548        domain_negate(Left0, Right),
 1549        domain_negate(Right0, Left).
 1550
 1551/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1552   Construct a domain from a list of integers. Try to balance it.
 1553- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1554
 1555list_to_disjoint_intervals([], []).
 1556list_to_disjoint_intervals([N|Ns], Is) :-
 1557        list_to_disjoint_intervals(Ns, N, N, Is).
 1558
 1559list_to_disjoint_intervals([], M, N, [n(M)-n(N)]).
 1560list_to_disjoint_intervals([B|Bs], M, N, Is) :-
 1561        (   B =:= N + 1 ->
 1562            list_to_disjoint_intervals(Bs, M, B, Is)
 1563        ;   Is = [n(M)-n(N)|Rest],
 1564            list_to_disjoint_intervals(Bs, B, B, Rest)
 1565        ).
 1566
 1567list_to_domain(List0, D) :-
 1568        (   List0 == [] -> D = empty
 1569        ;   sort(List0, List),
 1570            list_to_disjoint_intervals(List, Is),
 1571            intervals_to_domain(Is, D)
 1572        ).
 1573
 1574intervals_to_domain([], empty) :- !.
 1575intervals_to_domain([M-N], from_to(M,N)) :- !.
 1576intervals_to_domain(Is, D) :-
 1577        length(Is, L),
 1578        FL is L // 2,
 1579        length(Front, FL),
 1580        append(Front, Tail, Is),
 1581        Tail = [n(Start)-_|_],
 1582        Hole is Start - 1,
 1583        intervals_to_domain(Front, Left),
 1584        intervals_to_domain(Tail, Right),
 1585        D = split(Hole, Left, Right).
 1586
 1587%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1588
 1589
 1590%% ?Var in +Domain
 1591%
 1592%  Var is an element of Domain. Domain is one of:
 1593%
 1594%         * Integer
 1595%           Singleton set consisting only of _Integer_.
 1596%         * Lower..Upper
 1597%           All integers _I_ such that _Lower_ =< _I_ =< _Upper_.
 1598%           _Lower_ must be an integer or the atom *inf*, which
 1599%           denotes negative infinity. _Upper_ must be an integer or
 1600%           the atom *sup*, which denotes positive infinity.
 1601%         * Domain1 \/ Domain2
 1602%           The union of Domain1 and Domain2.
 1603
 1604Var in Dom :- clpfd_in(Var, Dom).
 1605
 1606clpfd_in(V, D) :-
 1607        fd_variable(V),
 1608        drep_to_domain(D, Dom),
 1609        domain(V, Dom).
 1610
 1611fd_variable(V) :-
 1612        (   var(V) -> true
 1613        ;   integer(V) -> true
 1614        ;   type_error(integer, V)
 1615        ).
 1616
 1617%% +Vars ins +Domain
 1618%
 1619%  The variables in the list Vars are elements of Domain. See in/2 for
 1620%  the syntax of Domain.
 1621
 1622Vs ins D :-
 1623        fd_must_be_list(Vs),
 1624        maplist(fd_variable, Vs),
 1625        drep_to_domain(D, Dom),
 1626        domains(Vs, Dom).
 1627
 1628fd_must_be_list(Ls) :-
 1629        (   fd_var(Ls) -> type_error(list, Ls)
 1630        ;   must_be(list, Ls)
 1631        ).
 1632
 1633%% indomain(?Var)
 1634%
 1635% Bind Var to all feasible values of its domain on backtracking. The
 1636% domain of Var must be finite.
 1637
 1638indomain(Var) :- label([Var]).
 1639
 1640order_dom_next(up, Dom, Next)   :- domain_infimum(Dom, n(Next)).
 1641order_dom_next(down, Dom, Next) :- domain_supremum(Dom, n(Next)).
 1642order_dom_next(random_value(_), Dom, Next) :-
 1643        phrase(domain_to_intervals(Dom), Is),
 1644        length(Is, L),
 1645        R is random(L),
 1646        nth0(R, Is, From-To),
 1647        random_between(From, To, Next).
 1648
 1649domain_to_intervals(from_to(n(From),n(To))) --> [From-To].
 1650domain_to_intervals(split(_, Left, Right)) -->
 1651        domain_to_intervals(Left),
 1652        domain_to_intervals(Right).
 1653
 1654%% label(+Vars)
 1655%
 1656% Equivalent to labeling([], Vars). See labeling/2.
 1657
 1658label(Vs) :- labeling([], Vs).
 1659
 1660%% labeling(+Options, +Vars)
 1661%
 1662% Assign a value to each variable in Vars. Labeling means systematically
 1663% trying out values for the finite domain   variables  Vars until all of
 1664% them are ground. The domain of each   variable in Vars must be finite.
 1665% Options is a list of options that   let  you exhibit some control over
 1666% the search process. Several categories of options exist:
 1667%
 1668% The variable selection strategy lets you specify which variable of
 1669% Vars is labeled next and is one of:
 1670%
 1671%   * leftmost
 1672%   Label the variables in the order they occur in Vars. This is the
 1673%   default.
 1674%
 1675%   * ff
 1676%   _|First fail|_. Label the leftmost variable with smallest domain next,
 1677%   in order to detect infeasibility early. This is often a good
 1678%   strategy.
 1679%
 1680%   * ffc
 1681%   Of the variables with smallest domains, the leftmost one
 1682%   participating in most constraints is labeled next.
 1683%
 1684%   * min
 1685%   Label the leftmost variable whose lower bound is the lowest next.
 1686%
 1687%   * max
 1688%   Label the leftmost variable whose upper bound is the highest next.
 1689%
 1690% The value order is one of:
 1691%
 1692%   * up
 1693%   Try the elements of the chosen variable's domain in ascending order.
 1694%   This is the default.
 1695%
 1696%   * down
 1697%   Try the domain elements in descending order.
 1698%
 1699% The branching strategy is one of:
 1700%
 1701%   * step
 1702%   For each variable X, a choice is made between X = V and X #\= V,
 1703%   where V is determined by the value ordering options. This is the
 1704%   default.
 1705%
 1706%   * enum
 1707%   For each variable X, a choice is made between X = V_1, X = V_2
 1708%   etc., for all values V_i of the domain of X. The order is
 1709%   determined by the value ordering options.
 1710%
 1711%   * bisect
 1712%   For each variable X, a choice is made between X #=< M and X #> M,
 1713%   where M is the midpoint of the domain of X.
 1714%
 1715% At most one option of each category can be specified, and an option
 1716% must not occur repeatedly.
 1717%
 1718% The order of solutions can be influenced with:
 1719%
 1720%   * min(Expr)
 1721%   * max(Expr)
 1722%
 1723% This generates solutions in ascending/descending order with respect
 1724% to the evaluation of the arithmetic expression Expr. Labeling Vars
 1725% must make Expr ground. If several such options are specified, they
 1726% are interpreted from left to right, e.g.:
 1727%
 1728% ==
 1729% ?- [X,Y] ins 10..20, labeling([max(X),min(Y)],[X,Y]).
 1730% ==
 1731%
 1732% This generates solutions in descending order of X, and for each
 1733% binding of X, solutions are generated in ascending order of Y. To
 1734% obtain the incomplete behaviour that other systems exhibit with
 1735% "maximize(Expr)" and "minimize(Expr)", use once/1, e.g.:
 1736%
 1737% ==
 1738% once(labeling([max(Expr)], Vars))
 1739% ==
 1740%
 1741% Labeling is always complete, always terminates, and yields no
 1742% redundant solutions. See [core relations and
 1743% search](<#clpfd-search>) for usage advice.
 1744
 1745labeling(Options, Vars) :-
 1746        must_be(list, Options),
 1747        fd_must_be_list(Vars),
 1748        maplist(must_be_finite_fdvar, Vars),
 1749        label(Options, Options, default(leftmost), default(up), default(step), [], upto_ground, Vars).
 1750
 1751finite_domain(Dom) :-
 1752        domain_infimum(Dom, n(_)),
 1753        domain_supremum(Dom, n(_)).
 1754
 1755must_be_finite_fdvar(Var) :-
 1756        (   fd_get(Var, Dom, _) ->
 1757            (   finite_domain(Dom) -> true
 1758            ;   instantiation_error(Var)
 1759            )
 1760        ;   integer(Var) -> true
 1761        ;   must_be(integer, Var)
 1762        ).
 1763
 1764
 1765label([O|Os], Options, Selection, Order, Choice, Optim, Consistency, Vars) :-
 1766        (   var(O)-> instantiation_error(O)
 1767        ;   override(selection, Selection, O, Options, S1) ->
 1768            label(Os, Options, S1, Order, Choice, Optim, Consistency, Vars)
 1769        ;   override(order, Order, O, Options, O1) ->
 1770            label(Os, Options, Selection, O1, Choice, Optim, Consistency, Vars)
 1771        ;   override(choice, Choice, O, Options, C1) ->
 1772            label(Os, Options, Selection, Order, C1, Optim, Consistency, Vars)
 1773        ;   optimisation(O) ->
 1774            label(Os, Options, Selection, Order, Choice, [O|Optim], Consistency, Vars)
 1775        ;   consistency(O, O1) ->
 1776            label(Os, Options, Selection, Order, Choice, Optim, O1, Vars)
 1777        ;   domain_error(labeling_option, O)
 1778        ).
 1779label([], _, Selection, Order, Choice, Optim0, Consistency, Vars) :-
 1780        maplist(arg(1), [Selection,Order,Choice], [S,O,C]),
 1781        (   Optim0 == [] ->
 1782            label(Vars, S, O, C, Consistency)
 1783        ;   reverse(Optim0, Optim),
 1784            exprs_singlevars(Optim, SVs),
 1785            optimise(Vars, [S,O,C], SVs)
 1786        ).
 1787
 1788% Introduce new variables for each min/max expression to avoid
 1789% reparsing expressions during optimisation.
 1790
 1791exprs_singlevars([], []).
 1792exprs_singlevars([E|Es], [SV|SVs]) :-
 1793        E =.. [F,Expr],
 1794        ?(Single) #= Expr,
 1795        SV =.. [F,Single],
 1796        exprs_singlevars(Es, SVs).
 1797
 1798all_dead(fd_props(Bs,Gs,Os)) :-
 1799        all_dead_(Bs),
 1800        all_dead_(Gs),
 1801        all_dead_(Os).
 1802
 1803all_dead_([]).
 1804all_dead_([propagator(_, S)|Ps]) :- S == dead, all_dead_(Ps).
 1805
 1806label([], _, _, _, Consistency) :- !,
 1807        (   Consistency = upto_in(I0,I) -> I0 = I
 1808        ;   true
 1809        ).
 1810label(Vars, Selection, Order, Choice, Consistency) :-
 1811        (   Vars = [V|Vs], nonvar(V) -> label(Vs, Selection, Order, Choice, Consistency)
 1812        ;   select_var(Selection, Vars, Var, RVars),
 1813            (   var(Var) ->
 1814                (   Consistency = upto_in(I0,I), fd_get(Var, _, Ps), all_dead(Ps) ->
 1815                    fd_size(Var, Size),
 1816                    I1 is I0*Size,
 1817                    label(RVars, Selection, Order, Choice, upto_in(I1,I))
 1818                ;   Consistency = upto_in, fd_get(Var, _, Ps), all_dead(Ps) ->
 1819                    label(RVars, Selection, Order, Choice, Consistency)
 1820                ;   choice_order_variable(Choice, Order, Var, RVars, Vars, Selection, Consistency)
 1821                )
 1822            ;   label(RVars, Selection, Order, Choice, Consistency)
 1823            )
 1824        ).
 1825
 1826choice_order_variable(step, Order, Var, Vars, Vars0, Selection, Consistency) :-
 1827        fd_get(Var, Dom, _),
 1828        order_dom_next(Order, Dom, Next),
 1829        (   Var = Next,
 1830            label(Vars, Selection, Order, step, Consistency)
 1831        ;   neq_num(Var, Next),
 1832            do_queue,
 1833            label(Vars0, Selection, Order, step, Consistency)
 1834        ).
 1835choice_order_variable(enum, Order, Var, Vars, _, Selection, Consistency) :-
 1836        fd_get(Var, Dom0, _),
 1837        domain_direction_element(Dom0, Order, Var),
 1838        label(Vars, Selection, Order, enum, Consistency).
 1839choice_order_variable(bisect, Order, Var, _, Vars0, Selection, Consistency) :-
 1840        fd_get(Var, Dom, _),
 1841        domain_infimum(Dom, n(I)),
 1842        domain_supremum(Dom, n(S)),
 1843        Mid0 is (I + S) // 2,
 1844        (   Mid0 =:= S -> Mid is Mid0 - 1 ; Mid = Mid0 ),
 1845        (   Order == up -> ( Var #=< Mid ; Var #> Mid )
 1846        ;   Order == down -> ( Var #> Mid ; Var #=< Mid )
 1847        ;   domain_error(bisect_up_or_down, Order)
 1848        ),
 1849        label(Vars0, Selection, Order, bisect, Consistency).
 1850
 1851override(What, Prev, Value, Options, Result) :-
 1852        call(What, Value),
 1853        override_(Prev, Value, Options, Result).
 1854
 1855override_(default(_), Value, _, user(Value)).
 1856override_(user(Prev), Value, Options, _) :-
 1857        (   Value == Prev ->
 1858            domain_error(nonrepeating_labeling_options, Options)
 1859        ;   domain_error(consistent_labeling_options, Options)
 1860        ).
 1861
 1862selection(ff).
 1863selection(ffc).
 1864selection(min).
 1865selection(max).
 1866selection(leftmost).
 1867selection(random_variable(Seed)) :-
 1868        must_be(integer, Seed),
 1869        set_random(seed(Seed)).
 1870
 1871choice(step).
 1872choice(enum).
 1873choice(bisect).
 1874
 1875order(up).
 1876order(down).
 1877% TODO: random_variable and random_value currently both set the seed,
 1878% so exchanging the options can yield different results.
 1879order(random_value(Seed)) :-
 1880        must_be(integer, Seed),
 1881        set_random(seed(Seed)).
 1882
 1883consistency(upto_in(I), upto_in(1, I)).
 1884consistency(upto_in, upto_in).
 1885consistency(upto_ground, upto_ground).
 1886
 1887optimisation(min(_)).
 1888optimisation(max(_)).
 1889
 1890select_var(leftmost, [Var|Vars], Var, Vars).
 1891select_var(min, [V|Vs], Var, RVars) :-
 1892        find_min(Vs, V, Var),
 1893        delete_eq([V|Vs], Var, RVars).
 1894select_var(max, [V|Vs], Var, RVars) :-
 1895        find_max(Vs, V, Var),
 1896        delete_eq([V|Vs], Var, RVars).
 1897select_var(ff, [V|Vs], Var, RVars) :-
 1898        fd_size_(V, n(S)),
 1899        find_ff(Vs, V, S, Var),
 1900        delete_eq([V|Vs], Var, RVars).
 1901select_var(ffc, [V|Vs], Var, RVars) :-
 1902        find_ffc(Vs, V, Var),
 1903        delete_eq([V|Vs], Var, RVars).
 1904select_var(random_variable(_), Vars0, Var, Vars) :-
 1905        length(Vars0, L),
 1906        I is random(L),
 1907        nth0(I, Vars0, Var),
 1908        delete_eq(Vars0, Var, Vars).
 1909
 1910find_min([], Var, Var).
 1911find_min([V|Vs], CM, Min) :-
 1912        (   min_lt(V, CM) ->
 1913            find_min(Vs, V, Min)
 1914        ;   find_min(Vs, CM, Min)
 1915        ).
 1916
 1917find_max([], Var, Var).
 1918find_max([V|Vs], CM, Max) :-
 1919        (   max_gt(V, CM) ->
 1920            find_max(Vs, V, Max)
 1921        ;   find_max(Vs, CM, Max)
 1922        ).
 1923
 1924find_ff([], Var, _, Var).
 1925find_ff([V|Vs], CM, S0, FF) :-
 1926        (   nonvar(V) -> find_ff(Vs, CM, S0, FF)
 1927        ;   (   fd_size_(V, n(S1)), S1 < S0 ->
 1928                find_ff(Vs, V, S1, FF)
 1929            ;   find_ff(Vs, CM, S0, FF)
 1930            )
 1931        ).
 1932
 1933find_ffc([], Var, Var).
 1934find_ffc([V|Vs], Prev, FFC) :-
 1935        (   ffc_lt(V, Prev) ->
 1936            find_ffc(Vs, V, FFC)
 1937        ;   find_ffc(Vs, Prev, FFC)
 1938        ).
 1939
 1940
 1941ffc_lt(X, Y) :-
 1942        (   fd_get(X, XD, XPs) ->
 1943            domain_num_elements(XD, n(NXD))
 1944        ;   NXD = 1, XPs = []
 1945        ),
 1946        (   fd_get(Y, YD, YPs) ->
 1947            domain_num_elements(YD, n(NYD))
 1948        ;   NYD = 1, YPs = []
 1949        ),
 1950        (   NXD < NYD -> true
 1951        ;   NXD =:= NYD,
 1952            props_number(XPs, NXPs),
 1953            props_number(YPs, NYPs),
 1954            NXPs > NYPs
 1955        ).
 1956
 1957min_lt(X,Y) :- bounds(X,LX,_), bounds(Y,LY,_), LX < LY.
 1958
 1959max_gt(X,Y) :- bounds(X,_,UX), bounds(Y,_,UY), UX > UY.
 1960
 1961bounds(X, L, U) :-
 1962        (   fd_get(X, Dom, _) ->
 1963            domain_infimum(Dom, n(L)),
 1964            domain_supremum(Dom, n(U))
 1965        ;   L = X, U = L
 1966        ).
 1967
 1968delete_eq([], _, []).
 1969delete_eq([X|Xs], Y, List) :-
 1970        (   nonvar(X) -> delete_eq(Xs, Y, List)
 1971        ;   X == Y -> List = Xs
 1972        ;   List = [X|Tail],
 1973            delete_eq(Xs, Y, Tail)
 1974        ).
 1975
 1976/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1977   contracting/1 -- subject to change
 1978
 1979   This can remove additional domain elements from the boundaries.
 1980- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1981
 1982contracting(Vs) :-
 1983        must_be(list, Vs),
 1984        maplist(must_be_finite_fdvar, Vs),
 1985        contracting(Vs, false, Vs).
 1986
 1987contracting([], Repeat, Vars) :-
 1988        (   Repeat -> contracting(Vars, false, Vars)
 1989        ;   true
 1990        ).
 1991contracting([V|Vs], Repeat, Vars) :-
 1992        fd_inf(V, Min),
 1993        (   \+ \+ (V = Min) ->
 1994            fd_sup(V, Max),
 1995            (   \+ \+ (V = Max) ->
 1996                contracting(Vs, Repeat, Vars)
 1997            ;   V #\= Max,
 1998                contracting(Vs, true, Vars)
 1999            )
 2000        ;   V #\= Min,
 2001            contracting(Vs, true, Vars)
 2002        ).
 2003
 2004/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2005   fds_sespsize(Vs, S).
 2006
 2007   S is an upper bound on the search space size with respect to finite
 2008   domain variables Vs.
 2009- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2010
 2011fds_sespsize(Vs, S) :-
 2012        must_be(list, Vs),
 2013        maplist(fd_variable, Vs),
 2014        fds_sespsize(Vs, n(1), S1),
 2015        bound_portray(S1, S).
 2016
 2017fd_size_(V, S) :-
 2018        (   fd_get(V, D, _) ->
 2019            domain_num_elements(D, S)
 2020        ;   S = n(1)
 2021        ).
 2022
 2023fds_sespsize([], S, S).
 2024fds_sespsize([V|Vs], S0, S) :-
 2025        fd_size_(V, S1),
 2026        S2 cis S0*S1,
 2027        fds_sespsize(Vs, S2, S).
 2028
 2029/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2030   Optimisation uses destructive assignment to save the computed
 2031   extremum over backtracking. Failure is used to get rid of copies of
 2032   attributed variables that are created in intermediate steps. At
 2033   least that's the intention - it currently doesn't work in SWI:
 2034
 2035   %?- X in 0..3, call_residue_vars(labeling([min(X)], [X]), Vs).
 2036   %@ X = 0,
 2037   %@ Vs = [_G6174, _G6177],
 2038   %@ _G6174 in 0..3
 2039
 2040- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2041
 2042optimise(Vars, Options, Whats) :-
 2043        Whats = [What|WhatsRest],
 2044        Extremum = extremum(none),
 2045        (   catch(store_extremum(Vars, Options, What, Extremum),
 2046                  time_limit_exceeded,
 2047                  false)
 2048        ;   Extremum = extremum(n(Val)),
 2049            arg(1, What, Expr),
 2050            append(WhatsRest, Options, Options1),
 2051            (   Expr #= Val,
 2052                labeling(Options1, Vars)
 2053            ;   Expr #\= Val,
 2054                optimise(Vars, Options, Whats)
 2055            )
 2056        ).
 2057
 2058store_extremum(Vars, Options, What, Extremum) :-
 2059        catch((labeling(Options, Vars), throw(w(What))), w(What1), true),
 2060        functor(What, Direction, _),
 2061        maplist(arg(1), [What,What1], [Expr,Expr1]),
 2062        optimise(Direction, Options, Vars, Expr1, Expr, Extremum).
 2063
 2064optimise(Direction, Options, Vars, Expr0, Expr, Extremum) :-
 2065        must_be(ground, Expr0),
 2066        nb_setarg(1, Extremum, n(Expr0)),
 2067        catch((tighten(Direction, Expr, Expr0),
 2068               labeling(Options, Vars),
 2069               throw(v(Expr))), v(Expr1), true),
 2070        optimise(Direction, Options, Vars, Expr1, Expr, Extremum).
 2071
 2072tighten(min, E, V) :- E #< V.
 2073tighten(max, E, V) :- E #> V.
 2074
 2075%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2076
 2077%% all_different(+Vars)
 2078%
 2079% Like all_distinct/1, but with weaker propagation. Consider using
 2080% all_distinct/1 instead, since all_distinct/1 is typically acceptably
 2081% efficient and propagates much more strongly.
 2082
 2083all_different(Ls) :-
 2084        fd_must_be_list(Ls),
 2085        maplist(fd_variable, Ls),
 2086        Orig = original_goal(_, all_different(Ls)),
 2087        all_different(Ls, [], Orig),
 2088        do_queue.
 2089
 2090all_different([], _, _).
 2091all_different([X|Right], Left, Orig) :-
 2092        (   var(X) ->
 2093            make_propagator(pdifferent(Left,Right,X,Orig), Prop),
 2094            init_propagator(X, Prop),
 2095            trigger_prop(Prop)
 2096        ;   exclude_fire(Left, Right, X)
 2097        ),
 2098        all_different(Right, [X|Left], Orig).
 2099
 2100%% all_distinct(+Vars).
 2101%
 2102%  True iff Vars are pairwise distinct. For example, all_distinct/1
 2103%  can detect that not all variables can assume distinct values given
 2104%  the following domains:
 2105%
 2106%  ==
 2107%  ?- maplist(in, Vs,
 2108%             [1\/3..4, 1..2\/4, 1..2\/4, 1..3, 1..3, 1..6]),
 2109%     all_distinct(Vs).
 2110%  false.
 2111%  ==
 2112
 2113all_distinct(Ls) :-
 2114        fd_must_be_list(Ls),
 2115        maplist(fd_variable, Ls),
 2116        make_propagator(pdistinct(Ls), Prop),
 2117        distinct_attach(Ls, Prop, []),
 2118        trigger_once(Prop).
 2119
 2120%% sum(+Vars, +Rel, ?Expr)
 2121%
 2122% The sum of elements of the list Vars is in relation Rel to Expr.
 2123% Rel is one of #=, #\=, #<, #>, #=< or #>=. For example:
 2124%
 2125% ==
 2126% ?- [A,B,C] ins 0..sup, sum([A,B,C], #=, 100).
 2127% A in 0..100,
 2128% A+B+C#=100,
 2129% B in 0..100,
 2130% C in 0..100.
 2131% ==
 2132
 2133sum(Vs, Op, Value) :-
 2134        must_be(list, Vs),
 2135        same_length(Vs, Ones),
 2136        maplist(=(1), Ones),
 2137        scalar_product(Ones, Vs, Op, Value).
 2138
 2139%% scalar_product(+Cs, +Vs, +Rel, ?Expr)
 2140%
 2141% True iff the scalar product of Cs and Vs is in relation Rel to Expr.
 2142% Cs is a list of integers, Vs is a list of variables and integers.
 2143% Rel is #=, #\=, #<, #>, #=< or #>=.
 2144
 2145scalar_product(Cs, Vs, Op, Value) :-
 2146        must_be(list(integer), Cs),
 2147        must_be(list, Vs),
 2148        maplist(fd_variable, Vs),
 2149        (   Op = (#=), single_value(Value, Right), ground(Vs) ->
 2150            foldl(coeff_int_linsum, Cs, Vs, 0, Right)
 2151        ;   must_be(callable, Op),
 2152            (   memberchk(Op, [#=,#\=,#<,#>,#=<,#>=]) -> true
 2153            ;   domain_error(scalar_product_relation, Op)
 2154            ),
 2155            must_be(acyclic, Value),
 2156            foldl(coeff_var_plusterm, Cs, Vs, 0, Left),
 2157            (   left_right_linsum_const(Left, Value, Cs1, Vs1, Const) ->
 2158                scalar_product_(Op, Cs1, Vs1, Const)
 2159            ;   sum(Cs, Vs, 0, Op, Value)
 2160            )
 2161        ).
 2162
 2163single_value(V, V)    :- var(V), !, non_monotonic(V).
 2164single_value(V, V)    :- integer(V).
 2165single_value(?(V), V) :- fd_variable(V).
 2166
 2167coeff_var_plusterm(C, V, T0, T0+(C* ?(V))).
 2168
 2169coeff_int_linsum(C, I, S0, S) :- S is S0 + C*I.
 2170
 2171sum([], _, Sum, Op, Value) :- call(Op, Sum, Value).
 2172sum([C|Cs], [X|Xs], Acc, Op, Value) :-
 2173        ?(NAcc) #= Acc + C* ?(X),
 2174        sum(Cs, Xs, NAcc, Op, Value).
 2175
 2176multiples([], [], _).
 2177multiples([C|Cs], [V|Vs], Left) :-
 2178        (   (   Cs = [N|_] ; Left = [N|_] ) ->
 2179            (   N =\= 1, gcd(C,N) =:= 1 ->
 2180                gcd(Cs, N, GCD0),
 2181                gcd(Left, GCD0, GCD),
 2182                (   GCD > 1 -> ?(V) #= GCD * ?(_)
 2183                ;   true
 2184                )
 2185            ;   true
 2186            )
 2187        ;   true
 2188        ),
 2189        multiples(Cs, Vs, [C|Left]).
 2190
 2191abs(N, A) :- A is abs(N).
 2192
 2193divide(D, N, R) :- R is N // D.
 2194
 2195scalar_product_(#=, Cs0, Vs, S0) :-
 2196        (   Cs0 = [C|Rest] ->
 2197            gcd(Rest, C, GCD),
 2198            S0 mod GCD =:= 0,
 2199            maplist(divide(GCD), [S0|Cs0], [S|Cs])
 2200        ;   S0 =:= 0, S = S0, Cs = Cs0
 2201        ),
 2202        (   S0 =:= 0 ->
 2203            maplist(abs, Cs, As),
 2204            multiples(As, Vs, [])
 2205        ;   true
 2206        ),
 2207        propagator_init_trigger(Vs, scalar_product_eq(Cs, Vs, S)).
 2208scalar_product_(#\=, Cs, Vs, C) :-
 2209        propagator_init_trigger(Vs, scalar_product_neq(Cs, Vs, C)).
 2210scalar_product_(#=<, Cs, Vs, C) :-
 2211        propagator_init_trigger(Vs, scalar_product_leq(Cs, Vs, C)).
 2212scalar_product_(#<, Cs, Vs, C) :-
 2213        C1 is C - 1,
 2214        scalar_product_(#=<, Cs, Vs, C1).
 2215scalar_product_(#>, Cs, Vs, C) :-
 2216        C1 is C + 1,
 2217        scalar_product_(#>=, Cs, Vs, C1).
 2218scalar_product_(#>=, Cs, Vs, C) :-
 2219        maplist(negative, Cs, Cs1),
 2220        C1 is -C,
 2221        scalar_product_(#=<, Cs1, Vs, C1).
 2222
 2223negative(X0, X) :- X is -X0.
 2224
 2225coeffs_variables_const([], [], [], [], I, I).
 2226coeffs_variables_const([C|Cs], [V|Vs], Cs1, Vs1, I0, I) :-
 2227        (   var(V) ->
 2228            Cs1 = [C|CRest], Vs1 = [V|VRest], I1 = I0
 2229        ;   I1 is I0 + C*V,
 2230            Cs1 = CRest, Vs1 = VRest
 2231        ),
 2232        coeffs_variables_const(Cs, Vs, CRest, VRest, I1, I).
 2233
 2234sum_finite_domains([], [], [], [], Inf, Sup, Inf, Sup).
 2235sum_finite_domains([C|Cs], [V|Vs], Infs, Sups, Inf0, Sup0, Inf, Sup) :-
 2236        fd_get(V, _, Inf1, Sup1, _),
 2237        (   Inf1 = n(NInf) ->
 2238            (   C < 0 ->
 2239                Sup2 is Sup0 + C*NInf
 2240            ;   Inf2 is Inf0 + C*NInf
 2241            ),
 2242            Sups = Sups1,
 2243            Infs = Infs1
 2244        ;   (   C < 0 ->
 2245                Sup2 = Sup0,
 2246                Sups = [C*V|Sups1],
 2247                Infs = Infs1
 2248            ;   Inf2 = Inf0,
 2249                Infs = [C*V|Infs1],
 2250                Sups = Sups1
 2251            )
 2252        ),
 2253        (   Sup1 = n(NSup) ->
 2254            (   C < 0 ->
 2255                Inf2 is Inf0 + C*NSup
 2256            ;   Sup2 is Sup0 + C*NSup
 2257            ),
 2258            Sups1 = Sups2,
 2259            Infs1 = Infs2
 2260        ;   (   C < 0 ->
 2261                Inf2 = Inf0,
 2262                Infs1 = [C*V|Infs2],
 2263                Sups1 = Sups2
 2264            ;   Sup2 = Sup0,
 2265                Sups1 = [C*V|Sups2],
 2266                Infs1 = Infs2
 2267            )
 2268        ),
 2269        sum_finite_domains(Cs, Vs, Infs2, Sups2, Inf2, Sup2, Inf, Sup).
 2270
 2271remove_dist_upper_lower([], _, _, _).
 2272remove_dist_upper_lower([C|Cs], [V|Vs], D1, D2) :-
 2273        (   fd_get(V, VD, VPs) ->
 2274            (   C < 0 ->
 2275                domain_supremum(VD, n(Sup)),
 2276                L is Sup + D1//C,
 2277                domain_remove_smaller_than(VD, L, VD1),
 2278                domain_infimum(VD1, n(Inf)),
 2279                G is Inf - D2//C,
 2280                domain_remove_greater_than(VD1, G, VD2)
 2281            ;   domain_infimum(VD, n(Inf)),
 2282                G is Inf + D1//C,
 2283                domain_remove_greater_than(VD, G, VD1),
 2284                domain_supremum(VD1, n(Sup)),
 2285                L is Sup - D2//C,
 2286                domain_remove_smaller_than(VD1, L, VD2)
 2287            ),
 2288            fd_put(V, VD2, VPs)
 2289        ;   true
 2290        ),
 2291        remove_dist_upper_lower(Cs, Vs, D1, D2).
 2292
 2293
 2294remove_dist_upper_leq([], _, _).
 2295remove_dist_upper_leq([C|Cs], [V|Vs], D1) :-
 2296        (   fd_get(V, VD, VPs) ->
 2297            (   C < 0 ->
 2298                domain_supremum(VD, n(Sup)),
 2299                L is Sup + D1//C,
 2300                domain_remove_smaller_than(VD, L, VD1)
 2301            ;   domain_infimum(VD, n(Inf)),
 2302                G is Inf + D1//C,
 2303                domain_remove_greater_than(VD, G, VD1)
 2304            ),
 2305            fd_put(V, VD1, VPs)
 2306        ;   true
 2307        ),
 2308        remove_dist_upper_leq(Cs, Vs, D1).
 2309
 2310
 2311remove_dist_upper([], _).
 2312remove_dist_upper([C*V|CVs], D) :-
 2313        (   fd_get(V, VD, VPs) ->
 2314            (   C < 0 ->
 2315                (   domain_supremum(VD, n(Sup)) ->
 2316                    L is Sup + D//C,
 2317                    domain_remove_smaller_than(VD, L, VD1)
 2318                ;   VD1 = VD
 2319                )
 2320            ;   (   domain_infimum(VD, n(Inf)) ->
 2321                    G is Inf + D//C,
 2322                    domain_remove_greater_than(VD, G, VD1)
 2323                ;   VD1 = VD
 2324                )
 2325            ),
 2326            fd_put(V, VD1, VPs)
 2327        ;   true
 2328        ),
 2329        remove_dist_upper(CVs, D).
 2330
 2331remove_dist_lower([], _).
 2332remove_dist_lower([C*V|CVs], D) :-
 2333        (   fd_get(V, VD, VPs) ->
 2334            (   C < 0 ->
 2335                (   domain_infimum(VD, n(Inf)) ->
 2336                    G is Inf - D//C,
 2337                    domain_remove_greater_than(VD, G, VD1)
 2338                ;   VD1 = VD
 2339                )
 2340            ;   (   domain_supremum(VD, n(Sup)) ->
 2341                    L is Sup - D//C,
 2342                    domain_remove_smaller_than(VD, L, VD1)
 2343                ;   VD1 = VD
 2344                )
 2345            ),
 2346            fd_put(V, VD1, VPs)
 2347        ;   true
 2348        ),
 2349        remove_dist_lower(CVs, D).
 2350
 2351remove_upper([], _).
 2352remove_upper([C*X|CXs], Max) :-
 2353        (   fd_get(X, XD, XPs) ->
 2354            D is Max//C,
 2355            (   C < 0 ->
 2356                domain_remove_smaller_than(XD, D, XD1)
 2357            ;   domain_remove_greater_than(XD, D, XD1)
 2358            ),
 2359            fd_put(X, XD1, XPs)
 2360        ;   true
 2361        ),
 2362        remove_upper(CXs, Max).
 2363
 2364remove_lower([], _).
 2365remove_lower([C*X|CXs], Min) :-
 2366        (   fd_get(X, XD, XPs) ->
 2367            D is -Min//C,
 2368            (   C < 0 ->
 2369                domain_remove_greater_than(XD, D, XD1)
 2370            ;   domain_remove_smaller_than(XD, D, XD1)
 2371            ),
 2372            fd_put(X, XD1, XPs)
 2373        ;   true
 2374        ),
 2375        remove_lower(CXs, Min).
 2376
 2377%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2378
 2379/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2380   Constraint propagation proceeds as follows: Each CLP(FD) variable
 2381   has an attribute that stores its associated domain and constraints.
 2382   Constraints are triggered when the event they are registered for
 2383   occurs (for example: variable is instantiated, bounds change etc.).
 2384   do_queue/0 works off all triggered constraints, possibly triggering
 2385   new ones, until fixpoint.
 2386- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2387
 2388% FIFO queue
 2389
 2390make_queue :- nb_setval('$clpfd_queue', fast_slow([], [])).
 2391
 2392push_queue(E, Which) :-
 2393        nb_getval('$clpfd_queue', Qs),
 2394        arg(Which, Qs, Q),
 2395        (   Q == [] ->
 2396            setarg(Which, Qs, [E|T]-T)
 2397        ;   Q = H-[E|T],
 2398            setarg(Which, Qs, H-T)
 2399        ).
 2400
 2401pop_queue(E) :-
 2402        nb_getval('$clpfd_queue', Qs),
 2403        (   pop_queue(E, Qs, 1) ->  true
 2404        ;   pop_queue(E, Qs, 2)
 2405        ).
 2406
 2407pop_queue(E, Qs, Which) :-
 2408        arg(Which, Qs, [E|NH]-T),
 2409        (   var(NH) ->
 2410            setarg(Which, Qs, [])
 2411        ;   setarg(Which, Qs, NH-T)
 2412        ).
 2413
 2414fetch_propagator(Prop) :-
 2415        pop_queue(P),
 2416        (   propagator_state(P, S), S == dead -> fetch_propagator(Prop)
 2417        ;   Prop = P
 2418        ).
 2419
 2420/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2421   Parsing a CLP(FD) expression has two important side-effects: First,
 2422   it constrains the variables occurring in the expression to
 2423   integers. Second, it constrains some of them even more: For
 2424   example, in X/Y and X mod Y, Y is constrained to be #\= 0.
 2425- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2426
 2427constrain_to_integer(Var) :-
 2428        (   integer(Var) -> true
 2429        ;   fd_get(Var, D, Ps),
 2430            fd_put(Var, D, Ps)
 2431        ).
 2432
 2433power_var_num(P, X, N) :-
 2434        (   var(P) -> X = P, N = 1
 2435        ;   P = Left*Right,
 2436            power_var_num(Left, XL, L),
 2437            power_var_num(Right, XR, R),
 2438            XL == XR,
 2439            X = XL,
 2440            N is L + R
 2441        ).
 2442
 2443/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2444   Given expression E, we obtain the finite domain variable R by
 2445   interpreting a simple committed-choice language that is a list of
 2446   conditions and bodies. In conditions, g(Goal) means literally Goal,
 2447   and m(Match) means that E can be decomposed as stated. The
 2448   variables are to be understood as the result of parsing the
 2449   subexpressions recursively. In the body, g(Goal) means again Goal,
 2450   and p(Propagator) means to attach and trigger once a propagator.
 2451- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2452
 2453:- op(800, xfx, =>). 2454
 2455parse_clpfd(E, R,
 2456            [g(cyclic_term(E)) => [g(domain_error(clpfd_expression, E))],
 2457             g(var(E))         => [g(non_monotonic(E)),
 2458                                   g(constrain_to_integer(E)), g(E = R)],
 2459             g(integer(E))     => [g(R = E)],
 2460             ?(E)              => [g(must_be_fd_integer(E)), g(R = E)],
 2461             #(E)              => [g(must_be_fd_integer(E)), g(R = E)],
 2462             m(A+B)            => [p(pplus(A, B, R))],
 2463             % power_var_num/3 must occur before */2 to be useful
 2464             g(power_var_num(E, V, N)) => [p(pexp(V, N, R))],
 2465             m(A*B)            => [p(ptimes(A, B, R))],
 2466             m(A-B)            => [p(pplus(R,B,A))],
 2467             m(-A)             => [p(ptimes(-1,A,R))],
 2468             m(max(A,B))       => [g(A #=< ?(R)), g(B #=< R), p(pmax(A, B, R))],
 2469             m(min(A,B))       => [g(A #>= ?(R)), g(B #>= R), p(pmin(A, B, R))],
 2470             m(A mod B)        => [g(B #\= 0), p(pmod(A, B, R))],
 2471             m(A rem B)        => [g(B #\= 0), p(prem(A, B, R))],
 2472             m(abs(A))         => [g(?(R) #>= 0), p(pabs(A, R))],
 2473%             m(A/B)            => [g(B #\= 0), p(ptzdiv(A, B, R))],
 2474             m(A//B)           => [g(B #\= 0), p(ptzdiv(A, B, R))],
 2475             m(A div B)        => [g(?(R) #= (A - (A mod B)) // B)],
 2476             m(A rdiv B)       => [g(B #\= 0), p(prdiv(A, B, R))],
 2477             m(A^B)            => [p(pexp(A, B, R))],
 2478             % bitwise operations
 2479             m(\A)             => [p(pfunction(\, A, R))],
 2480             m(msb(A))         => [p(pfunction(msb, A, R))],
 2481             m(lsb(A))         => [p(pfunction(lsb, A, R))],
 2482             m(popcount(A))    => [p(pfunction(popcount, A, R))],
 2483             m(A<<B)           => [p(pfunction(<<, A, B, R))],
 2484             m(A>>B)           => [p(pfunction(>>, A, B, R))],
 2485             m(A/\B)           => [p(pfunction(/\, A, B, R))],
 2486             m(A\/B)           => [p(pfunction(\/, A, B, R))],
 2487             m(A xor B)        => [p(pfunction(xor, A, B, R))],
 2488             g(true)           => [g(domain_error(clpfd_expression, E))]
 2489            ]).
 2490
 2491non_monotonic(X) :-
 2492        (   \+ fd_var(X), current_prolog_flag(clpfd_monotonic, true) ->
 2493            instantiation_error(X)
 2494        ;   true
 2495        ).
 2496
 2497% Here, we compile the committed choice language to a single
 2498% predicate, parse_clpfd/2.
 2499
 2500make_parse_clpfd(Clauses) :-
 2501        parse_clpfd_clauses(Clauses0),
 2502        maplist(goals_goal, Clauses0, Clauses).
 2503
 2504goals_goal((Head :- Goals), (Head :- Body)) :-
 2505        list_goal(Goals, Body).
 2506
 2507parse_clpfd_clauses(Clauses) :-
 2508        parse_clpfd(E, R, Matchers),
 2509        maplist(parse_matcher(E, R), Matchers, Clauses).
 2510
 2511parse_matcher(E, R, Matcher, Clause) :-
 2512        Matcher = (Condition0 => Goals0),
 2513        phrase((parse_condition(Condition0, E, Head),
 2514                parse_goals(Goals0)), Goals),
 2515        Clause = (parse_clpfd(Head, R) :- Goals).
 2516
 2517parse_condition(g(Goal), E, E)       --> [Goal, !].
 2518parse_condition(?(E), _, ?(E))       --> [!].
 2519parse_condition(#(E), _, #(E))       --> [!].
 2520parse_condition(m(Match), _, Match0) -->
 2521        [!],
 2522        { copy_term(Match, Match0),
 2523          term_variables(Match0, Vs0),
 2524          term_variables(Match, Vs)
 2525        },
 2526        parse_match_variables(Vs0, Vs).
 2527
 2528parse_match_variables([], []) --> [].
 2529parse_match_variables([V0|Vs0], [V|Vs]) -->
 2530        [parse_clpfd(V0, V)],
 2531        parse_match_variables(Vs0, Vs).
 2532
 2533parse_goals([]) --> [].
 2534parse_goals([G|Gs]) --> parse_goal(G), parse_goals(Gs).
 2535
 2536parse_goal(g(Goal)) --> [Goal].
 2537parse_goal(p(Prop)) -->
 2538        [make_propagator(Prop, P)],
 2539        { term_variables(Prop, Vs) },
 2540        parse_init(Vs, P),
 2541        [trigger_once(P)].
 2542
 2543parse_init([], _)     --> [].
 2544parse_init([V|Vs], P) --> [init_propagator(V, P)], parse_init(Vs, P).
 2545
 2546%?- set_prolog_flag(answer_write_options, [portray(true)]),
 2547%   clpfd:parse_clpfd_clauses(Clauses), maplist(portray_clause, Clauses).
 2548
 2549
 2550%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2551%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2552
 2553trigger_once(Prop) :- trigger_prop(Prop), do_queue.
 2554
 2555neq(A, B) :- propagator_init_trigger(pneq(A, B)).
 2556
 2557propagator_init_trigger(P) -->
 2558        { term_variables(P, Vs) },
 2559        propagator_init_trigger(Vs, P).
 2560
 2561propagator_init_trigger(Vs, P) -->
 2562        [p(Prop)],
 2563        { make_propagator(P, Prop),
 2564          maplist(prop_init(Prop), Vs),
 2565          trigger_once(Prop) }.
 2566
 2567propagator_init_trigger(P) :-
 2568        phrase(propagator_init_trigger(P), _).
 2569
 2570propagator_init_trigger(Vs, P) :-
 2571        phrase(propagator_init_trigger(Vs, P), _).
 2572
 2573prop_init(Prop, V) :- init_propagator(V, Prop).
 2574
 2575geq(A, B) :-
 2576        (   fd_get(A, AD, APs) ->
 2577            domain_infimum(AD, AI),
 2578            (   fd_get(B, BD, _) ->
 2579                domain_supremum(BD, BS),
 2580                (   AI cis_geq BS -> true
 2581                ;   propagator_init_trigger(pgeq(A,B))
 2582                )
 2583            ;   (   AI cis_geq n(B) -> true
 2584                ;   domain_remove_smaller_than(AD, B, AD1),
 2585                    fd_put(A, AD1, APs),
 2586                    do_queue
 2587                )
 2588            )
 2589        ;   fd_get(B, BD, BPs) ->
 2590            domain_remove_greater_than(BD, A, BD1),
 2591            fd_put(B, BD1, BPs),
 2592            do_queue
 2593        ;   A >= B
 2594        ).
 2595
 2596/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2597   Naive parsing of inequalities and disequalities can result in a lot
 2598   of unnecessary work if expressions of non-trivial depth are
 2599   involved: Auxiliary variables are introduced for sub-expressions,
 2600   and propagation proceeds on them as if they were involved in a
 2601   tighter constraint (like equality), whereas eventually only very
 2602   little of the propagated information is actually used. For example,
 2603   only extremal values are of interest in inequalities. Introducing
 2604   auxiliary variables should be avoided when possible, and
 2605   specialised propagators should be used for common constraints.
 2606
 2607   We again use a simple committed-choice language for matching
 2608   special cases of constraints. m_c(M,C) means that M matches and C
 2609   holds. d(X, Y) means decomposition, i.e., it is short for
 2610   g(parse_clpfd(X, Y)). r(X, Y) means to rematch with X and Y.
 2611
 2612   Two things are important: First, although the actual constraint
 2613   functors (#\=2, #=/2 etc.) are used in the description, they must
 2614   expand to the respective auxiliary predicates (match_expand/2)
 2615   because the actual constraints are subject to goal expansion.
 2616   Second, when specialised constraints (like scalar product) post
 2617   simpler constraints on their own, these simpler versions must be
 2618   handled separately and must occur before.
 2619- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2620
 2621match_expand(#>=, clpfd_geq_).
 2622match_expand(#=, clpfd_equal_).
 2623match_expand(#\=, clpfd_neq).
 2624
 2625symmetric(#=).
 2626symmetric(#\=).
 2627
 2628matches([
 2629         m_c(any(X) #>= any(Y), left_right_linsum_const(X, Y, Cs, Vs, Const)) =>
 2630            [g((   Cs = [1], Vs = [A] -> geq(A, Const)
 2631               ;   Cs = [-1], Vs = [A] -> Const1 is -Const, geq(Const1, A)
 2632               ;   Cs = [1,1], Vs = [A,B] -> ?(A) + ?(B) #= ?(S), geq(S, Const)
 2633               ;   Cs = [1,-1], Vs = [A,B] ->
 2634                   (   Const =:= 0 -> geq(A, B)
 2635                   ;   C1 is -Const,
 2636                       propagator_init_trigger(x_leq_y_plus_c(B, A, C1))
 2637                   )
 2638               ;   Cs = [-1,1], Vs = [A,B] ->
 2639                   (   Const =:= 0 -> geq(B, A)
 2640                   ;   C1 is -Const,
 2641                       propagator_init_trigger(x_leq_y_plus_c(A, B, C1))
 2642                   )
 2643               ;   Cs = [-1,-1], Vs = [A,B] ->
 2644                   ?(A) + ?(B) #= ?(S), Const1 is -Const, geq(Const1, S)
 2645               ;   scalar_product_(#>=, Cs, Vs, Const)
 2646               ))],
 2647         m(any(X) - any(Y) #>= integer(C))     => [d(X, X1), d(Y, Y1), g(C1 is -C), p(x_leq_y_plus_c(Y1, X1, C1))],
 2648         m(integer(X) #>= any(Z) + integer(A)) => [g(C is X - A), r(C, Z)],
 2649         m(abs(any(X)-any(Y)) #>= integer(I))  => [d(X, X1), d(Y, Y1), p(absdiff_geq(X1, Y1, I))],
 2650         m(abs(any(X)) #>= integer(I))         => [d(X, RX), g((I>0 -> I1 is -I, RX in inf..I1 \/ I..sup; true))],
 2651         m(integer(I) #>= abs(any(X)))         => [d(X, RX), g(I>=0), g(I1 is -I), g(RX in I1..I)],
 2652         m(any(X) #>= any(Y))                  => [d(X, RX), d(Y, RY), g(geq(RX, RY))],
 2653
 2654         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2655         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2656
 2657         m(var(X) #= var(Y))        => [g(constrain_to_integer(X)), g(X=Y)],
 2658         m(var(X) #= var(Y)+var(Z)) => [p(pplus(Y,Z,X))],
 2659         m(var(X) #= var(Y)-var(Z)) => [p(pplus(X,Z,Y))],
 2660         m(var(X) #= var(Y)*var(Z)) => [p(ptimes(Y,Z,X))],
 2661         m(var(X) #= -var(Z))       => [p(ptimes(-1, Z, X))],
 2662         m_c(any(X) #= any(Y), left_right_linsum_const(X, Y, Cs, Vs, S)) =>
 2663            [g(scalar_product_(#=, Cs, Vs, S))],
 2664         m(var(X) #= any(Y))       => [d(Y,X)],
 2665         m(any(X) #= any(Y))       => [d(X, RX), d(Y, RX)],
 2666
 2667         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2668         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2669
 2670         m(var(X) #\= integer(Y))             => [g(neq_num(X, Y))],
 2671         m(var(X) #\= var(Y))                 => [g(neq(X,Y))],
 2672         m(var(X) #\= var(Y) + var(Z))        => [p(x_neq_y_plus_z(X, Y, Z))],
 2673         m(var(X) #\= var(Y) - var(Z))        => [p(x_neq_y_plus_z(Y, X, Z))],
 2674         m(var(X) #\= var(Y)*var(Z))          => [p(ptimes(Y,Z,P)), g(neq(X,P))],
 2675         m(integer(X) #\= abs(any(Y)-any(Z))) => [d(Y, Y1), d(Z, Z1), p(absdiff_neq(Y1, Z1, X))],
 2676         m_c(any(X) #\= any(Y), left_right_linsum_const(X, Y, Cs, Vs, S)) =>
 2677            [g(scalar_product_(#\=, Cs, Vs, S))],
 2678         m(any(X) #\= any(Y) + any(Z))        => [d(X, X1), d(Y, Y1), d(Z, Z1), p(x_neq_y_plus_z(X1, Y1, Z1))],
 2679         m(any(X) #\= any(Y) - any(Z))        => [d(X, X1), d(Y, Y1), d(Z, Z1), p(x_neq_y_plus_z(Y1, X1, Z1))],
 2680         m(any(X) #\= any(Y)) => [d(X, RX), d(Y, RY), g(neq(RX, RY))]
 2681        ]).
 2682
 2683/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2684   We again compile the committed-choice matching language to the
 2685   intended auxiliary predicates. We now must take care not to
 2686   unintentionally unify a variable with a complex term.
 2687- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2688
 2689make_matches(Clauses) :-
 2690        matches(Ms),
 2691        findall(F, (member(M=>_, Ms), arg(1, M, M1), functor(M1, F, _)), Fs0),
 2692        sort(Fs0, Fs),
 2693        maplist(prevent_cyclic_argument, Fs, PrevCyclicClauses),
 2694        phrase(matchers(Ms), Clauses0),
 2695        maplist(goals_goal, Clauses0, MatcherClauses),
 2696        append(PrevCyclicClauses, MatcherClauses, Clauses1),
 2697        sort_by_predicate(Clauses1, Clauses).
 2698
 2699sort_by_predicate(Clauses, ByPred) :-
 2700        map_list_to_pairs(predname, Clauses, Keyed),
 2701        keysort(Keyed, KeyedByPred),
 2702        pairs_values(KeyedByPred, ByPred).
 2703
 2704predname((H:-_), Key)   :- !, predname(H, Key).
 2705predname(M:H, M:Key)    :- !, predname(H, Key).
 2706predname(H, Name/Arity) :- !, functor(H, Name, Arity).
 2707
 2708prevent_cyclic_argument(F0, Clause) :-
 2709        match_expand(F0, F),
 2710        Head =.. [F,X,Y],
 2711        Clause = (Head :- (   cyclic_term(X) ->
 2712                              domain_error(clpfd_expression, X)
 2713                          ;   cyclic_term(Y) ->
 2714                              domain_error(clpfd_expression, Y)
 2715                          ;   false
 2716                          )).
 2717
 2718matchers([]) --> [].
 2719matchers([Condition => Goals|Ms]) -->
 2720        matcher(Condition, Goals),
 2721        matchers(Ms).
 2722
 2723matcher(m(M), Gs) --> matcher(m_c(M,true), Gs).
 2724matcher(m_c(Matcher,Cond), Gs) -->
 2725        [(Head :- Goals0)],
 2726        { Matcher =.. [F,A,B],
 2727          match_expand(F, Expand),
 2728          Head =.. [Expand,X,Y],
 2729          phrase((match(A, X), match(B, Y)), Goals0, [Cond,!|Goals1]),
 2730          phrase(match_goals(Gs, Expand), Goals1) },
 2731        (   { symmetric(F), \+ (subsumes_term(A, B), subsumes_term(B, A)) } ->
 2732            { Head1 =.. [Expand,Y,X] },
 2733            [(Head1 :- Goals0)]
 2734        ;   []
 2735        ).
 2736
 2737match(any(A), T)     --> [A = T].
 2738match(var(V), T)     --> [( nonvar(T), ( T = ?(Var) ; T = #(Var) ) ->
 2739                            must_be_fd_integer(Var), V = Var
 2740                          ; v_or_i(T), V = T
 2741                          )].
 2742match(integer(I), T) --> [integer(T), I = T].
 2743match(-X, T)         --> [nonvar(T), T = -A], match(X, A).
 2744match(abs(X), T)     --> [nonvar(T), T = abs(A)], match(X, A).
 2745match(Binary, T)     -->
 2746        { Binary =.. [Op,X,Y], Term =.. [Op,A,B] },
 2747        [nonvar(T), T = Term],
 2748        match(X, A), match(Y, B).
 2749
 2750match_goals([], _)     --> [].
 2751match_goals([G|Gs], F) --> match_goal(G, F), match_goals(Gs, F).
 2752
 2753match_goal(r(X,Y), F)  --> { G =.. [F,X,Y] }, [G].
 2754match_goal(d(X,Y), _)  --> [parse_clpfd(X, Y)].
 2755match_goal(g(Goal), _) --> [Goal].
 2756match_goal(p(Prop), _) -->
 2757        [make_propagator(Prop, P)],
 2758        { term_variables(Prop, Vs) },
 2759        parse_init(Vs, P),
 2760        [trigger_once(P)].
 2761
 2762
 2763%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2764
 2765
 2766
 2767%% ?X #>= ?Y
 2768%
 2769% Same as Y #=< X. When reasoning over integers, replace `(>=)/2` by
 2770% #>=/2 to obtain more general relations. See [declarative integer
 2771% arithmetic](<#clpfd-integer-arith>).
 2772
 2773X #>= Y :- clpfd_geq(X, Y).
 2774
 2775clpfd_geq(X, Y) :- clpfd_geq_(X, Y), reinforce(X), reinforce(Y).
 2776
 2777%% ?X #=< ?Y
 2778%
 2779% The arithmetic expression X is less than or equal to Y. When
 2780% reasoning over integers, replace `(=<)/2` by #=</2 to obtain more
 2781% general relations. See [declarative integer
 2782% arithmetic](<#clpfd-integer-arith>).
 2783
 2784X #=< Y :- Y #>= X.
 2785
 2786%% ?X #= ?Y
 2787%
 2788% The arithmetic expression X equals Y. This is the most important
 2789% [arithmetic constraint](<#clpfd-arith-constraints>), subsuming and
 2790% replacing both `(is)/2` _and_ `(=:=)/2` over integers. See
 2791% [declarative integer arithmetic](<#clpfd-integer-arith>).
 2792
 2793X #= Y :- clpfd_equal(X, Y).
 2794
 2795clpfd_equal(X, Y) :- clpfd_equal_(X, Y), reinforce(X).
 2796
 2797/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2798   Conditions under which an equality can be compiled to built-in
 2799   arithmetic. Their order is significant. (/)/2 becomes (//)/2.
 2800- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2801
 2802expr_conds(E, E)                 --> [integer(E)],
 2803        { var(E), !, \+ current_prolog_flag(clpfd_monotonic, true) }.
 2804expr_conds(E, E)                 --> { integer(E) }.
 2805expr_conds(?(E), E)              --> [integer(E)].
 2806expr_conds(#(E), E)              --> [integer(E)].
 2807expr_conds(-E0, -E)              --> expr_conds(E0, E).
 2808expr_conds(abs(E0), abs(E))      --> expr_conds(E0, E).
 2809expr_conds(A0+B0, A+B)           --> expr_conds(A0, A), expr_conds(B0, B).
 2810expr_conds(A0*B0, A*B)           --> expr_conds(A0, A), expr_conds(B0, B).
 2811expr_conds(A0-B0, A-B)           --> expr_conds(A0, A), expr_conds(B0, B).
 2812expr_conds(A0//B0, A//B)         -->
 2813        expr_conds(A0, A), expr_conds(B0, B),
 2814        [B =\= 0].
 2815%expr_conds(A0/B0, AB)            --> expr_conds(A0//B0, AB).
 2816expr_conds(min(A0,B0), min(A,B)) --> expr_conds(A0, A), expr_conds(B0, B).
 2817expr_conds(max(A0,B0), max(A,B)) --> expr_conds(A0, A), expr_conds(B0, B).
 2818expr_conds(A0 mod B0, A mod B)   -->
 2819        expr_conds(A0, A), expr_conds(B0, B),
 2820        [B =\= 0].
 2821expr_conds(A0^B0, A^B)           -->
 2822        expr_conds(A0, A), expr_conds(B0, B),
 2823        [(B >= 0 ; A =:= -1)].
 2824% Bitwise operations, added to make CLP(FD) usable in more cases
 2825expr_conds(\ A0, \ A) --> expr_conds(A0, A).
 2826expr_conds(A0<<B0, A<<B) --> expr_conds(A0, A), expr_conds(B0, B).
 2827expr_conds(A0>>B0, A>>B) --> expr_conds(A0, A), expr_conds(B0, B).
 2828expr_conds(A0/\B0, A/\B) --> expr_conds(A0, A), expr_conds(B0, B).
 2829expr_conds(A0\/B0, A\/B) --> expr_conds(A0, A), expr_conds(B0, B).
 2830expr_conds(A0 xor B0, A xor B) --> expr_conds(A0, A), expr_conds(B0, B).
 2831expr_conds(lsb(A0), lsb(A)) --> expr_conds(A0, A).
 2832expr_conds(msb(A0), msb(A)) --> expr_conds(A0, A).
 2833expr_conds(popcount(A0), popcount(A)) --> expr_conds(A0, A).
 2834
 2835:- multifile
 2836        system:goal_expansion/2. 2837:- dynamic
 2838        system:goal_expansion/2. 2839
 2840system:goal_expansion(Goal, Expansion) :-
 2841        \+ current_prolog_flag(clpfd_goal_expansion, false),
 2842        clpfd_expandable(Goal),
 2843        prolog_load_context(module, M),
 2844	(   M == clpfd
 2845	->  true
 2846	;   predicate_property(M:Goal, imported_from(clpfd))
 2847	),
 2848        clpfd_expansion(Goal, Expansion).
 2849
 2850clpfd_expandable(_ in _).
 2851clpfd_expandable(_ #= _).
 2852clpfd_expandable(_ #>= _).
 2853clpfd_expandable(_ #=< _).
 2854clpfd_expandable(_ #> _).
 2855clpfd_expandable(_ #< _).
 2856
 2857clpfd_expansion(Var in Dom, In) :-
 2858        (   ground(Dom), Dom = L..U, integer(L), integer(U) ->
 2859            expansion_simpler(
 2860                (   integer(Var) ->
 2861                    between(L, U, Var)
 2862                ;   clpfd:clpfd_in(Var, Dom)
 2863                ), In)
 2864        ;   In = clpfd:clpfd_in(Var, Dom)
 2865        ).
 2866clpfd_expansion(X0 #= Y0, Equal) :-
 2867        phrase(expr_conds(X0, X), CsX),
 2868        phrase(expr_conds(Y0, Y), CsY),
 2869        list_goal(CsX, CondX),
 2870        list_goal(CsY, CondY),
 2871        expansion_simpler(
 2872                (   CondX ->
 2873                    (   var(Y) -> Y is X
 2874                    ;   CondY -> X =:= Y
 2875                    ;   T is X, clpfd:clpfd_equal(T, Y0)
 2876                    )
 2877                ;   CondY ->
 2878                    (   var(X) -> X is Y
 2879                    ;   T is Y, clpfd:clpfd_equal(X0, T)
 2880                    )
 2881                ;   clpfd:clpfd_equal(X0, Y0)
 2882                ), Equal).
 2883clpfd_expansion(X0 #>= Y0, Geq) :-
 2884        phrase(expr_conds(X0, X), CsX),
 2885        phrase(expr_conds(Y0, Y), CsY),
 2886        list_goal(CsX, CondX),
 2887        list_goal(CsY, CondY),
 2888        expansion_simpler(
 2889              (   CondX ->
 2890                  (   CondY -> X >= Y
 2891                  ;   T is X, clpfd:clpfd_geq(T, Y0)
 2892                  )
 2893              ;   CondY -> T is Y, clpfd:clpfd_geq(X0, T)
 2894              ;   clpfd:clpfd_geq(X0, Y0)
 2895              ), Geq).
 2896clpfd_expansion(X #=< Y,  Leq) :- clpfd_expansion(Y #>= X, Leq).
 2897clpfd_expansion(X #> Y, Gt)    :- clpfd_expansion(X #>= Y+1, Gt).
 2898clpfd_expansion(X #< Y, Lt)    :- clpfd_expansion(Y #> X, Lt).
 2899
 2900expansion_simpler((True->Then0;_), Then) :-
 2901        is_true(True), !,
 2902        expansion_simpler(Then0, Then).
 2903expansion_simpler((False->_;Else0), Else) :-
 2904        is_false(False), !,
 2905        expansion_simpler(Else0, Else).
 2906expansion_simpler((If->Then0;Else0), (If->Then;Else)) :- !,
 2907        expansion_simpler(Then0, Then),
 2908        expansion_simpler(Else0, Else).
 2909expansion_simpler((A0,B0), (A,B)) :-
 2910        expansion_simpler(A0, A),
 2911        expansion_simpler(B0, B).
 2912expansion_simpler(Var is Expr0, Goal) :-
 2913        ground(Expr0), !,
 2914        phrase(expr_conds(Expr0, Expr), Gs),
 2915        (   maplist(call, Gs) -> Value is Expr, Goal = (Var = Value)
 2916        ;   Goal = false
 2917        ).
 2918expansion_simpler(Var =:= Expr0, Goal) :-
 2919        ground(Expr0), !,
 2920        phrase(expr_conds(Expr0, Expr), Gs),
 2921        (   maplist(call, Gs) -> Value is Expr, Goal = (Var =:= Value)
 2922        ;   Goal = false
 2923        ).
 2924expansion_simpler(Var is Expr, Var = Expr) :- var(Expr), !.
 2925expansion_simpler(Var is Expr, Goal) :- !,
 2926        (   var(Var), nonvar(Expr),
 2927            Expr = E mod M, nonvar(E), E = A^B ->
 2928            Goal = ( ( integer(A), integer(B), integer(M),
 2929                       A >= 0, B >= 0, M > 0 ->
 2930                       Var is powm(A, B, M)
 2931                     ; Var is Expr
 2932                     ) )
 2933        ;   Goal = ( Var is Expr )
 2934        ).
 2935expansion_simpler(between(L,U,V), Goal) :- maplist(integer, [L,U,V]), !,
 2936        (   between(L,U,V) -> Goal = true
 2937        ;   Goal = false
 2938        ).
 2939expansion_simpler(Goal, Goal).
 2940
 2941is_true(true).
 2942is_true(integer(I))  :- integer(I).
 2943:- if(current_predicate(var_property/2)). 2944is_true(var(X))      :- var(X), var_property(X, fresh(true)).
 2945is_false(integer(X)) :- var(X), var_property(X, fresh(true)).
 2946is_false((A,B))      :- is_false(A) ; is_false(B).
 2947:- endif. 2948is_false(var(X)) :- nonvar(X).
 2949
 2950
 2951%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 2952
 2953linsum(X, S, S)    --> { var(X), !, non_monotonic(X) }, [vn(X,1)].
 2954linsum(I, S0, S)   --> { integer(I), S is S0 + I }.
 2955linsum(?(X), S, S) --> { must_be_fd_integer(X) }, [vn(X,1)].
 2956linsum(#(X), S, S) --> { must_be_fd_integer(X) }, [vn(X,1)].
 2957linsum(-A, S0, S)  --> mulsum(A, -1, S0, S).
 2958linsum(N*A, S0, S) --> { integer(N) }, !, mulsum(A, N, S0, S).
 2959linsum(A*N, S0, S) --> { integer(N) }, !, mulsum(A, N, S0, S).
 2960linsum(A+B, S0, S) --> linsum(A, S0, S1), linsum(B, S1, S).
 2961linsum(A-B, S0, S) --> linsum(A, S0, S1), mulsum(B, -1, S1, S).
 2962
 2963mulsum(A, M, S0, S) -->
 2964        { phrase(linsum(A, 0, CA), As), S is S0 + M*CA },
 2965        lin_mul(As, M).
 2966
 2967lin_mul([], _)             --> [].
 2968lin_mul([vn(X,N0)|VNs], M) --> { N is N0*M }, [vn(X,N)], lin_mul(VNs, M).
 2969
 2970v_or_i(V) :- var(V), !, non_monotonic(V).
 2971v_or_i(I) :- integer(I).
 2972
 2973must_be_fd_integer(X) :-
 2974        (   var(X) -> constrain_to_integer(X)
 2975        ;   must_be(integer, X)
 2976        ).
 2977
 2978left_right_linsum_const(Left, Right, Cs, Vs, Const) :-
 2979        phrase(linsum(Left, 0, CL), Lefts0, Rights),
 2980        phrase(linsum(Right, 0, CR), Rights0),
 2981        maplist(linterm_negate, Rights0, Rights),
 2982        msort(Lefts0, Lefts),
 2983        Lefts = [vn(First,N)|LeftsRest],
 2984        vns_coeffs_variables(LeftsRest, N, First, Cs0, Vs0),
 2985        filter_linsum(Cs0, Vs0, Cs, Vs),
 2986        Const is CR - CL.
 2987        %format("linear sum: ~w ~w ~w\n", [Cs,Vs,Const]).
 2988
 2989linterm_negate(vn(V,N0), vn(V,N)) :- N is -N0.
 2990
 2991vns_coeffs_variables([], N, V, [N], [V]).
 2992vns_coeffs_variables([vn(V,N)|VNs], N0, V0, Ns, Vs) :-
 2993        (   V == V0 ->
 2994            N1 is N0 + N,
 2995            vns_coeffs_variables(VNs, N1, V0, Ns, Vs)
 2996        ;   Ns = [N0|NRest],
 2997            Vs = [V0|VRest],
 2998            vns_coeffs_variables(VNs, N, V, NRest, VRest)
 2999        ).
 3000
 3001filter_linsum([], [], [], []).
 3002filter_linsum([C0|Cs0], [V0|Vs0], Cs, Vs) :-
 3003        (   C0 =:= 0 ->
 3004            constrain_to_integer(V0),
 3005            filter_linsum(Cs0, Vs0, Cs, Vs)
 3006        ;   Cs = [C0|Cs1], Vs = [V0|Vs1],
 3007            filter_linsum(Cs0, Vs0, Cs1, Vs1)
 3008        ).
 3009
 3010gcd([], G, G).
 3011gcd([N|Ns], G0, G) :-
 3012        G1 is gcd(N, G0),
 3013        gcd(Ns, G1, G).
 3014
 3015even(N) :- N mod 2 =:= 0.
 3016
 3017odd(N) :- \+ even(N).
 3018
 3019/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3020   k-th root of N, if N is a k-th power.
 3021
 3022   TODO: Replace this when the GMP function becomes available.
 3023- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3024
 3025integer_kth_root(N, K, R) :-
 3026        (   even(K) ->
 3027            N >= 0
 3028        ;   true
 3029        ),
 3030        (   N < 0 ->
 3031            odd(K),
 3032            integer_kroot(N, 0, N, K, R)
 3033        ;   integer_kroot(0, N, N, K, R)
 3034        ).
 3035
 3036integer_kroot(L, U, N, K, R) :-
 3037        (   L =:= U -> N =:= L^K, R = L
 3038        ;   L + 1 =:= U ->
 3039            (   L^K =:= N -> R = L
 3040            ;   U^K =:= N -> R = U
 3041            ;   false
 3042            )
 3043        ;   Mid is (L + U)//2,
 3044            (   Mid^K > N ->
 3045                integer_kroot(L, Mid, N, K, R)
 3046            ;   integer_kroot(Mid, U, N, K, R)
 3047            )
 3048        ).
 3049
 3050integer_log_b(N, B, Log0, Log) :-
 3051        T is B^Log0,
 3052        (   T =:= N -> Log = Log0
 3053        ;   T < N,
 3054            Log1 is Log0 + 1,
 3055            integer_log_b(N, B, Log1, Log)
 3056        ).
 3057
 3058floor_integer_log_b(N, B, Log0, Log) :-
 3059        T is B^Log0,
 3060        (   T > N -> Log is Log0 - 1
 3061        ;   T =:= N -> Log = Log0
 3062        ;   T < N,
 3063            Log1 is Log0 + 1,
 3064            floor_integer_log_b(N, B, Log1, Log)
 3065        ).
 3066
 3067
 3068/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3069   Largest R such that R^K =< N.
 3070- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3071
 3072:- if(current_predicate(nth_integer_root_and_remainder/4)). 3073
 3074% This currently only works for K >= 1, which is all that is needed for now.
 3075integer_kth_root_leq(N, K, R) :-
 3076        nth_integer_root_and_remainder(K, N, R, _).
 3077
 3078:- else. 3079
 3080integer_kth_root_leq(N, K, R) :-
 3081        (   even(K) ->
 3082            N >= 0
 3083        ;   true
 3084        ),
 3085        (   N < 0 ->
 3086            odd(K),
 3087            integer_kroot_leq(N, 0, N, K, R)
 3088        ;   integer_kroot_leq(0, N, N, K, R)
 3089        ).
 3090
 3091integer_kroot_leq(L, U, N, K, R) :-
 3092        (   L =:= U -> R = L
 3093        ;   L + 1 =:= U ->
 3094            (   U^K =< N -> R = U
 3095            ;   R = L
 3096            )
 3097        ;   Mid is (L + U)//2,
 3098            (   Mid^K > N ->
 3099                integer_kroot_leq(L, Mid, N, K, R)
 3100            ;   integer_kroot_leq(Mid, U, N, K, R)
 3101            )
 3102        ).
 3103
 3104:- endif. 3105
 3106%% ?X #\= ?Y
 3107%
 3108% The arithmetic expressions X and Y evaluate to distinct integers.
 3109% When reasoning over integers, replace `(=\=)/2` by #\=/2 to obtain
 3110% more general relations. See [declarative integer
 3111% arithmetic](<#clpfd-integer-arith>).
 3112
 3113X #\= Y :- clpfd_neq(X, Y), do_queue.
 3114
 3115% X #\= Y + Z
 3116
 3117x_neq_y_plus_z(X, Y, Z) :-
 3118        propagator_init_trigger(x_neq_y_plus_z(X,Y,Z)).
 3119
 3120% X is distinct from the number N. This is used internally, and does
 3121% not reinforce other constraints.
 3122
 3123neq_num(X, N) :-
 3124        (   fd_get(X, XD, XPs) ->
 3125            domain_remove(XD, N, XD1),
 3126            fd_put(X, XD1, XPs)
 3127        ;   X =\= N
 3128        ).
 3129
 3130%% ?X #> ?Y
 3131%
 3132% Same as Y #< X. When reasoning over integers, replace `(>)/2` by
 3133% #>/2 to obtain more general relations See [declarative integer
 3134% arithmetic](<#clpfd-integer-arith>).
 3135
 3136X #> Y  :- X #>= Y + 1.
 3137
 3138%% #<(?X, ?Y)
 3139%
 3140% The arithmetic expression X is less than Y. When reasoning over
 3141% integers, replace `(<)/2` by #</2 to obtain more general relations. See
 3142% [declarative integer arithmetic](<#clpfd-integer-arith>).
 3143%
 3144% In addition to its regular use in tasks that require it, this
 3145% constraint can also be useful to eliminate uninteresting symmetries
 3146% from a problem. For example, all possible matches between pairs
 3147% built from four players in total:
 3148%
 3149% ==
 3150% ?- Vs = [A,B,C,D], Vs ins 1..4,
 3151%         all_different(Vs),
 3152%         A #< B, C #< D, A #< C,
 3153%    findall(pair(A,B)-pair(C,D), label(Vs), Ms).
 3154% Ms = [ pair(1, 2)-pair(3, 4),
 3155%        pair(1, 3)-pair(2, 4),
 3156%        pair(1, 4)-pair(2, 3)].
 3157% ==
 3158
 3159X #< Y  :- Y #> X.
 3160
 3161%% #\ (+Q)
 3162%
 3163% Q does _not_ hold. See [reification](<#clpfd-reification>).
 3164%
 3165% For example, to obtain the complement of a domain:
 3166%
 3167% ==
 3168% ?- #\ X in -3..0\/10..80.
 3169% X in inf.. -4\/1..9\/81..sup.
 3170% ==
 3171
 3172#\ Q       :- reify(Q, 0), do_queue.
 3173
 3174%% ?P #<==> ?Q
 3175%
 3176% P and Q are equivalent. See [reification](<#clpfd-reification>).
 3177%
 3178% For example:
 3179%
 3180% ==
 3181% ?- X #= 4 #<==> B, X #\= 4.
 3182% B = 0,
 3183% X in inf..3\/5..sup.
 3184% ==
 3185% The following example uses reified constraints to relate a list of
 3186% finite domain variables to the number of occurrences of a given value:
 3187%
 3188% ==
 3189% vs_n_num(Vs, N, Num) :-
 3190%         maplist(eq_b(N), Vs, Bs),
 3191%         sum(Bs, #=, Num).
 3192%
 3193% eq_b(X, Y, B) :- X #= Y #<==> B.
 3194% ==
 3195%
 3196% Sample queries and their results:
 3197%
 3198% ==
 3199% ?- Vs = [X,Y,Z], Vs ins 0..1, vs_n_num(Vs, 4, Num).
 3200% Vs = [X, Y, Z],
 3201% Num = 0,
 3202% X in 0..1,
 3203% Y in 0..1,
 3204% Z in 0..1.
 3205%
 3206% ?- vs_n_num([X,Y,Z], 2, 3).
 3207% X = 2,
 3208% Y = 2,
 3209% Z = 2.
 3210% ==
 3211
 3212L #<==> R  :- reify(L, B), reify(R, B), do_queue.
 3213
 3214%% ?P #==> ?Q
 3215%
 3216% P implies Q. See [reification](<#clpfd-reification>).
 3217
 3218/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3219   Implication is special in that created auxiliary constraints can be
 3220   retracted when the implication becomes entailed, for example:
 3221
 3222   %?- X + 1 #= Y #==> Z, Z #= 1.
 3223   %@ Z = 1,
 3224   %@ X in inf..sup,
 3225   %@ Y in inf..sup.
 3226
 3227   We cannot use propagator_init_trigger/1 here because the states of
 3228   auxiliary propagators are themselves part of the propagator.
 3229- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3230
 3231L #==> R   :-
 3232        reify(L, LB, LPs),
 3233        reify(R, RB, RPs),
 3234        append(LPs, RPs, Ps),
 3235        propagator_init_trigger([LB,RB], pimpl(LB,RB,Ps)).
 3236
 3237%% ?P #<== ?Q
 3238%
 3239% Q implies P. See [reification](<#clpfd-reification>).
 3240
 3241L #<== R   :- R #==> L.
 3242
 3243%% ?P #/\ ?Q
 3244%
 3245% P and Q hold. See [reification](<#clpfd-reification>).
 3246
 3247L #/\ R    :- reify(L, 1), reify(R, 1), do_queue.
 3248
 3249conjunctive_neqs_var_drep(Eqs, Var, Drep) :-
 3250        conjunctive_neqs_var(Eqs, Var),
 3251        phrase(conjunctive_neqs_vals(Eqs), Vals),
 3252        list_to_domain(Vals, Dom),
 3253        domain_complement(Dom, C),
 3254        domain_to_drep(C, Drep).
 3255
 3256conjunctive_neqs_var(V, _) :- var(V), !, false.
 3257conjunctive_neqs_var(L #\= R, Var) :-
 3258        (   var(L), integer(R) -> Var = L
 3259        ;   integer(L), var(R) -> Var = R
 3260        ;   false
 3261        ).
 3262conjunctive_neqs_var(A #/\ B, VA) :-
 3263        conjunctive_neqs_var(A, VA),
 3264        conjunctive_neqs_var(B, VB),
 3265        VA == VB.
 3266
 3267conjunctive_neqs_vals(L #\= R) --> ( { integer(L) } -> [L] ; [R] ).
 3268conjunctive_neqs_vals(A #/\ B) -->
 3269        conjunctive_neqs_vals(A),
 3270        conjunctive_neqs_vals(B).
 3271
 3272%% ?P #\/ ?Q
 3273%
 3274% P or Q holds. See [reification](<#clpfd-reification>).
 3275%
 3276% For example, the sum of natural numbers below 1000 that are
 3277% multiples of 3 or 5:
 3278%
 3279% ==
 3280% ?- findall(N, (N mod 3 #= 0 #\/ N mod 5 #= 0, N in 0..999,
 3281%                indomain(N)),
 3282%            Ns),
 3283%    sum(Ns, #=, Sum).
 3284% Ns = [0, 3, 5, 6, 9, 10, 12, 15, 18|...],
 3285% Sum = 233168.
 3286% ==
 3287
 3288L #\/ R :-
 3289        (   disjunctive_eqs_var_drep(L #\/ R, Var, Drep) -> Var in Drep
 3290        ;   reify(L, X, Ps1),
 3291            reify(R, Y, Ps2),
 3292            propagator_init_trigger([X,Y], reified_or(X,Ps1,Y,Ps2,1))
 3293        ).
 3294
 3295disjunctive_eqs_var_drep(Eqs, Var, Drep) :-
 3296        disjunctive_eqs_var(Eqs, Var),
 3297        phrase(disjunctive_eqs_vals(Eqs), Vals),
 3298        list_to_drep(Vals, Drep).
 3299
 3300disjunctive_eqs_var(V, _) :- var(V), !, false.
 3301disjunctive_eqs_var(V in I, V) :- var(V), integer(I).
 3302disjunctive_eqs_var(L #= R, Var) :-
 3303        (   var(L), integer(R) -> Var = L
 3304        ;   integer(L), var(R) -> Var = R
 3305        ;   false
 3306        ).
 3307disjunctive_eqs_var(A #\/ B, VA) :-
 3308        disjunctive_eqs_var(A, VA),
 3309        disjunctive_eqs_var(B, VB),
 3310        VA == VB.
 3311
 3312disjunctive_eqs_vals(L #= R)  --> ( { integer(L) } -> [L] ; [R] ).
 3313disjunctive_eqs_vals(_ in I)  --> [I].
 3314disjunctive_eqs_vals(A #\/ B) -->
 3315        disjunctive_eqs_vals(A),
 3316        disjunctive_eqs_vals(B).
 3317
 3318%% ?P #\ ?Q
 3319%
 3320% Either P holds or Q holds, but not both. See
 3321% [reification](<#clpfd-reification>).
 3322
 3323L #\ R :- (L #\/ R) #/\ #\ (L #/\ R).
 3324
 3325/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3326   A constraint that is being reified need not hold. Therefore, in
 3327   X/Y, Y can as well be 0, for example. Note that it is OK to
 3328   constrain the *result* of an expression (which does not appear
 3329   explicitly in the expression and is not visible to the outside),
 3330   but not the operands, except for requiring that they be integers.
 3331
 3332   In contrast to parse_clpfd/2, the result of an expression can now
 3333   also be undefined, in which case the constraint cannot hold.
 3334   Therefore, the committed-choice language is extended by an element
 3335   d(D) that states D is 1 iff all subexpressions are defined. a(V)
 3336   means that V is an auxiliary variable that was introduced while
 3337   parsing a compound expression. a(X,V) means V is auxiliary unless
 3338   it is ==/2 X, and a(X,Y,V) means V is auxiliary unless it is ==/2 X
 3339   or Y. l(L) means the literal L occurs in the described list.
 3340
 3341   When a constraint becomes entailed or subexpressions become
 3342   undefined, created auxiliary constraints are killed, and the
 3343   "clpfd" attribute is removed from auxiliary variables.
 3344
 3345   For (/)/2, mod/2 and rem/2, we create a skeleton propagator and
 3346   remember it as an auxiliary constraint. The pskeleton propagator
 3347   can use the skeleton when the constraint is defined.
 3348- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3349
 3350parse_reified(E, R, D,
 3351              [g(cyclic_term(E)) => [g(domain_error(clpfd_expression, E))],
 3352               g(var(E))     => [g(non_monotonic(E)),
 3353                                 g(constrain_to_integer(E)), g(R = E), g(D=1)],
 3354               g(integer(E)) => [g(R=E), g(D=1)],
 3355               ?(E)          => [g(must_be_fd_integer(E)), g(R=E), g(D=1)],
 3356               #(E)          => [g(must_be_fd_integer(E)), g(R=E), g(D=1)],
 3357               m(A+B)        => [d(D), p(pplus(A,B,R)), a(A,B,R)],
 3358               m(A*B)        => [d(D), p(ptimes(A,B,R)), a(A,B,R)],
 3359               m(A-B)        => [d(D), p(pplus(R,B,A)), a(A,B,R)],
 3360               m(-A)         => [d(D), p(ptimes(-1,A,R)), a(R)],
 3361               m(max(A,B))   => [d(D), p(pgeq(R, A)), p(pgeq(R, B)), p(pmax(A,B,R)), a(A,B,R)],
 3362               m(min(A,B))   => [d(D), p(pgeq(A, R)), p(pgeq(B, R)), p(pmin(A,B,R)), a(A,B,R)],
 3363               m(abs(A))     => [g(?(R)#>=0), d(D), p(pabs(A, R)), a(A,R)],
 3364%               m(A/B)        => [skeleton(A,B,D,R,ptzdiv)],
 3365               m(A//B)       => [skeleton(A,B,D,R,ptzdiv)],
 3366               m(A div B)    => [skeleton(A,B,D,R,pdiv)],
 3367               m(A rdiv B)   => [skeleton(A,B,D,R,prdiv)],
 3368               m(A mod B)    => [skeleton(A,B,D,R,pmod)],
 3369               m(A rem B)    => [skeleton(A,B,D,R,prem)],
 3370               m(A^B)        => [d(D), p(pexp(A,B,R)), a(A,B,R)],
 3371               % bitwise operations
 3372               m(\A)         => [function(D,\,A,R)],
 3373               m(msb(A))     => [function(D,msb,A,R)],
 3374               m(lsb(A))     => [function(D,lsb,A,R)],
 3375               m(popcount(A)) => [function(D,popcount,A,R)],
 3376               m(A<<B)       => [function(D,<<,A,B,R)],
 3377               m(A>>B)       => [function(D,>>,A,B,R)],
 3378               m(A/\B)       => [function(D,/\,A,B,R)],
 3379               m(A\/B)       => [function(D,\/,A,B,R)],
 3380               m(A xor B)    => [function(D,xor,A,B,R)],
 3381               g(true)       => [g(domain_error(clpfd_expression, E))]]
 3382             ).
 3383
 3384% Again, we compile this to a predicate, parse_reified_clpfd//3. This
 3385% time, it is a DCG that describes the list of auxiliary variables and
 3386% propagators for the given expression, in addition to relating it to
 3387% its reified (Boolean) finite domain variable and its Boolean
 3388% definedness.
 3389
 3390make_parse_reified(Clauses) :-
 3391        parse_reified_clauses(Clauses0),
 3392        maplist(goals_goal_dcg, Clauses0, Clauses).
 3393
 3394goals_goal_dcg((Head --> Goals), Clause) :-
 3395        list_goal(Goals, Body),
 3396        expand_term((Head --> Body), Clause).
 3397
 3398parse_reified_clauses(Clauses) :-
 3399        parse_reified(E, R, D, Matchers),
 3400        maplist(parse_reified(E, R, D), Matchers, Clauses).
 3401
 3402parse_reified(E, R, D, Matcher, Clause) :-
 3403        Matcher = (Condition0 => Goals0),
 3404        phrase((reified_condition(Condition0, E, Head, Ds),
 3405                reified_goals(Goals0, Ds)), Goals, [a(D)]),
 3406        Clause = (parse_reified_clpfd(Head, R, D) --> Goals).
 3407
 3408reified_condition(g(Goal), E, E, []) --> [{Goal}, !].
 3409reified_condition(?(E), _, ?(E), []) --> [!].
 3410reified_condition(#(E), _, #(E), []) --> [!].
 3411reified_condition(m(Match), _, Match0, Ds) -->
 3412        [!],
 3413        { copy_term(Match, Match0),
 3414          term_variables(Match0, Vs0),
 3415          term_variables(Match, Vs)
 3416        },
 3417        reified_variables(Vs0, Vs, Ds).
 3418
 3419reified_variables([], [], []) --> [].
 3420reified_variables([V0|Vs0], [V|Vs], [D|Ds]) -->
 3421        [parse_reified_clpfd(V0, V, D)],
 3422        reified_variables(Vs0, Vs, Ds).
 3423
 3424reified_goals([], _) --> [].
 3425reified_goals([G|Gs], Ds) --> reified_goal(G, Ds), reified_goals(Gs, Ds).
 3426
 3427reified_goal(d(D), Ds) -->
 3428        (   { Ds = [X] } -> [{D=X}]
 3429        ;   { Ds = [X,Y] } ->
 3430            { phrase(reified_goal(p(reified_and(X,[],Y,[],D)), _), Gs),
 3431              list_goal(Gs, Goal) },
 3432            [( {X==1, Y==1} -> {D = 1} ; Goal )]
 3433        ;   { domain_error(one_or_two_element_list, Ds) }
 3434        ).
 3435reified_goal(g(Goal), _) --> [{Goal}].
 3436reified_goal(p(Vs, Prop), _) -->
 3437        [{make_propagator(Prop, P)}],
 3438        parse_init_dcg(Vs, P),
 3439        [{trigger_once(P)}],
 3440        [( { propagator_state(P, S), S == dead } -> [] ; [p(P)])].
 3441reified_goal(p(Prop), Ds) -->
 3442        { term_variables(Prop, Vs) },
 3443        reified_goal(p(Vs,Prop), Ds).
 3444reified_goal(function(D,Op,A,B,R), Ds) -->
 3445        reified_goals([d(D),p(pfunction(Op,A,B,R)),a(A,B,R)], Ds).
 3446reified_goal(function(D,Op,A,R), Ds) -->
 3447        reified_goals([d(D),p(pfunction(Op,A,R)),a(A,R)], Ds).
 3448reified_goal(skeleton(A,B,D,R,F), Ds) -->
 3449        { Prop =.. [F,X,Y,Z] },
 3450        reified_goals([d(D1),l(p(P)),g(make_propagator(Prop, P)),
 3451                       p([A,B,D2,R], pskeleton(A,B,D2,[X,Y,Z]-P,R,F)),
 3452                       p(reified_and(D1,[],D2,[],D)),a(D2),a(A,B,R)], Ds).
 3453reified_goal(a(V), _)     --> [a(V)].
 3454reified_goal(a(X,V), _)   --> [a(X,V)].
 3455reified_goal(a(X,Y,V), _) --> [a(X,Y,V)].
 3456reified_goal(l(L), _)     --> [[L]].
 3457
 3458parse_init_dcg([], _)     --> [].
 3459parse_init_dcg([V|Vs], P) --> [{init_propagator(V, P)}], parse_init_dcg(Vs, P).
 3460
 3461%?- set_prolog_flag(answer_write_options, [portray(true)]),
 3462%   clpfd:parse_reified_clauses(Cs), maplist(portray_clause, Cs).
 3463
 3464reify(E, B) :- reify(E, B, _).
 3465
 3466reify(Expr, B, Ps) :-
 3467        (   acyclic_term(Expr), reifiable(Expr) -> phrase(reify(Expr, B), Ps)
 3468        ;   domain_error(clpfd_reifiable_expression, Expr)
 3469        ).
 3470
 3471reifiable(E)      :- var(E), non_monotonic(E).
 3472reifiable(E)      :- integer(E), E in 0..1.
 3473reifiable(?(E))   :- must_be_fd_integer(E).
 3474reifiable(#(E))   :- must_be_fd_integer(E).
 3475reifiable(V in _) :- fd_variable(V).
 3476reifiable(Expr)   :-
 3477        Expr =.. [Op,Left,Right],
 3478        (   memberchk(Op, [#>=,#>,#=<,#<,#=,#\=])
 3479        ;   memberchk(Op, [#==>,#<==,#<==>,#/\,#\/,#\]),
 3480            reifiable(Left),
 3481            reifiable(Right)
 3482        ).
 3483reifiable(#\ E) :- reifiable(E).
 3484reifiable(tuples_in(Tuples, Relation)) :-
 3485        must_be(list(list), Tuples),
 3486        maplist(maplist(fd_variable), Tuples),
 3487        must_be(list(list(integer)), Relation).
 3488reifiable(finite_domain(V)) :- fd_variable(V).
 3489
 3490reify(E, B) --> { B in 0..1 }, reify_(E, B).
 3491
 3492reify_(E, B) --> { var(E), !, E = B }.
 3493reify_(E, B) --> { integer(E), E = B }.
 3494reify_(?(B), B) --> [].
 3495reify_(#(B), B) --> [].
 3496reify_(V in Drep, B) -->
 3497        { drep_to_domain(Drep, Dom) },
 3498        propagator_init_trigger(reified_in(V,Dom,B)),
 3499        a(B).
 3500reify_(tuples_in(Tuples, Relation), B) -->
 3501        { maplist(relation_tuple_b_prop(Relation), Tuples, Bs, Ps),
 3502          maplist(monotonic, Bs, Bs1),
 3503          fold_statement(conjunction, Bs1, And),
 3504          ?(B) #<==> And },
 3505        propagator_init_trigger([B], tuples_not_in(Tuples, Relation, B)),
 3506        kill_reified_tuples(Bs, Ps, Bs),
 3507        list(Ps),
 3508        as([B|Bs]).
 3509reify_(finite_domain(V), B) -->
 3510        propagator_init_trigger(reified_fd(V,B)),
 3511        a(B).
 3512reify_(L #>= R, B) --> arithmetic(L, R, B, reified_geq).
 3513reify_(L #= R, B)  --> arithmetic(L, R, B, reified_eq).
 3514reify_(L #\= R, B) --> arithmetic(L, R, B, reified_neq).
 3515reify_(L #> R, B)  --> reify_(L #>= (R+1), B).
 3516reify_(L #=< R, B) --> reify_(R #>= L, B).
 3517reify_(L #< R, B)  --> reify_(R #>= (L+1), B).
 3518reify_(L #==> R, B)  --> reify_((#\ L) #\/ R, B).
 3519reify_(L #<== R, B)  --> reify_(R #==> L, B).
 3520reify_(L #<==> R, B) --> reify_((L #==> R) #/\ (R #==> L), B).
 3521reify_(L #\ R, B) --> reify_((L #\/ R) #/\ #\ (L #/\ R), B).
 3522reify_(L #/\ R, B)   -->
 3523        (   { conjunctive_neqs_var_drep(L #/\ R, V, D) } -> reify_(V in D, B)
 3524        ;   boolean(L, R, B, reified_and)
 3525        ).
 3526reify_(L #\/ R, B) -->
 3527        (   { disjunctive_eqs_var_drep(L #\/ R, V, D) } -> reify_(V in D, B)
 3528        ;   boolean(L, R, B, reified_or)
 3529        ).
 3530reify_(#\ Q, B) -->
 3531        reify(Q, QR),
 3532        propagator_init_trigger(reified_not(QR,B)),
 3533        a(B).
 3534
 3535arithmetic(L, R, B, Functor) -->
 3536        { phrase((parse_reified_clpfd(L, LR, LD),
 3537                  parse_reified_clpfd(R, RR, RD)), Ps),
 3538          Prop =.. [Functor,LD,LR,RD,RR,Ps,B] },
 3539        list(Ps),
 3540        propagator_init_trigger([LD,LR,RD,RR,B], Prop),
 3541        a(B).
 3542
 3543boolean(L, R, B, Functor) -->
 3544        { reify(L, LR, Ps1), reify(R, RR, Ps2),
 3545          Prop =.. [Functor,LR,Ps1,RR,Ps2,B] },
 3546        list(Ps1), list(Ps2),
 3547        propagator_init_trigger([LR,RR,B], Prop),
 3548        a(LR, RR, B).
 3549
 3550list([])     --> [].
 3551list([L|Ls]) --> [L], list(Ls).
 3552
 3553a(X,Y,B) -->
 3554        (   { nonvar(X) } -> a(Y, B)
 3555        ;   { nonvar(Y) } -> a(X, B)
 3556        ;   [a(X,Y,B)]
 3557        ).
 3558
 3559a(X, B) -->
 3560        (   { var(X) } -> [a(X, B)]
 3561        ;   a(B)
 3562        ).
 3563
 3564a(B) -->
 3565        (   { var(B) } -> [a(B)]
 3566        ;   []
 3567        ).
 3568
 3569as([])     --> [].
 3570as([B|Bs]) --> a(B), as(Bs).
 3571
 3572kill_reified_tuples([], _, _) --> [].
 3573kill_reified_tuples([B|Bs], Ps, All) -->
 3574        propagator_init_trigger([B], kill_reified_tuples(B, Ps, All)),
 3575        kill_reified_tuples(Bs, Ps, All).
 3576
 3577relation_tuple_b_prop(Relation, Tuple, B, p(Prop)) :-
 3578        put_attr(R, clpfd_relation, Relation),
 3579        make_propagator(reified_tuple_in(Tuple, R, B), Prop),
 3580        tuple_freeze_(Tuple, Prop),
 3581        init_propagator(B, Prop).
 3582
 3583
 3584tuples_in_conjunction(Tuples, Relation, Conj) :-
 3585        maplist(tuple_in_disjunction(Relation), Tuples, Disjs),
 3586        fold_statement(conjunction, Disjs, Conj).
 3587
 3588tuple_in_disjunction(Relation, Tuple, Disj) :-
 3589        maplist(tuple_in_conjunction(Tuple), Relation, Conjs),
 3590        fold_statement(disjunction, Conjs, Disj).
 3591
 3592tuple_in_conjunction(Tuple, Element, Conj) :-
 3593        maplist(var_eq, Tuple, Element, Eqs),
 3594        fold_statement(conjunction, Eqs, Conj).
 3595
 3596fold_statement(Operation, List, Statement) :-
 3597        (   List = [] -> Statement = 1
 3598        ;   List = [First|Rest],
 3599            foldl(Operation, Rest, First, Statement)
 3600        ).
 3601
 3602conjunction(E, Conj, Conj #/\ E).
 3603
 3604disjunction(E, Disj, Disj #\/ E).
 3605
 3606var_eq(V, N, ?(V) #= N).
 3607
 3608% Match variables to created skeleton.
 3609
 3610skeleton(Vs, Vs-Prop) :-
 3611        maplist(prop_init(Prop), Vs),
 3612        trigger_once(Prop).
 3613
 3614/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3615   A drep is a user-accessible and visible domain representation. N,
 3616   N..M, and D1 \/ D2 are dreps, if D1 and D2 are dreps.
 3617- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3618
 3619is_drep(N)      :- integer(N).
 3620is_drep(N..M)   :- drep_bound(N), drep_bound(M), N \== sup, M \== inf.
 3621is_drep(D1\/D2) :- is_drep(D1), is_drep(D2).
 3622is_drep({AI})   :- is_and_integers(AI).
 3623is_drep(\D)     :- is_drep(D).
 3624
 3625is_and_integers(I)     :- integer(I).
 3626is_and_integers((A,B)) :- is_and_integers(A), is_and_integers(B).
 3627
 3628drep_bound(I)   :- integer(I).
 3629drep_bound(sup).
 3630drep_bound(inf).
 3631
 3632drep_to_intervals(I)        --> { integer(I) }, [n(I)-n(I)].
 3633drep_to_intervals(N..M)     -->
 3634        (   { defaulty_to_bound(N, N1), defaulty_to_bound(M, M1),
 3635              N1 cis_leq M1} -> [N1-M1]
 3636        ;   []
 3637        ).
 3638drep_to_intervals(D1 \/ D2) -->
 3639        drep_to_intervals(D1), drep_to_intervals(D2).
 3640drep_to_intervals(\D0) -->
 3641        { drep_to_domain(D0, D1),
 3642          domain_complement(D1, D),
 3643          domain_to_drep(D, Drep) },
 3644        drep_to_intervals(Drep).
 3645drep_to_intervals({AI}) -->
 3646        and_integers_(AI).
 3647
 3648and_integers_(I)     --> { integer(I) }, [n(I)-n(I)].
 3649and_integers_((A,B)) --> and_integers_(A), and_integers_(B).
 3650
 3651drep_to_domain(DR, D) :-
 3652        must_be(ground, DR),
 3653        (   is_drep(DR) -> true
 3654        ;   domain_error(clpfd_domain, DR)
 3655        ),
 3656        phrase(drep_to_intervals(DR), Is0),
 3657        merge_intervals(Is0, Is1),
 3658        intervals_to_domain(Is1, D).
 3659
 3660merge_intervals(Is0, Is) :-
 3661        keysort(Is0, Is1),
 3662        merge_overlapping(Is1, Is).
 3663
 3664merge_overlapping([], []).
 3665merge_overlapping([A-B0|ABs0], [A-B|ABs]) :-
 3666        merge_remaining(ABs0, B0, B, Rest),
 3667        merge_overlapping(Rest, ABs).
 3668
 3669merge_remaining([], B, B, []).
 3670merge_remaining([N-M|NMs], B0, B, Rest) :-
 3671        Next cis B0 + n(1),
 3672        (   N cis_gt Next -> B = B0, Rest = [N-M|NMs]
 3673        ;   B1 cis max(B0,M),
 3674            merge_remaining(NMs, B1, B, Rest)
 3675        ).
 3676
 3677domain(V, Dom) :-
 3678        (   fd_get(V, Dom0, VPs) ->
 3679            domains_intersection(Dom, Dom0, Dom1),
 3680            %format("intersected\n: ~w\n ~w\n==> ~w\n\n", [Dom,Dom0,Dom1]),
 3681            fd_put(V, Dom1, VPs),
 3682            do_queue,
 3683            reinforce(V)
 3684        ;   domain_contains(Dom, V)
 3685        ).
 3686
 3687domains([], _).
 3688domains([V|Vs], D) :- domain(V, D), domains(Vs, D).
 3689
 3690props_number(fd_props(Gs,Bs,Os), N) :-
 3691        length(Gs, N1),
 3692        length(Bs, N2),
 3693        length(Os, N3),
 3694        N is N1 + N2 + N3.
 3695
 3696fd_get(X, Dom, Ps) :-
 3697        (   get_attr(X, clpfd, Attr) -> Attr = clpfd_attr(_,_,_,Dom,Ps)
 3698        ;   var(X) -> default_domain(Dom), Ps = fd_props([],[],[])
 3699        ).
 3700
 3701fd_get(X, Dom, Inf, Sup, Ps) :-
 3702        fd_get(X, Dom, Ps),
 3703        domain_infimum(Dom, Inf),
 3704        domain_supremum(Dom, Sup).
 3705
 3706/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3707   By default, propagation always terminates. Currently, this is
 3708   ensured by allowing the left and right boundaries, as well as the
 3709   distance between the smallest and largest number occurring in the
 3710   domain representation to be changed at most once after a constraint
 3711   is posted, unless the domain is bounded. Set the experimental
 3712   Prolog flag 'clpfd_propagation' to 'full' to make the solver
 3713   propagate as much as possible. This can make queries
 3714   non-terminating, like: X #> abs(X), or: X #> Y, Y #> X, X #> 0.
 3715   Importantly, it can also make labeling non-terminating, as in:
 3716
 3717   ?- B #==> X #> abs(X), indomain(B).
 3718- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3719
 3720fd_put(X, Dom, Ps) :-
 3721        (   current_prolog_flag(clpfd_propagation, full) ->
 3722            put_full(X, Dom, Ps)
 3723        ;   put_terminating(X, Dom, Ps)
 3724        ).
 3725
 3726put_terminating(X, Dom, Ps) :-
 3727        Dom \== empty,
 3728        (   Dom = from_to(F, F) -> F = n(X)
 3729        ;   (   get_attr(X, clpfd, Attr) ->
 3730                Attr = clpfd_attr(Left,Right,Spread,OldDom, _OldPs),
 3731                put_attr(X, clpfd, clpfd_attr(Left,Right,Spread,Dom,Ps)),
 3732                (   OldDom == Dom -> true
 3733                ;   (   Left == (.) -> Bounded = yes
 3734                    ;   domain_infimum(Dom, Inf), domain_supremum(Dom, Sup),
 3735                        (   Inf = n(_), Sup = n(_) ->
 3736                            Bounded = yes
 3737                        ;   Bounded = no
 3738                        )
 3739                    ),
 3740                    (   Bounded == yes ->
 3741                        put_attr(X, clpfd, clpfd_attr(.,.,.,Dom,Ps)),
 3742                        trigger_props(Ps, X, OldDom, Dom)
 3743                    ;   % infinite domain; consider border and spread changes
 3744                        domain_infimum(OldDom, OldInf),
 3745                        (   Inf == OldInf -> LeftP = Left
 3746                        ;   LeftP = yes
 3747                        ),
 3748                        domain_supremum(OldDom, OldSup),
 3749                        (   Sup == OldSup -> RightP = Right
 3750                        ;   RightP = yes
 3751                        ),
 3752                        domain_spread(OldDom, OldSpread),
 3753                        domain_spread(Dom, NewSpread),
 3754                        (   NewSpread == OldSpread -> SpreadP = Spread
 3755                        ;   NewSpread cis_lt OldSpread -> SpreadP = no
 3756                        ;   SpreadP = yes
 3757                        ),
 3758                        put_attr(X, clpfd, clpfd_attr(LeftP,RightP,SpreadP,Dom,Ps)),
 3759                        (   RightP == yes, Right = yes -> true
 3760                        ;   LeftP == yes, Left = yes -> true
 3761                        ;   SpreadP == yes, Spread = yes -> true
 3762                        ;   trigger_props(Ps, X, OldDom, Dom)
 3763                        )
 3764                    )
 3765                )
 3766            ;   var(X) ->
 3767                put_attr(X, clpfd, clpfd_attr(no,no,no,Dom, Ps))
 3768            ;   true
 3769            )
 3770        ).
 3771
 3772domain_spread(Dom, Spread) :-
 3773        domain_smallest_finite(Dom, S),
 3774        domain_largest_finite(Dom, L),
 3775        Spread cis L - S.
 3776
 3777smallest_finite(inf, Y, Y).
 3778smallest_finite(n(N), _, n(N)).
 3779
 3780domain_smallest_finite(from_to(F,T), S)   :- smallest_finite(F, T, S).
 3781domain_smallest_finite(split(_, L, _), S) :- domain_smallest_finite(L, S).
 3782
 3783largest_finite(sup, Y, Y).
 3784largest_finite(n(N), _, n(N)).
 3785
 3786domain_largest_finite(from_to(F,T), L)   :- largest_finite(T, F, L).
 3787domain_largest_finite(split(_, _, R), L) :- domain_largest_finite(R, L).
 3788
 3789/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3790   With terminating propagation, all relevant constraints get a
 3791   propagation opportunity whenever a new constraint is posted.
 3792- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3793
 3794reinforce(X) :-
 3795        (   current_prolog_flag(clpfd_propagation, full) ->
 3796            % full propagation propagates everything in any case
 3797            true
 3798        ;   term_variables(X, Vs),
 3799            maplist(reinforce_, Vs),
 3800            do_queue
 3801        ).
 3802
 3803reinforce_(X) :-
 3804        (   fd_var(X), fd_get(X, Dom, Ps) ->
 3805            put_full(X, Dom, Ps)
 3806        ;   true
 3807        ).
 3808
 3809put_full(X, Dom, Ps) :-
 3810        Dom \== empty,
 3811        (   Dom = from_to(F, F) -> F = n(X)
 3812        ;   (   get_attr(X, clpfd, Attr) ->
 3813                Attr = clpfd_attr(_,_,_,OldDom, _OldPs),
 3814                put_attr(X, clpfd, clpfd_attr(no,no,no,Dom, Ps)),
 3815                %format("putting dom: ~w\n", [Dom]),
 3816                (   OldDom == Dom -> true
 3817                ;   trigger_props(Ps, X, OldDom, Dom)
 3818                )
 3819            ;   var(X) -> %format('\t~w in ~w .. ~w\n',[X,L,U]),
 3820                put_attr(X, clpfd, clpfd_attr(no,no,no,Dom, Ps))
 3821            ;   true
 3822            )
 3823        ).
 3824
 3825/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3826   A propagator is a term of the form propagator(C, State), where C
 3827   represents a constraint, and State is a free variable that can be
 3828   used to destructively change the state of the propagator via
 3829   attributes. This can be used to avoid redundant invocation of the
 3830   same propagator, or to disable the propagator.
 3831- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3832
 3833make_propagator(C, propagator(C, _)).
 3834
 3835propagator_state(propagator(_,S), S).
 3836
 3837trigger_props(fd_props(Gs,Bs,Os), X, D0, D) :-
 3838        (   ground(X) ->
 3839            trigger_props_(Gs),
 3840            trigger_props_(Bs)
 3841        ;   Bs \== [] ->
 3842            domain_infimum(D0, I0),
 3843            domain_infimum(D, I),
 3844            (   I == I0 ->
 3845                domain_supremum(D0, S0),
 3846                domain_supremum(D, S),
 3847                (   S == S0 -> true
 3848                ;   trigger_props_(Bs)
 3849                )
 3850            ;   trigger_props_(Bs)
 3851            )
 3852        ;   true
 3853        ),
 3854        trigger_props_(Os).
 3855
 3856trigger_props(fd_props(Gs,Bs,Os), X) :-
 3857        trigger_props_(Os),
 3858        trigger_props_(Bs),
 3859        (   ground(X) ->
 3860            trigger_props_(Gs)
 3861        ;   true
 3862        ).
 3863
 3864trigger_props(fd_props(Gs,Bs,Os)) :-
 3865        trigger_props_(Gs),
 3866        trigger_props_(Bs),
 3867        trigger_props_(Os).
 3868
 3869trigger_props_([]).
 3870trigger_props_([P|Ps]) :- trigger_prop(P), trigger_props_(Ps).
 3871
 3872trigger_prop(Propagator) :-
 3873        propagator_state(Propagator, State),
 3874        (   State == dead -> true
 3875        ;   get_attr(State, clpfd_aux, queued) -> true
 3876        ;   b_getval('$clpfd_current_propagator', C), C == State -> true
 3877        ;   % passive
 3878            % format("triggering: ~w\n", [Propagator]),
 3879            put_attr(State, clpfd_aux, queued),
 3880            (   arg(1, Propagator, C), functor(C, F, _), global_constraint(F) ->
 3881                push_queue(Propagator, 2)
 3882            ;   push_queue(Propagator, 1)
 3883            )
 3884        ).
 3885
 3886kill(State) :- del_attr(State, clpfd_aux), State = dead.
 3887
 3888kill(State, Ps) :-
 3889        kill(State),
 3890        maplist(kill_entailed, Ps).
 3891
 3892kill_entailed(p(Prop)) :-
 3893        propagator_state(Prop, State),
 3894        kill(State).
 3895kill_entailed(a(V)) :-
 3896        del_attr(V, clpfd).
 3897kill_entailed(a(X,B)) :-
 3898        (   X == B -> true
 3899        ;   del_attr(B, clpfd)
 3900        ).
 3901kill_entailed(a(X,Y,B)) :-
 3902        (   X == B -> true
 3903        ;   Y == B -> true
 3904        ;   del_attr(B, clpfd)
 3905        ).
 3906
 3907no_reactivation(rel_tuple(_,_)).
 3908no_reactivation(pdistinct(_)).
 3909no_reactivation(pgcc(_,_,_)).
 3910no_reactivation(pgcc_single(_,_)).
 3911%no_reactivation(scalar_product(_,_,_,_)).
 3912
 3913activate_propagator(propagator(P,State)) :-
 3914        % format("running: ~w\n", [P]),
 3915        del_attr(State, clpfd_aux),
 3916        (   no_reactivation(P) ->
 3917            b_setval('$clpfd_current_propagator', State),
 3918            run_propagator(P, State),
 3919            b_setval('$clpfd_current_propagator', [])
 3920        ;   run_propagator(P, State)
 3921        ).
 3922
 3923disable_queue :- b_setval('$clpfd_queue_status', disabled).
 3924enable_queue  :- b_setval('$clpfd_queue_status', enabled).
 3925
 3926portray_propagator(propagator(P,_), F) :- functor(P, F, _).
 3927
 3928portray_queue(V, []) :- var(V), !.
 3929portray_queue([P|Ps], [F|Fs]) :-
 3930        portray_propagator(P, F),
 3931        portray_queue(Ps, Fs).
 3932
 3933do_queue :-
 3934        % b_getval('$clpfd_queue', H-_),
 3935        % portray_queue(H, Port),
 3936        % format("queue: ~w\n", [Port]),
 3937        (   b_getval('$clpfd_queue_status', enabled) ->
 3938            (   fetch_propagator(Propagator) ->
 3939                activate_propagator(Propagator),
 3940                do_queue
 3941            ;   true
 3942            )
 3943        ;   true
 3944        ).
 3945
 3946init_propagator(Var, Prop) :-
 3947        (   fd_get(Var, Dom, Ps0) ->
 3948            insert_propagator(Prop, Ps0, Ps),
 3949            fd_put(Var, Dom, Ps)
 3950        ;   true
 3951        ).
 3952
 3953constraint_wake(pneq, ground).
 3954constraint_wake(x_neq_y_plus_z, ground).
 3955constraint_wake(absdiff_neq, ground).
 3956constraint_wake(pdifferent, ground).
 3957constraint_wake(pexclude, ground).
 3958constraint_wake(scalar_product_neq, ground).
 3959
 3960constraint_wake(x_leq_y_plus_c, bounds).
 3961constraint_wake(scalar_product_eq, bounds).
 3962constraint_wake(scalar_product_leq, bounds).
 3963constraint_wake(pplus, bounds).
 3964constraint_wake(pgeq, bounds).
 3965constraint_wake(pgcc_single, bounds).
 3966constraint_wake(pgcc_check_single, bounds).
 3967
 3968global_constraint(pdistinct).
 3969global_constraint(pgcc).
 3970global_constraint(pgcc_single).
 3971global_constraint(pcircuit).
 3972%global_constraint(rel_tuple).
 3973%global_constraint(scalar_product_eq).
 3974
 3975insert_propagator(Prop, Ps0, Ps) :-
 3976        Ps0 = fd_props(Gs,Bs,Os),
 3977        arg(1, Prop, Constraint),
 3978        functor(Constraint, F, _),
 3979        (   constraint_wake(F, ground) ->
 3980            Ps = fd_props([Prop|Gs], Bs, Os)
 3981        ;   constraint_wake(F, bounds) ->
 3982            Ps = fd_props(Gs, [Prop|Bs], Os)
 3983        ;   Ps = fd_props(Gs, Bs, [Prop|Os])
 3984        ).
 3985
 3986%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 3987
 3988%% lex_chain(+Lists)
 3989%
 3990% Lists are lexicographically non-decreasing.
 3991
 3992lex_chain(Lss) :-
 3993        must_be(list(list), Lss),
 3994        maplist(maplist(fd_variable), Lss),
 3995        (   Lss == [] -> true
 3996        ;   Lss = [First|Rest],
 3997            make_propagator(presidual(lex_chain(Lss)), Prop),
 3998            foldl(lex_chain_(Prop), Rest, First, _)
 3999        ).
 4000
 4001lex_chain_(Prop, Ls, Prev, Ls) :-
 4002        maplist(prop_init(Prop), Ls),
 4003        lex_le(Prev, Ls).
 4004
 4005lex_le([], []).
 4006lex_le([V1|V1s], [V2|V2s]) :-
 4007        ?(V1) #=< ?(V2),
 4008        (   integer(V1) ->
 4009            (   integer(V2) ->
 4010                (   V1 =:= V2 -> lex_le(V1s, V2s) ;  true )
 4011            ;   freeze(V2, lex_le([V1|V1s], [V2|V2s]))
 4012            )
 4013        ;   freeze(V1, lex_le([V1|V1s], [V2|V2s]))
 4014        ).
 4015
 4016%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4017
 4018
 4019%% tuples_in(+Tuples, +Relation).
 4020%
 4021% True iff all Tuples are elements of Relation. Each element of the
 4022% list Tuples is a list of integers or finite domain variables.
 4023% Relation is a list of lists of integers. Arbitrary finite relations,
 4024% such as compatibility tables, can be modeled in this way. For
 4025% example, if 1 is compatible with 2 and 5, and 4 is compatible with 0
 4026% and 3:
 4027%
 4028% ==
 4029% ?- tuples_in([[X,Y]], [[1,2],[1,5],[4,0],[4,3]]), X = 4.
 4030% X = 4,
 4031% Y in 0\/3.
 4032% ==
 4033%
 4034% As another example, consider a train schedule represented as a list
 4035% of quadruples, denoting departure and arrival places and times for
 4036% each train. In the following program, Ps is a feasible journey of
 4037% length 3 from A to D via trains that are part of the given schedule.
 4038%
 4039% ==
 4040% trains([[1,2,0,1],
 4041%         [2,3,4,5],
 4042%         [2,3,0,1],
 4043%         [3,4,5,6],
 4044%         [3,4,2,3],
 4045%         [3,4,8,9]]).
 4046%
 4047% threepath(A, D, Ps) :-
 4048%         Ps = [[A,B,_T0,T1],[B,C,T2,T3],[C,D,T4,_T5]],
 4049%         T2 #> T1,
 4050%         T4 #> T3,
 4051%         trains(Ts),
 4052%         tuples_in(Ps, Ts).
 4053% ==
 4054%
 4055% In this example, the unique solution is found without labeling:
 4056%
 4057% ==
 4058% ?- threepath(1, 4, Ps).
 4059% Ps = [[1, 2, 0, 1], [2, 3, 4, 5], [3, 4, 8, 9]].
 4060% ==
 4061
 4062tuples_in(Tuples, Relation) :-
 4063        must_be(list(list), Tuples),
 4064        maplist(maplist(fd_variable), Tuples),
 4065        must_be(list(list(integer)), Relation),
 4066        maplist(relation_tuple(Relation), Tuples),
 4067        do_queue.
 4068
 4069relation_tuple(Relation, Tuple) :-
 4070        relation_unifiable(Relation, Tuple, Us, _, _),
 4071        (   ground(Tuple) -> memberchk(Tuple, Relation)
 4072        ;   tuple_domain(Tuple, Us),
 4073            (   Tuple = [_,_|_] -> tuple_freeze(Tuple, Us)
 4074            ;   true
 4075            )
 4076        ).
 4077
 4078tuple_domain([], _).
 4079tuple_domain([T|Ts], Relation0) :-
 4080        maplist(list_first_rest, Relation0, Firsts, Relation1),
 4081        (   var(T) ->
 4082            (   Firsts = [Unique] -> T = Unique
 4083            ;   list_to_domain(Firsts, FDom),
 4084                fd_get(T, TDom, TPs),
 4085                domains_intersection(TDom, FDom, TDom1),
 4086                fd_put(T, TDom1, TPs)
 4087            )
 4088        ;   true
 4089        ),
 4090        tuple_domain(Ts, Relation1).
 4091
 4092tuple_freeze(Tuple, Relation) :-
 4093        put_attr(R, clpfd_relation, Relation),
 4094        make_propagator(rel_tuple(R, Tuple), Prop),
 4095        tuple_freeze_(Tuple, Prop).
 4096
 4097tuple_freeze_([], _).
 4098tuple_freeze_([T|Ts], Prop) :-
 4099        (   var(T) ->
 4100            init_propagator(T, Prop),
 4101            trigger_prop(Prop)
 4102        ;   true
 4103        ),
 4104        tuple_freeze_(Ts, Prop).
 4105
 4106relation_unifiable([], _, [], Changed, Changed).
 4107relation_unifiable([R|Rs], Tuple, Us, Changed0, Changed) :-
 4108        (   all_in_domain(R, Tuple) ->
 4109            Us = [R|Rest],
 4110            relation_unifiable(Rs, Tuple, Rest, Changed0, Changed)
 4111        ;   relation_unifiable(Rs, Tuple, Us, true, Changed)
 4112        ).
 4113
 4114all_in_domain([], []).
 4115all_in_domain([A|As], [T|Ts]) :-
 4116        (   fd_get(T, Dom, _) ->
 4117            domain_contains(Dom, A)
 4118        ;   T =:= A
 4119        ),
 4120        all_in_domain(As, Ts).
 4121
 4122%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4123
 4124% trivial propagator, used only to remember pending constraints
 4125run_propagator(presidual(_), _).
 4126
 4127%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4128run_propagator(pdifferent(Left,Right,X,_), MState) :-
 4129        run_propagator(pexclude(Left,Right,X), MState).
 4130
 4131run_propagator(weak_distinct(Left,Right,X,_), _MState) :-
 4132        (   ground(X) ->
 4133            disable_queue,
 4134            exclude_fire(Left, Right, X),
 4135            enable_queue
 4136        ;   outof_reducer(Left, Right, X)
 4137            %(   var(X) -> kill_if_isolated(Left, Right, X, MState)
 4138            %;   true
 4139            %)
 4140        ).
 4141
 4142run_propagator(pexclude(Left,Right,X), _) :-
 4143        (   ground(X) ->
 4144            disable_queue,
 4145            exclude_fire(Left, Right, X),
 4146            enable_queue
 4147        ;   true
 4148        ).
 4149
 4150run_propagator(pdistinct(Ls), _MState) :-
 4151        distinct(Ls).
 4152
 4153run_propagator(check_distinct(Left,Right,X), _) :-
 4154        \+ list_contains(Left, X),
 4155        \+ list_contains(Right, X).
 4156
 4157%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4158
 4159run_propagator(pelement(N, Is, V), MState) :-
 4160        (   fd_get(N, NDom, _) ->
 4161            (   fd_get(V, VDom, VPs) ->
 4162                integers_remaining(Is, 1, NDom, empty, VDom1),
 4163                domains_intersection(VDom, VDom1, VDom2),
 4164                fd_put(V, VDom2, VPs)
 4165            ;   true
 4166            )
 4167        ;   kill(MState), nth1(N, Is, V)
 4168        ).
 4169
 4170%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4171
 4172run_propagator(pgcc_single(Vs, Pairs), _) :- gcc_global(Vs, Pairs).
 4173
 4174run_propagator(pgcc_check_single(Pairs), _) :- gcc_check(Pairs).
 4175
 4176run_propagator(pgcc_check(Pairs), _) :- gcc_check(Pairs).
 4177
 4178run_propagator(pgcc(Vs, _, Pairs), _) :- gcc_global(Vs, Pairs).
 4179
 4180%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4181
 4182run_propagator(pcircuit(Vs), _MState) :-
 4183        distinct(Vs),
 4184        propagate_circuit(Vs).
 4185
 4186%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4187run_propagator(pneq(A, B), MState) :-
 4188        (   nonvar(A) ->
 4189            (   nonvar(B) -> A =\= B, kill(MState)
 4190            ;   fd_get(B, BD0, BExp0),
 4191                domain_remove(BD0, A, BD1),
 4192                kill(MState),
 4193                fd_put(B, BD1, BExp0)
 4194            )
 4195        ;   nonvar(B) -> run_propagator(pneq(B, A), MState)
 4196        ;   A \== B,
 4197            fd_get(A, _, AI, AS, _), fd_get(B, _, BI, BS, _),
 4198            (   AS cis_lt BI -> kill(MState)
 4199            ;   AI cis_gt BS -> kill(MState)
 4200            ;   true
 4201            )
 4202        ).
 4203
 4204%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4205run_propagator(pgeq(A,B), MState) :-
 4206        (   A == B -> kill(MState)
 4207        ;   nonvar(A) ->
 4208            (   nonvar(B) -> kill(MState), A >= B
 4209            ;   fd_get(B, BD, BPs),
 4210                domain_remove_greater_than(BD, A, BD1),
 4211                kill(MState),
 4212                fd_put(B, BD1, BPs)
 4213            )
 4214        ;   nonvar(B) ->
 4215            fd_get(A, AD, APs),
 4216            domain_remove_smaller_than(AD, B, AD1),
 4217            kill(MState),
 4218            fd_put(A, AD1, APs)
 4219        ;   fd_get(A, AD, AL, AU, APs),
 4220            fd_get(B, _, BL, BU, _),
 4221            AU cis_geq BL,
 4222            (   AL cis_geq BU -> kill(MState)
 4223            ;   AU == BL -> kill(MState), A = B
 4224            ;   NAL cis max(AL,BL),
 4225                domains_intersection(AD, from_to(NAL,AU), NAD),
 4226                fd_put(A, NAD, APs),
 4227                (   fd_get(B, BD2, BL2, BU2, BPs2) ->
 4228                    NBU cis min(BU2, AU),
 4229                    domains_intersection(BD2, from_to(BL2,NBU), NBD),
 4230                    fd_put(B, NBD, BPs2)
 4231                ;   true
 4232                )
 4233            )
 4234        ).
 4235
 4236%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4237
 4238run_propagator(rel_tuple(R, Tuple), MState) :-
 4239        get_attr(R, clpfd_relation, Relation),
 4240        (   ground(Tuple) -> kill(MState), memberchk(Tuple, Relation)
 4241        ;   relation_unifiable(Relation, Tuple, Us, false, Changed),
 4242            Us = [_|_],
 4243            (   Tuple = [First,Second], ( ground(First) ; ground(Second) ) ->
 4244                kill(MState)
 4245            ;   true
 4246            ),
 4247            (   Us = [Single] -> kill(MState), Single = Tuple
 4248            ;   Changed ->
 4249                put_attr(R, clpfd_relation, Us),
 4250                disable_queue,
 4251                tuple_domain(Tuple, Us),
 4252                enable_queue
 4253            ;   true
 4254            )
 4255        ).
 4256
 4257%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4258
 4259run_propagator(pserialized(S_I, D_I, S_J, D_J, _), MState) :-
 4260        (   nonvar(S_I), nonvar(S_J) ->
 4261            kill(MState),
 4262            (   S_I + D_I =< S_J -> true
 4263            ;   S_J + D_J =< S_I -> true
 4264            ;   false
 4265            )
 4266        ;   serialize_lower_upper(S_I, D_I, S_J, D_J, MState),
 4267            serialize_lower_upper(S_J, D_J, S_I, D_I, MState)
 4268        ).
 4269
 4270%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4271
 4272% abs(X-Y) #\= C
 4273run_propagator(absdiff_neq(X,Y,C), MState) :-
 4274        (   C < 0 -> kill(MState)
 4275        ;   nonvar(X) ->
 4276            kill(MState),
 4277            (   nonvar(Y) -> abs(X - Y) =\= C
 4278            ;   V1 is X - C, neq_num(Y, V1),
 4279                V2 is C + X, neq_num(Y, V2)
 4280            )
 4281        ;   nonvar(Y) -> kill(MState),
 4282            V1 is C + Y, neq_num(X, V1),
 4283            V2 is Y - C, neq_num(X, V2)
 4284        ;   true
 4285        ).
 4286
 4287% abs(X-Y) #>= C
 4288run_propagator(absdiff_geq(X,Y,C), MState) :-
 4289        (   C =< 0 -> kill(MState)
 4290        ;   nonvar(X) ->
 4291            kill(MState),
 4292            (   nonvar(Y) -> abs(X-Y) >= C
 4293            ;   P1 is X - C, P2 is X + C,
 4294                Y in inf..P1 \/ P2..sup
 4295            )
 4296        ;   nonvar(Y) ->
 4297            kill(MState),
 4298            P1 is Y - C, P2 is Y + C,
 4299            X in inf..P1 \/ P2..sup
 4300        ;   true
 4301        ).
 4302
 4303% X #\= Y + Z
 4304run_propagator(x_neq_y_plus_z(X,Y,Z), MState) :-
 4305        (   nonvar(X) ->
 4306            (   nonvar(Y) ->
 4307                (   nonvar(Z) -> kill(MState), X =\= Y + Z
 4308                ;   kill(MState), XY is X - Y, neq_num(Z, XY)
 4309                )
 4310            ;   nonvar(Z) -> kill(MState), XZ is X - Z, neq_num(Y, XZ)
 4311            ;   true
 4312            )
 4313        ;   nonvar(Y) ->
 4314            (   nonvar(Z) ->
 4315                kill(MState), YZ is Y + Z, neq_num(X, YZ)
 4316            ;   Y =:= 0 -> kill(MState), neq(X, Z)
 4317            ;   true
 4318            )
 4319        ;   Z == 0 -> kill(MState), neq(X, Y)
 4320        ;   true
 4321        ).
 4322
 4323% X #=< Y + C
 4324run_propagator(x_leq_y_plus_c(X,Y,C), MState) :-
 4325        (   nonvar(X) ->
 4326            (   nonvar(Y) -> kill(MState), X =< Y + C
 4327            ;   kill(MState),
 4328                R is X - C,
 4329                fd_get(Y, YD, YPs),
 4330                domain_remove_smaller_than(YD, R, YD1),
 4331                fd_put(Y, YD1, YPs)
 4332            )
 4333        ;   nonvar(Y) ->
 4334            kill(MState),
 4335            R is Y + C,
 4336            fd_get(X, XD, XPs),
 4337            domain_remove_greater_than(XD, R, XD1),
 4338            fd_put(X, XD1, XPs)
 4339        ;   (   X == Y -> C >= 0, kill(MState)
 4340            ;   fd_get(Y, YD, _),
 4341                (   domain_supremum(YD, n(YSup)) ->
 4342                    YS1 is YSup + C,
 4343                    fd_get(X, XD, XPs),
 4344                    domain_remove_greater_than(XD, YS1, XD1),
 4345                    fd_put(X, XD1, XPs)
 4346                ;   true
 4347                ),
 4348                (   fd_get(X, XD2, _), domain_infimum(XD2, n(XInf)) ->
 4349                    XI1 is XInf - C,
 4350                    (   fd_get(Y, YD1, YPs1) ->
 4351                        domain_remove_smaller_than(YD1, XI1, YD2),
 4352                        (   domain_infimum(YD2, n(YInf)),
 4353                            domain_supremum(XD2, n(XSup)),
 4354                            XSup =< YInf + C ->
 4355                            kill(MState)
 4356                        ;   true
 4357                        ),
 4358                        fd_put(Y, YD2, YPs1)
 4359                    ;   true
 4360                    )
 4361                ;   true
 4362                )
 4363            )
 4364        ).
 4365
 4366run_propagator(scalar_product_neq(Cs0,Vs0,P0), MState) :-
 4367        coeffs_variables_const(Cs0, Vs0, Cs, Vs, 0, I),
 4368        P is P0 - I,
 4369        (   Vs = [] -> kill(MState), P =\= 0
 4370        ;   Vs = [V], Cs = [C] ->
 4371            kill(MState),
 4372            (   C =:= 1 -> neq_num(V, P)
 4373            ;   C*V #\= P
 4374            )
 4375        ;   Cs == [1,-1] -> kill(MState), Vs = [A,B], x_neq_y_plus_z(A, B, P)
 4376        ;   Cs == [-1,1] -> kill(MState), Vs = [A,B], x_neq_y_plus_z(B, A, P)
 4377        ;   P =:= 0, Cs = [1,1,-1] ->
 4378            kill(MState), Vs = [A,B,C], x_neq_y_plus_z(C, A, B)
 4379        ;   P =:= 0, Cs = [1,-1,1] ->
 4380            kill(MState), Vs = [A,B,C], x_neq_y_plus_z(B, A, C)
 4381        ;   P =:= 0, Cs = [-1,1,1] ->
 4382            kill(MState), Vs = [A,B,C], x_neq_y_plus_z(A, B, C)
 4383        ;   true
 4384        ).
 4385
 4386run_propagator(scalar_product_leq(Cs0,Vs0,P0), MState) :-
 4387        coeffs_variables_const(Cs0, Vs0, Cs, Vs, 0, I),
 4388        P is P0 - I,
 4389        (   Vs = [] -> kill(MState), P >= 0
 4390        ;   sum_finite_domains(Cs, Vs, Infs, Sups, 0, 0, Inf, Sup),
 4391            D1 is P - Inf,
 4392            disable_queue,
 4393            (   Infs == [], Sups == [] ->
 4394                Inf =< P,
 4395                (   Sup =< P -> kill(MState)
 4396                ;   remove_dist_upper_leq(Cs, Vs, D1)
 4397                )
 4398            ;   Infs == [] -> Inf =< P, remove_dist_upper(Sups, D1)
 4399            ;   Sups = [_], Infs = [_] ->
 4400                remove_upper(Infs, D1)
 4401            ;   Infs = [_] -> remove_upper(Infs, D1)
 4402            ;   true
 4403            ),
 4404            enable_queue
 4405        ).
 4406
 4407run_propagator(scalar_product_eq(Cs0,Vs0,P0), MState) :-
 4408        coeffs_variables_const(Cs0, Vs0, Cs, Vs, 0, I),
 4409        P is P0 - I,
 4410        (   Vs = [] -> kill(MState), P =:= 0
 4411        ;   Vs = [V], Cs = [C] -> kill(MState), P mod C =:= 0, V is P // C
 4412        ;   Cs == [1,1] -> kill(MState), Vs = [A,B], A + B #= P
 4413        ;   Cs == [1,-1] -> kill(MState), Vs = [A,B], A #= P + B
 4414        ;   Cs == [-1,1] -> kill(MState), Vs = [A,B], B #= P + A
 4415        ;   Cs == [-1,-1] -> kill(MState), Vs = [A,B], P1 is -P, A + B #= P1
 4416        ;   P =:= 0, Cs == [1,1,-1] -> kill(MState), Vs = [A,B,C], A + B #= C
 4417        ;   P =:= 0, Cs == [1,-1,1] -> kill(MState), Vs = [A,B,C], A + C #= B
 4418        ;   P =:= 0, Cs == [-1,1,1] -> kill(MState), Vs = [A,B,C], B + C #= A
 4419        ;   sum_finite_domains(Cs, Vs, Infs, Sups, 0, 0, Inf, Sup),
 4420            % nl, writeln(Infs-Sups-Inf-Sup),
 4421            D1 is P - Inf,
 4422            D2 is Sup - P,
 4423            disable_queue,
 4424            (   Infs == [], Sups == [] ->
 4425                between(Inf, Sup, P),
 4426                remove_dist_upper_lower(Cs, Vs, D1, D2)
 4427            ;   Sups = [] -> P =< Sup, remove_dist_lower(Infs, D2)
 4428            ;   Infs = [] -> Inf =< P, remove_dist_upper(Sups, D1)
 4429            ;   Sups = [_], Infs = [_] ->
 4430                remove_lower(Sups, D2),
 4431                remove_upper(Infs, D1)
 4432            ;   Infs = [_] -> remove_upper(Infs, D1)
 4433            ;   Sups = [_] -> remove_lower(Sups, D2)
 4434            ;   true
 4435            ),
 4436            enable_queue
 4437        ).
 4438
 4439% X + Y = Z
 4440run_propagator(pplus(X,Y,Z), MState) :-
 4441        (   nonvar(X) ->
 4442            (   X =:= 0 -> kill(MState), Y = Z
 4443            ;   Y == Z -> kill(MState), X =:= 0
 4444            ;   nonvar(Y) -> kill(MState), Z is X + Y
 4445            ;   nonvar(Z) -> kill(MState), Y is Z - X
 4446            ;   fd_get(Z, ZD, ZPs),
 4447                fd_get(Y, YD, _),
 4448                domain_shift(YD, X, Shifted_YD),
 4449                domains_intersection(ZD, Shifted_YD, ZD1),
 4450                fd_put(Z, ZD1, ZPs),
 4451                (   fd_get(Y, YD1, YPs) ->
 4452                    O is -X,
 4453                    domain_shift(ZD1, O, YD2),
 4454                    domains_intersection(YD1, YD2, YD3),
 4455                    fd_put(Y, YD3, YPs)
 4456                ;   true
 4457                )
 4458            )
 4459        ;   nonvar(Y) -> run_propagator(pplus(Y,X,Z), MState)
 4460        ;   nonvar(Z) ->
 4461            (   X == Y -> kill(MState), even(Z), X is Z // 2
 4462            ;   fd_get(X, XD, _),
 4463                fd_get(Y, YD, YPs),
 4464                domain_negate(XD, XDN),
 4465                domain_shift(XDN, Z, YD1),
 4466                domains_intersection(YD, YD1, YD2),
 4467                fd_put(Y, YD2, YPs),
 4468                (   fd_get(X, XD1, XPs) ->
 4469                    domain_negate(YD2, YD2N),
 4470                    domain_shift(YD2N, Z, XD2),
 4471                    domains_intersection(XD1, XD2, XD3),
 4472                    fd_put(X, XD3, XPs)
 4473                ;   true
 4474                )
 4475            )
 4476        ;   (   X == Y -> kill(MState), 2*X #= Z
 4477            ;   X == Z -> kill(MState), Y = 0
 4478            ;   Y == Z -> kill(MState), X = 0
 4479            ;   fd_get(X, XD, XL, XU, XPs),
 4480                fd_get(Y, _, YL, YU, _),
 4481                fd_get(Z, _, ZL, ZU, _),
 4482                NXL cis max(XL, ZL-YU),
 4483                NXU cis min(XU, ZU-YL),
 4484                update_bounds(X, XD, XPs, XL, XU, NXL, NXU),
 4485                (   fd_get(Y, YD2, YL2, YU2, YPs2) ->
 4486                    NYL cis max(YL2, ZL-NXU),
 4487                    NYU cis min(YU2, ZU-NXL),
 4488                    update_bounds(Y, YD2, YPs2, YL2, YU2, NYL, NYU)
 4489                ;   NYL = n(Y), NYU = n(Y)
 4490                ),
 4491                (   fd_get(Z, ZD2, ZL2, ZU2, ZPs2) ->
 4492                    NZL cis max(ZL2,NXL+NYL),
 4493                    NZU cis min(ZU2,NXU+NYU),
 4494                    update_bounds(Z, ZD2, ZPs2, ZL2, ZU2, NZL, NZU)
 4495                ;   true
 4496                )
 4497            )
 4498        ).
 4499
 4500%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4501
 4502run_propagator(ptimes(X,Y,Z), MState) :-
 4503        (   nonvar(X) ->
 4504            (   nonvar(Y) -> kill(MState), Z is X * Y
 4505            ;   X =:= 0 -> kill(MState), Z = 0
 4506            ;   X =:= 1 -> kill(MState), Z = Y
 4507            ;   nonvar(Z) -> kill(MState), 0 =:= Z mod X, Y is Z // X
 4508            ;   (   Y == Z -> kill(MState), Y = 0
 4509                ;   fd_get(Y, YD, _),
 4510                    fd_get(Z, ZD, ZPs),
 4511                    domain_expand(YD, X, Scaled_YD),
 4512                    domains_intersection(ZD, Scaled_YD, ZD1),
 4513                    fd_put(Z, ZD1, ZPs),
 4514                    (   fd_get(Y, YDom2, YPs2) ->
 4515                        domain_contract(ZD1, X, Contract),
 4516                        domains_intersection(YDom2, Contract, NYDom),
 4517                        fd_put(Y, NYDom, YPs2)
 4518                    ;   kill(MState), Z is X * Y
 4519                    )
 4520                )
 4521            )
 4522        ;   nonvar(Y) -> run_propagator(ptimes(Y,X,Z), MState)
 4523        ;   nonvar(Z) ->
 4524            (   X == Y ->
 4525                kill(MState),
 4526                integer_kth_root(Z, 2, R),
 4527                NR is -R,
 4528                X in NR \/ R
 4529            ;   fd_get(X, XD, XL, XU, XPs),
 4530                fd_get(Y, YD, YL, YU, _),
 4531                min_max_factor(n(Z), n(Z), YL, YU, XL, XU, NXL, NXU),
 4532                update_bounds(X, XD, XPs, XL, XU, NXL, NXU),
 4533                (   fd_get(Y, YD2, YL2, YU2, YPs2) ->
 4534                    min_max_factor(n(Z), n(Z), NXL, NXU, YL2, YU2, NYL, NYU),
 4535                    update_bounds(Y, YD2, YPs2, YL2, YU2, NYL, NYU)
 4536                ;   (   Y =\= 0 -> 0 =:= Z mod Y, kill(MState), X is Z // Y
 4537                    ;   kill(MState), Z = 0
 4538                    )
 4539                ),
 4540                (   Z =:= 0 ->
 4541                    (   \+ domain_contains(XD, 0) -> kill(MState), Y = 0
 4542                    ;   \+ domain_contains(YD, 0) -> kill(MState), X = 0
 4543                    ;   true
 4544                    )
 4545                ;  neq_num(X, 0), neq_num(Y, 0)
 4546                )
 4547            )
 4548        ;   (   X == Y -> kill(MState), X^2 #= Z
 4549            ;   fd_get(X, XD, XL, XU, XPs),
 4550                fd_get(Y, _, YL, YU, _),
 4551                fd_get(Z, ZD, ZL, ZU, _),
 4552                (   Y == Z, \+ domain_contains(ZD, 0) -> kill(MState), X = 1
 4553                ;   X == Z, \+ domain_contains(ZD, 0) -> kill(MState), Y = 1
 4554                ;   min_max_factor(ZL, ZU, YL, YU, XL, XU, NXL, NXU),
 4555                    update_bounds(X, XD, XPs, XL, XU, NXL, NXU),
 4556                    (   fd_get(Y, YD2, YL2, YU2, YPs2) ->
 4557                        min_max_factor(ZL, ZU, NXL, NXU, YL2, YU2, NYL, NYU),
 4558                        update_bounds(Y, YD2, YPs2, YL2, YU2, NYL, NYU)
 4559                    ;   NYL = n(Y), NYU = n(Y)
 4560                    ),
 4561                    (   fd_get(Z, ZD2, ZL2, ZU2, ZPs2) ->
 4562                        min_product(NXL, NXU, NYL, NYU, NZL),
 4563                        max_product(NXL, NXU, NYL, NYU, NZU),
 4564                        (   NZL cis_leq ZL2, NZU cis_geq ZU2 -> ZD3 = ZD2
 4565                        ;   domains_intersection(ZD2, from_to(NZL,NZU), ZD3),
 4566                            fd_put(Z, ZD3, ZPs2)
 4567                        ),
 4568                        (   domain_contains(ZD3, 0) ->  true
 4569                        ;   neq_num(X, 0), neq_num(Y, 0)
 4570                        )
 4571                    ;   true
 4572                    )
 4573                )
 4574            )
 4575        ).
 4576
 4577%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4578
 4579% X div Y = Z
 4580run_propagator(pdiv(X,Y,Z), MState) :- kill(MState), Z #= (X-(X mod Y)) // Y.
 4581
 4582% X rdiv Y = Z
 4583run_propagator(prdiv(X,Y,Z), MState) :- kill(MState), Z*Y #= X.
 4584
 4585% X // Y = Z (round towards zero)
 4586run_propagator(ptzdiv(X,Y,Z), MState) :-
 4587        (   nonvar(X) ->
 4588            (   nonvar(Y) -> kill(MState), Y =\= 0, Z is X // Y
 4589            ;   fd_get(Y, YD, YL, YU, YPs),
 4590                (   nonvar(Z) ->
 4591                    (   Z =:= 0 ->
 4592                        NYL is -abs(X) - 1,
 4593                        NYU is abs(X) + 1,
 4594                        domains_intersection(YD, split(0, from_to(inf,n(NYL)),
 4595                                                       from_to(n(NYU), sup)),
 4596                                             NYD),
 4597                        fd_put(Y, NYD, YPs)
 4598                    ;   (   sign(X) =:= sign(Z) ->
 4599                            NYL cis max(n(X) // (n(Z)+sign(n(Z))) + n(1), YL),
 4600                            NYU cis min(n(X) // n(Z), YU)
 4601                        ;   NYL cis max(n(X) // n(Z), YL),
 4602                            NYU cis min(n(X) // (n(Z)+sign(n(Z))) - n(1), YU)
 4603                        ),
 4604                        update_bounds(Y, YD, YPs, YL, YU, NYL, NYU)
 4605                    )
 4606                ;   fd_get(Z, ZD, ZL, ZU, ZPs),
 4607                    (   X >= 0, ( YL cis_gt n(0) ; YU cis_lt n(0) )->
 4608                        NZL cis max(n(X)//YU, ZL),
 4609                        NZU cis min(n(X)//YL, ZU)
 4610                    ;   X < 0, ( YL cis_gt n(0) ; YU cis_lt n(0) ) ->
 4611                        NZL cis max(n(X)//YL, ZL),
 4612                        NZU cis min(n(X)//YU, ZU)
 4613                    ;   % TODO: more stringent bounds, cover Y
 4614                        NZL cis max(-abs(n(X)), ZL),
 4615                        NZU cis min(abs(n(X)), ZU)
 4616                    ),
 4617                    update_bounds(Z, ZD, ZPs, ZL, ZU, NZL, NZU),
 4618                    (   X >= 0, NZL cis_gt n(0), fd_get(Y, YD1, YPs1) ->
 4619                        NYL cis n(X) // (NZU + n(1)) + n(1),
 4620                        NYU cis n(X) // NZL,
 4621                        domains_intersection(YD1, from_to(NYL, NYU), NYD1),
 4622                        fd_put(Y, NYD1, YPs1)
 4623                    ;   true
 4624                    )
 4625                )
 4626            )
 4627        ;   nonvar(Y) ->
 4628            Y =\= 0,
 4629            (   Y =:= 1 -> kill(MState), X = Z
 4630            ;   Y =:= -1 -> kill(MState), Z #= -X
 4631            ;   fd_get(X, XD, XL, XU, XPs),
 4632                (   nonvar(Z) ->
 4633                    kill(MState),
 4634                    (   sign(Z) =:= sign(Y) ->
 4635                        NXL cis max(n(Z)*n(Y), XL),
 4636                        NXU cis min((abs(n(Z))+n(1))*abs(n(Y))-n(1), XU)
 4637                    ;   Z =:= 0 ->
 4638                        NXL cis max(-abs(n(Y)) + n(1), XL),
 4639                        NXU cis min(abs(n(Y)) - n(1), XU)
 4640                    ;   NXL cis max((n(Z)+sign(n(Z)))*n(Y)+n(1), XL),
 4641                        NXU cis min(n(Z)*n(Y), XU)
 4642                    ),
 4643                    update_bounds(X, XD, XPs, XL, XU, NXL, NXU)
 4644                ;   fd_get(Z, ZD, ZPs),
 4645                    domain_contract_less(XD, Y, Contracted),
 4646                    domains_intersection(ZD, Contracted, NZD),
 4647                    fd_put(Z, NZD, ZPs),
 4648                    (   fd_get(X, XD2, XPs2) ->
 4649                        domain_expand_more(NZD, Y, Expanded),
 4650                        domains_intersection(XD2, Expanded, NXD2),
 4651                        fd_put(X, NXD2, XPs2)
 4652                    ;   true
 4653                    )
 4654                )
 4655            )
 4656        ;   nonvar(Z) ->
 4657            fd_get(X, XD, XL, XU, XPs),
 4658            fd_get(Y, _, YL, YU, _),
 4659            (   YL cis_geq n(0), XL cis_geq n(0) ->
 4660                NXL cis max(YL*n(Z), XL),
 4661                NXU cis min(YU*(n(Z)+n(1))-n(1), XU)
 4662            ;   %TODO: cover more cases
 4663                NXL = XL, NXU = XU
 4664            ),
 4665            update_bounds(X, XD, XPs, XL, XU, NXL, NXU)
 4666        ;   (   X == Y -> kill(MState), Z = 1
 4667            ;   fd_get(X, _, XL, XU, _),
 4668                fd_get(Y, _, YL, _, _),
 4669                fd_get(Z, ZD, ZPs),
 4670                NZU cis max(abs(XL), XU),
 4671                NZL cis -NZU,
 4672                domains_intersection(ZD, from_to(NZL,NZU), NZD0),
 4673                (   XL cis_geq n(0), YL cis_geq n(0) ->
 4674                    domain_remove_smaller_than(NZD0, 0, NZD1)
 4675                ;   % TODO: cover more cases
 4676                    NZD1 = NZD0
 4677                ),
 4678                fd_put(Z, NZD1, ZPs)
 4679            )
 4680        ).
 4681
 4682
 4683%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4684% Y = abs(X)
 4685
 4686run_propagator(pabs(X,Y), MState) :-
 4687        (   nonvar(X) -> kill(MState), Y is abs(X)
 4688        ;   nonvar(Y) ->
 4689            kill(MState),
 4690            Y >= 0,
 4691            YN is -Y,
 4692            X in YN \/ Y
 4693        ;   fd_get(X, XD, XPs),
 4694            fd_get(Y, YD, _),
 4695            domain_negate(YD, YDNegative),
 4696            domains_union(YD, YDNegative, XD1),
 4697            domains_intersection(XD, XD1, XD2),
 4698            fd_put(X, XD2, XPs),
 4699            (   fd_get(Y, YD1, YPs1) ->
 4700                domain_negate(XD2, XD2Neg),
 4701                domains_union(XD2, XD2Neg, YD2),
 4702                domain_remove_smaller_than(YD2, 0, YD3),
 4703                domains_intersection(YD1, YD3, YD4),
 4704                fd_put(Y, YD4, YPs1)
 4705            ;   true
 4706            )
 4707        ).
 4708%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4709% Z = X mod Y
 4710
 4711run_propagator(pmod(X,Y,Z), MState) :-
 4712        (   nonvar(X) ->
 4713            (   nonvar(Y) -> kill(MState), Y =\= 0, Z is X mod Y
 4714            ;   true
 4715            )
 4716        ;   nonvar(Y) ->
 4717            Y =\= 0,
 4718            (   abs(Y) =:= 1 -> kill(MState), Z = 0
 4719            ;   var(Z) ->
 4720                YP is abs(Y) - 1,
 4721                (   Y > 0, fd_get(X, _, n(XL), n(XU), _) ->
 4722                    (   XL >= 0, XU < Y ->
 4723                        kill(MState), Z = X, ZL = XL, ZU = XU
 4724                    ;   ZL = 0, ZU = YP
 4725                    )
 4726                ;   Y > 0 -> ZL = 0, ZU = YP
 4727                ;   YN is -YP, ZL = YN, ZU = 0
 4728                ),
 4729                (   fd_get(Z, ZD, ZPs) ->
 4730                    domains_intersection(ZD, from_to(n(ZL), n(ZU)), ZD1),
 4731                    domain_infimum(ZD1, n(ZMin)),
 4732                    domain_supremum(ZD1, n(ZMax)),
 4733                    fd_put(Z, ZD1, ZPs)
 4734                ;   ZMin = Z, ZMax = Z
 4735                ),
 4736                (   fd_get(X, XD, XPs), domain_infimum(XD, n(XMin)) ->
 4737                    Z1 is XMin mod Y,
 4738                    (   between(ZMin, ZMax, Z1) -> true
 4739                    ;   Y > 0 ->
 4740                        Next is ((XMin - ZMin + Y - 1) div Y)*Y + ZMin,
 4741                        domain_remove_smaller_than(XD, Next, XD1),
 4742                        fd_put(X, XD1, XPs)
 4743                    ;   neq_num(X, XMin)
 4744                    )
 4745                ;   true
 4746                ),
 4747                (   fd_get(X, XD2, XPs2), domain_supremum(XD2, n(XMax)) ->
 4748                    Z2 is XMax mod Y,
 4749                    (   between(ZMin, ZMax, Z2) -> true
 4750                    ;   Y > 0 ->
 4751                        Prev is ((XMax - ZMin) div Y)*Y + ZMax,
 4752                        domain_remove_greater_than(XD2, Prev, XD3),
 4753                        fd_put(X, XD3, XPs2)
 4754                    ;   neq_num(X, XMax)
 4755                    )
 4756                ;   true
 4757                )
 4758            ;   fd_get(X, XD, XPs),
 4759                % if possible, propagate at the boundaries
 4760                (   domain_infimum(XD, n(Min)) ->
 4761                    (   Min mod Y =:= Z -> true
 4762                    ;   Y > 0 ->
 4763                        Next is ((Min - Z + Y - 1) div Y)*Y + Z,
 4764                        domain_remove_smaller_than(XD, Next, XD1),
 4765                        fd_put(X, XD1, XPs)
 4766                    ;   neq_num(X, Min)
 4767                    )
 4768                ;   true
 4769                ),
 4770                (   fd_get(X, XD2, XPs2) ->
 4771                    (   domain_supremum(XD2, n(Max)) ->
 4772                        (   Max mod Y =:= Z -> true
 4773                        ;   Y > 0 ->
 4774                            Prev is ((Max - Z) div Y)*Y + Z,
 4775                            domain_remove_greater_than(XD2, Prev, XD3),
 4776                            fd_put(X, XD3, XPs2)
 4777                        ;   neq_num(X, Max)
 4778                        )
 4779                    ;   true
 4780                    )
 4781                ;   true
 4782                )
 4783            )
 4784        ;   X == Y -> kill(MState), Z = 0
 4785        ;   true % TODO: propagate more
 4786        ).
 4787
 4788%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4789% Z = X rem Y
 4790
 4791run_propagator(prem(X,Y,Z), MState) :-
 4792        (   nonvar(X) ->
 4793            (   nonvar(Y) -> kill(MState), Y =\= 0, Z is X rem Y
 4794            ;   U is abs(X),
 4795                fd_get(Y, YD, _),
 4796                (   X >=0, domain_infimum(YD, n(Min)), Min >= 0 -> L = 0
 4797                ;   L is -U
 4798                ),
 4799                Z in L..U
 4800            )
 4801        ;   nonvar(Y) ->
 4802            Y =\= 0,
 4803            (   abs(Y) =:= 1 -> kill(MState), Z = 0
 4804            ;   var(Z) ->
 4805                YP is abs(Y) - 1,
 4806                YN is -YP,
 4807                (   Y > 0, fd_get(X, _, n(XL), n(XU), _) ->
 4808                    (   abs(XL) < Y, XU < Y -> kill(MState), Z = X, ZL = XL
 4809                    ;   XL < 0, abs(XL) < Y -> ZL = XL
 4810                    ;   XL >= 0 -> ZL = 0
 4811                    ;   ZL = YN
 4812                    ),
 4813                    (   XU > 0, XU < Y -> ZU = XU
 4814                    ;   XU < 0 -> ZU = 0
 4815                    ;   ZU = YP
 4816                    )
 4817                ;   ZL = YN, ZU = YP
 4818                ),
 4819                (   fd_get(Z, ZD, ZPs) ->
 4820                    domains_intersection(ZD, from_to(n(ZL), n(ZU)), ZD1),
 4821                    fd_put(Z, ZD1, ZPs)
 4822                ;   ZD1 = from_to(n(Z), n(Z))
 4823                ),
 4824                (   fd_get(X, XD, _), domain_infimum(XD, n(Min)) ->
 4825                    Z1 is Min rem Y,
 4826                    (   domain_contains(ZD1, Z1) -> true
 4827                    ;   neq_num(X, Min)
 4828                    )
 4829                ;   true
 4830                ),
 4831                (   fd_get(X, XD1, _), domain_supremum(XD1, n(Max)) ->
 4832                    Z2 is Max rem Y,
 4833                    (   domain_contains(ZD1, Z2) -> true
 4834                    ;   neq_num(X, Max)
 4835                    )
 4836                ;   true
 4837                )
 4838            ;   fd_get(X, XD1, XPs1),
 4839                % if possible, propagate at the boundaries
 4840                (   domain_infimum(XD1, n(Min)) ->
 4841                    (   Min rem Y =:= Z -> true
 4842                    ;   Y > 0, Min > 0 ->
 4843                        Next is ((Min - Z + Y - 1) div Y)*Y + Z,
 4844                        domain_remove_smaller_than(XD1, Next, XD2),
 4845                        fd_put(X, XD2, XPs1)
 4846                    ;   % TODO: bigger steps in other cases as well
 4847                        neq_num(X, Min)
 4848                    )
 4849                ;   true
 4850                ),
 4851                (   fd_get(X, XD3, XPs3) ->
 4852                    (   domain_supremum(XD3, n(Max)) ->
 4853                        (   Max rem Y =:= Z -> true
 4854                        ;   Y > 0, Max > 0  ->
 4855                            Prev is ((Max - Z) div Y)*Y + Z,
 4856                            domain_remove_greater_than(XD3, Prev, XD4),
 4857                            fd_put(X, XD4, XPs3)
 4858                        ;   % TODO: bigger steps in other cases as well
 4859                            neq_num(X, Max)
 4860                        )
 4861                    ;   true
 4862                    )
 4863                ;   true
 4864                )
 4865            )
 4866        ;   X == Y -> kill(MState), Z = 0
 4867        ;   fd_get(Z, ZD, ZPs) ->
 4868            fd_get(Y, _, YInf, YSup, _),
 4869            fd_get(X, _, XInf, XSup, _),
 4870            M cis max(abs(YInf),YSup),
 4871            (   XInf cis_geq n(0) -> Inf0 = n(0)
 4872            ;   Inf0 = XInf
 4873            ),
 4874            (   XSup cis_leq n(0) -> Sup0 = n(0)
 4875            ;   Sup0 = XSup
 4876            ),
 4877            NInf cis max(max(Inf0, -M + n(1)), min(XInf,-XSup)),
 4878            NSup cis min(min(Sup0, M - n(1)), max(abs(XInf),XSup)),
 4879            domains_intersection(ZD, from_to(NInf,NSup), ZD1),
 4880            fd_put(Z, ZD1, ZPs)
 4881        ;   true % TODO: propagate more
 4882        ).
 4883
 4884%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4885% Z = max(X,Y)
 4886
 4887run_propagator(pmax(X,Y,Z), MState) :-
 4888        (   nonvar(X) ->
 4889            (   nonvar(Y) -> kill(MState), Z is max(X,Y)
 4890            ;   nonvar(Z) ->
 4891                (   Z =:= X -> kill(MState), X #>= Y
 4892                ;   Z > X -> Z = Y
 4893                ;   false % Z < X
 4894                )
 4895            ;   fd_get(Y, _, YInf, YSup, _),
 4896                (   YInf cis_gt n(X) -> Z = Y
 4897                ;   YSup cis_lt n(X) -> Z = X
 4898                ;   YSup = n(M) ->
 4899                    fd_get(Z, ZD, ZPs),
 4900                    domain_remove_greater_than(ZD, M, ZD1),
 4901                    fd_put(Z, ZD1, ZPs)
 4902                ;   true
 4903                )
 4904            )
 4905        ;   nonvar(Y) -> run_propagator(pmax(Y,X,Z), MState)
 4906        ;   fd_get(Z, ZD, ZPs) ->
 4907            fd_get(X, _, XInf, XSup, _),
 4908            fd_get(Y, _, YInf, YSup, _),
 4909            (   YInf cis_gt YSup -> kill(MState), Z = Y
 4910            ;   YSup cis_lt XInf -> kill(MState), Z = X
 4911            ;   n(M) cis max(XSup, YSup) ->
 4912                domain_remove_greater_than(ZD, M, ZD1),
 4913                fd_put(Z, ZD1, ZPs)
 4914            ;   true
 4915            )
 4916        ;   true
 4917        ).
 4918
 4919%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4920% Z = min(X,Y)
 4921
 4922run_propagator(pmin(X,Y,Z), MState) :-
 4923        (   nonvar(X) ->
 4924            (   nonvar(Y) -> kill(MState), Z is min(X,Y)
 4925            ;   nonvar(Z) ->
 4926                (   Z =:= X -> kill(MState), X #=< Y
 4927                ;   Z < X -> Z = Y
 4928                ;   false % Z > X
 4929                )
 4930            ;   fd_get(Y, _, YInf, YSup, _),
 4931                (   YSup cis_lt n(X) -> Z = Y
 4932                ;   YInf cis_gt n(X) -> Z = X
 4933                ;   YInf = n(M) ->
 4934                    fd_get(Z, ZD, ZPs),
 4935                    domain_remove_smaller_than(ZD, M, ZD1),
 4936                    fd_put(Z, ZD1, ZPs)
 4937                ;   true
 4938                )
 4939            )
 4940        ;   nonvar(Y) -> run_propagator(pmin(Y,X,Z), MState)
 4941        ;   fd_get(Z, ZD, ZPs) ->
 4942            fd_get(X, _, XInf, XSup, _),
 4943            fd_get(Y, _, YInf, YSup, _),
 4944            (   YSup cis_lt YInf -> kill(MState), Z = Y
 4945            ;   YInf cis_gt XSup -> kill(MState), Z = X
 4946            ;   n(M) cis min(XInf, YInf) ->
 4947                domain_remove_smaller_than(ZD, M, ZD1),
 4948                fd_put(Z, ZD1, ZPs)
 4949            ;   true
 4950            )
 4951        ;   true
 4952        ).
 4953%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 4954% Z = X ^ Y
 4955
 4956run_propagator(pexp(X,Y,Z), MState) :-
 4957        (   X == 1 -> kill(MState), Z = 1
 4958        ;   X == 0 -> kill(MState), Z in 0..1, Z #<==> Y #= 0
 4959        ;   Y == 0 -> kill(MState), Z = 1
 4960        ;   Y == 1 -> kill(MState), Z = X
 4961        ;   nonvar(X) ->
 4962            (   nonvar(Y) ->
 4963                (   Y >= 0 -> true ; X =:= -1 ),
 4964                kill(MState),
 4965                Z is X^Y
 4966            ;   nonvar(Z) ->
 4967                (   Z > 1 ->
 4968                    kill(MState),
 4969                    integer_log_b(Z, X, 1, Y)
 4970                ;   true
 4971                )
 4972            ;   fd_get(Y, _, YL, YU, _),
 4973                fd_get(Z, ZD, ZPs),
 4974                (   X > 0, YL cis_geq n(0) ->
 4975                    NZL cis n(X)^YL,
 4976                    NZU cis n(X)^YU,
 4977                    domains_intersection(ZD, from_to(NZL,NZU), NZD),
 4978                    fd_put(Z, NZD, ZPs)
 4979                ;   true
 4980                ),
 4981                (   X > 0,
 4982                    fd_get(Z, _, _, n(ZMax), _),
 4983                    ZMax > 0 ->
 4984                    floor_integer_log_b(ZMax, X, 1, YCeil),
 4985                    Y in inf..YCeil
 4986                ;   true
 4987                )
 4988            )
 4989        ;   nonvar(Z) ->
 4990            (   nonvar(Y) ->
 4991                integer_kth_root(Z, Y, R),
 4992                kill(MState),
 4993                (   even(Y) ->
 4994                    N is -R,
 4995                    X in N \/ R
 4996                ;   X = R
 4997                )
 4998            ;   fd_get(X, _, n(NXL), _, _), NXL > 1 ->
 4999                (   Z > 1, between(NXL, Z, Exp), NXL^Exp > Z ->
 5000                    Exp1 is Exp - 1,
 5001                    fd_get(Y, YD, YPs),
 5002                    domains_intersection(YD, from_to(n(1),n(Exp1)), YD1),
 5003                    fd_put(Y, YD1, YPs),
 5004                    (   fd_get(X, XD, XPs) ->
 5005                        domain_infimum(YD1, n(YL)),
 5006                        integer_kth_root_leq(Z, YL, RU),
 5007                        domains_intersection(XD, from_to(n(NXL),n(RU)), XD1),
 5008                        fd_put(X, XD1, XPs)
 5009                    ;   true
 5010                    )
 5011                ;   true
 5012                )
 5013            ;   true
 5014            )
 5015        ;   nonvar(Y), Y > 0 ->
 5016            (   even(Y) ->
 5017                geq(Z, 0)
 5018            ;   true
 5019            ),
 5020            (   fd_get(X, XD, XL, XU, _), fd_get(Z, ZD, ZL, ZU, ZPs) ->
 5021                (   domain_contains(ZD, 0) -> XD1 = XD
 5022                ;   domain_remove(XD, 0, XD1)
 5023                ),
 5024                (   domain_contains(XD, 0) -> ZD1 = ZD
 5025                ;   domain_remove(ZD, 0, ZD1)
 5026                ),
 5027                (   even(Y) ->
 5028                    (   XL cis_geq n(0) ->
 5029                        NZL cis XL^n(Y)
 5030                    ;   XU cis_leq n(0) ->
 5031                        NZL cis XU^n(Y)
 5032                    ;   NZL = n(0)
 5033                    ),
 5034                    NZU cis max(abs(XL),abs(XU))^n(Y),
 5035                    domains_intersection(ZD1, from_to(NZL,NZU), ZD2)
 5036                ;   (   finite(XL) ->
 5037                        NZL cis XL^n(Y),
 5038                        NZU cis XU^n(Y),
 5039                        domains_intersection(ZD1, from_to(NZL,NZU), ZD2)
 5040                    ;   ZD2 = ZD1
 5041                    )
 5042                ),
 5043                fd_put(Z, ZD2, ZPs),
 5044                (   even(Y), ZU = n(Num) ->
 5045                    integer_kth_root_leq(Num, Y, RU),
 5046                    (   XL cis_geq n(0), ZL = n(Num1) ->
 5047                        integer_kth_root_leq(Num1, Y, RL0),
 5048                        (   RL0^Y < Num1 -> RL is RL0 + 1
 5049                        ;   RL = RL0
 5050                        )
 5051                    ;   RL is -RU
 5052                    ),
 5053                    RL =< RU,
 5054                    NXD = from_to(n(RL),n(RU))
 5055                ;   odd(Y), ZL cis_geq n(0), ZU = n(Num) ->
 5056                    integer_kth_root_leq(Num, Y, RU),
 5057                    ZL = n(Num1),
 5058                    integer_kth_root_leq(Num1, Y, RL0),
 5059                    (   RL0^Y < Num1 -> RL is RL0 + 1
 5060                    ;   RL = RL0
 5061                    ),
 5062                    RL =< RU,
 5063                    NXD = from_to(n(RL),n(RU))
 5064                ;   NXD = XD1   % TODO: propagate more
 5065                ),
 5066                (   fd_get(X, XD2, XPs) ->
 5067                    domains_intersection(XD2, XD1, XD3),
 5068                    domains_intersection(XD3, NXD, XD4),
 5069                    fd_put(X, XD4, XPs)
 5070                ;   true
 5071                )
 5072            ;   true
 5073            )
 5074        ;   fd_get(X, _, XL, _, _),
 5075            XL cis_gt n(0),
 5076            fd_get(Y, _, YL, _, _),
 5077            YL cis_gt n(0),
 5078            fd_get(Z, ZD, ZPs) ->
 5079            n(NZL) cis XL^YL,
 5080            domain_remove_smaller_than(ZD, NZL, ZD1),
 5081            fd_put(Z, ZD1, ZPs)
 5082        ;   true
 5083        ).
 5084
 5085%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5086run_propagator(pzcompare(Order, A, B), MState) :-
 5087        (   A == B -> kill(MState), Order = (=)
 5088        ;   (   nonvar(A) ->
 5089                (   nonvar(B) ->
 5090                    kill(MState),
 5091                    (   A > B -> Order = (>)
 5092                    ;   Order = (<)
 5093                    )
 5094                ;   fd_get(B, _, BL, BU, _),
 5095                    (   BL cis_gt n(A) -> kill(MState), Order = (<)
 5096                    ;   BU cis_lt n(A) -> kill(MState), Order = (>)
 5097                    ;   true
 5098                    )
 5099                )
 5100            ;   nonvar(B) ->
 5101                fd_get(A, _, AL, AU, _),
 5102                (   AL cis_gt n(B) -> kill(MState), Order = (>)
 5103                ;   AU cis_lt n(B) -> kill(MState), Order = (<)
 5104                ;   true
 5105                )
 5106            ;   fd_get(A, _, AL, AU, _),
 5107                fd_get(B, _, BL, BU, _),
 5108                (   AL cis_gt BU -> kill(MState), Order = (>)
 5109                ;   AU cis_lt BL -> kill(MState), Order = (<)
 5110                ;   true
 5111                )
 5112            )
 5113        ).
 5114
 5115%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5116
 5117% reified constraints
 5118
 5119%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5120
 5121run_propagator(reified_in(V,Dom,B), MState) :-
 5122        (   integer(V) ->
 5123            kill(MState),
 5124            (   domain_contains(Dom, V) -> B = 1
 5125            ;   B = 0
 5126            )
 5127        ;   B == 1 -> kill(MState), domain(V, Dom)
 5128        ;   B == 0 -> kill(MState), domain_complement(Dom, C), domain(V, C)
 5129        ;   fd_get(V, VD, _),
 5130            (   domains_intersection(VD, Dom, I) ->
 5131                (   I == VD -> kill(MState), B = 1
 5132                ;   true
 5133                )
 5134            ;   kill(MState), B = 0
 5135            )
 5136        ).
 5137
 5138run_propagator(reified_tuple_in(Tuple, R, B), MState) :-
 5139        get_attr(R, clpfd_relation, Relation),
 5140        (   B == 1 -> kill(MState), tuples_in([Tuple], Relation)
 5141        ;   (   ground(Tuple) ->
 5142                kill(MState),
 5143                (   memberchk(Tuple, Relation) -> B = 1
 5144                ;   B = 0
 5145                )
 5146            ;   relation_unifiable(Relation, Tuple, Us, _, _),
 5147                (   Us = [] -> kill(MState), B = 0
 5148                ;   true
 5149                )
 5150            )
 5151        ).
 5152
 5153run_propagator(tuples_not_in(Tuples, Relation, B), MState) :-
 5154        (   B == 0 ->
 5155            kill(MState),
 5156            tuples_in_conjunction(Tuples, Relation, Conj),
 5157            #\ Conj
 5158        ;   true
 5159        ).
 5160
 5161run_propagator(kill_reified_tuples(B, Ps, Bs), _) :-
 5162        (   B == 0 ->
 5163            maplist(kill_entailed, Ps),
 5164            phrase(as(Bs), As),
 5165            maplist(kill_entailed, As)
 5166        ;   true
 5167        ).
 5168
 5169run_propagator(reified_fd(V,B), MState) :-
 5170        (   fd_inf(V, I), I \== inf, fd_sup(V, S), S \== sup ->
 5171            kill(MState),
 5172            B = 1
 5173        ;   B == 0 ->
 5174            (   fd_inf(V, inf) -> true
 5175            ;   fd_sup(V, sup) -> true
 5176            ;   false
 5177            )
 5178        ;   true
 5179        ).
 5180
 5181% The result of X/Y, X mod Y, and X rem Y is undefined iff Y is 0.
 5182
 5183run_propagator(pskeleton(X,Y,D,Skel,Z,_), MState) :-
 5184        (   Y == 0 -> kill(MState), D = 0
 5185        ;   D == 1 -> kill(MState), neq_num(Y, 0), skeleton([X,Y,Z], Skel)
 5186        ;   integer(Y), Y =\= 0 -> kill(MState), D = 1, skeleton([X,Y,Z], Skel)
 5187        ;   fd_get(Y, YD, _), \+ domain_contains(YD, 0) ->
 5188            kill(MState),
 5189            D = 1, skeleton([X,Y,Z], Skel)
 5190        ;   true
 5191        ).
 5192
 5193/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 5194   Propagators for arithmetic functions that only propagate
 5195   functionally. These are currently the bitwise operations.
 5196- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 5197
 5198run_propagator(pfunction(Op,A,B,R), MState) :-
 5199        (   integer(A), integer(B) ->
 5200            kill(MState),
 5201            Expr =.. [Op,A,B],
 5202            R is Expr
 5203        ;   true
 5204        ).
 5205run_propagator(pfunction(Op,A,R), MState) :-
 5206        (   integer(A) ->
 5207            kill(MState),
 5208            Expr =.. [Op,A],
 5209            R is Expr
 5210        ;   true
 5211        ).
 5212
 5213%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5214
 5215run_propagator(reified_geq(DX,X,DY,Y,Ps,B), MState) :-
 5216        (   DX == 0 -> kill(MState, Ps), B = 0
 5217        ;   DY == 0 -> kill(MState, Ps), B = 0
 5218        ;   B == 1 -> kill(MState), DX = 1, DY = 1, geq(X, Y)
 5219        ;   DX == 1, DY == 1 ->
 5220            (   var(B) ->
 5221                (   nonvar(X) ->
 5222                    (   nonvar(Y) ->
 5223                        kill(MState),
 5224                        (   X >= Y -> B = 1 ; B = 0 )
 5225                    ;   fd_get(Y, _, YL, YU, _),
 5226                        (   n(X) cis_geq YU -> kill(MState, Ps), B = 1
 5227                        ;   n(X) cis_lt YL -> kill(MState, Ps), B = 0
 5228                        ;   true
 5229                        )
 5230                    )
 5231                ;   nonvar(Y) ->
 5232                    fd_get(X, _, XL, XU, _),
 5233                    (   XL cis_geq n(Y) -> kill(MState, Ps), B = 1
 5234                    ;   XU cis_lt n(Y) -> kill(MState, Ps), B = 0
 5235                    ;   true
 5236                    )
 5237                ;   X == Y -> kill(MState, Ps), B = 1
 5238                ;   fd_get(X, _, XL, XU, _),
 5239                    fd_get(Y, _, YL, YU, _),
 5240                    (   XL cis_geq YU -> kill(MState, Ps), B = 1
 5241                    ;   XU cis_lt YL -> kill(MState, Ps), B = 0
 5242                    ;   true
 5243                    )
 5244                )
 5245            ;   B =:= 0 -> kill(MState), X #< Y
 5246            ;   true
 5247            )
 5248        ;   true
 5249        ).
 5250
 5251%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5252run_propagator(reified_eq(DX,X,DY,Y,Ps,B), MState) :-
 5253        (   DX == 0 -> kill(MState, Ps), B = 0
 5254        ;   DY == 0 -> kill(MState, Ps), B = 0
 5255        ;   B == 1 -> kill(MState), DX = 1, DY = 1, X = Y
 5256        ;   DX == 1, DY == 1 ->
 5257            (   var(B) ->
 5258                (   nonvar(X) ->
 5259                    (   nonvar(Y) ->
 5260                        kill(MState),
 5261                        (   X =:= Y -> B = 1 ; B = 0)
 5262                    ;   fd_get(Y, YD, _),
 5263                        (   domain_contains(YD, X) -> true
 5264                        ;   kill(MState, Ps), B = 0
 5265                        )
 5266                    )
 5267                ;   nonvar(Y) -> run_propagator(reified_eq(DY,Y,DX,X,Ps,B), MState)
 5268                ;   X == Y -> kill(MState), B = 1
 5269                ;   fd_get(X, _, XL, XU, _),
 5270                    fd_get(Y, _, YL, YU, _),
 5271                    (   XL cis_gt YU -> kill(MState, Ps), B = 0
 5272                    ;   YL cis_gt XU -> kill(MState, Ps), B = 0
 5273                    ;   true
 5274                    )
 5275                )
 5276            ;   B =:= 0 -> kill(MState), X #\= Y
 5277            ;   true
 5278            )
 5279        ;   true
 5280        ).
 5281%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5282run_propagator(reified_neq(DX,X,DY,Y,Ps,B), MState) :-
 5283        (   DX == 0 -> kill(MState, Ps), B = 0
 5284        ;   DY == 0 -> kill(MState, Ps), B = 0
 5285        ;   B == 1 -> kill(MState), DX = 1, DY = 1, X #\= Y
 5286        ;   DX == 1, DY == 1 ->
 5287            (   var(B) ->
 5288                (   nonvar(X) ->
 5289                    (   nonvar(Y) ->
 5290                        kill(MState),
 5291                        (   X =\= Y -> B = 1 ; B = 0)
 5292                    ;   fd_get(Y, YD, _),
 5293                        (   domain_contains(YD, X) -> true
 5294                        ;   kill(MState, Ps), B = 1
 5295                        )
 5296                    )
 5297                ;   nonvar(Y) -> run_propagator(reified_neq(DY,Y,DX,X,Ps,B), MState)
 5298                ;   X == Y -> kill(MState), B = 0
 5299                ;   fd_get(X, _, XL, XU, _),
 5300                    fd_get(Y, _, YL, YU, _),
 5301                    (   XL cis_gt YU -> kill(MState, Ps), B = 1
 5302                    ;   YL cis_gt XU -> kill(MState, Ps), B = 1
 5303                    ;   true
 5304                    )
 5305                )
 5306            ;   B =:= 0 -> kill(MState), X = Y
 5307            ;   true
 5308            )
 5309        ;   true
 5310        ).
 5311%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5312run_propagator(reified_and(X,Ps1,Y,Ps2,B), MState) :-
 5313        (   nonvar(X) ->
 5314            kill(MState),
 5315            (   X =:= 0 -> maplist(kill_entailed, Ps2), B = 0
 5316            ;   B = Y
 5317            )
 5318        ;   nonvar(Y) -> run_propagator(reified_and(Y,Ps2,X,Ps1,B), MState)
 5319        ;   B == 1 -> kill(MState), X = 1, Y = 1
 5320        ;   true
 5321        ).
 5322
 5323%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5324run_propagator(reified_or(X,Ps1,Y,Ps2,B), MState) :-
 5325        (   nonvar(X) ->
 5326            kill(MState),
 5327            (   X =:= 1 -> maplist(kill_entailed, Ps2), B = 1
 5328            ;   B = Y
 5329            )
 5330        ;   nonvar(Y) -> run_propagator(reified_or(Y,Ps2,X,Ps1,B), MState)
 5331        ;   B == 0 -> kill(MState), X = 0, Y = 0
 5332        ;   true
 5333        ).
 5334
 5335%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5336run_propagator(reified_not(X,Y), MState) :-
 5337        (   X == 0 -> kill(MState), Y = 1
 5338        ;   X == 1 -> kill(MState), Y = 0
 5339        ;   Y == 0 -> kill(MState), X = 1
 5340        ;   Y == 1 -> kill(MState), X = 0
 5341        ;   true
 5342        ).
 5343
 5344%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5345run_propagator(pimpl(X, Y, Ps), MState) :-
 5346        (   nonvar(X) ->
 5347            kill(MState),
 5348            (   X =:= 1 -> Y = 1
 5349            ;   maplist(kill_entailed, Ps)
 5350            )
 5351        ;   nonvar(Y) ->
 5352            kill(MState),
 5353            (   Y =:= 0 -> X = 0
 5354            ;   maplist(kill_entailed, Ps)
 5355            )
 5356        ;   true
 5357        ).
 5358
 5359%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5360%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5361
 5362update_bounds(X, XD, XPs, XL, XU, NXL, NXU) :-
 5363        (   NXL == XL, NXU == XU -> true
 5364        ;   domains_intersection(XD, from_to(NXL, NXU), NXD),
 5365            fd_put(X, NXD, XPs)
 5366        ).
 5367
 5368min_product(L1, U1, L2, U2, Min) :-
 5369        Min cis min(min(L1*L2,L1*U2),min(U1*L2,U1*U2)).
 5370max_product(L1, U1, L2, U2, Max) :-
 5371        Max cis max(max(L1*L2,L1*U2),max(U1*L2,U1*U2)).
 5372
 5373finite(n(_)).
 5374
 5375in_(L, U, X) :-
 5376        fd_get(X, XD, XPs),
 5377        domains_intersection(XD, from_to(L,U), NXD),
 5378        fd_put(X, NXD, XPs).
 5379
 5380min_max_factor(L1, U1, L2, U2, L3, U3, Min, Max) :-
 5381        (   U1 cis_lt n(0),
 5382            L2 cis_lt n(0), U2 cis_gt n(0),
 5383            L3 cis_lt n(0), U3 cis_gt n(0) ->
 5384            maplist(in_(L1,U1), [Z1,Z2]),
 5385            in_(L2, n(-1), X1), in_(n(1), U3, Y1),
 5386            (   X1*Y1 #= Z1 ->
 5387                (   fd_get(Y1, _, Inf1, Sup1, _) -> true
 5388                ;   Inf1 = n(Y1), Sup1 = n(Y1)
 5389                )
 5390            ;   Inf1 = inf, Sup1 = n(-1)
 5391            ),
 5392            in_(n(1), U2, X2), in_(L3, n(-1), Y2),
 5393            (   X2*Y2 #= Z2 ->
 5394                (   fd_get(Y2, _, Inf2, Sup2, _) -> true
 5395                ;   Inf2 = n(Y2), Sup2 = n(Y2)
 5396                )
 5397            ;   Inf2 = n(1), Sup2 = sup
 5398            ),
 5399            Min cis max(min(Inf1,Inf2), L3),
 5400            Max cis min(max(Sup1,Sup2), U3)
 5401        ;   L1 cis_gt n(0),
 5402            L2 cis_lt n(0), U2 cis_gt n(0),
 5403            L3 cis_lt n(0), U3 cis_gt n(0) ->
 5404            maplist(in_(L1,U1), [Z1,Z2]),
 5405            in_(L2, n(-1), X1), in_(L3, n(-1), Y1),
 5406            (   X1*Y1 #= Z1 ->
 5407                (   fd_get(Y1, _, Inf1, Sup1, _) -> true
 5408                ;   Inf1 = n(Y1), Sup1 = n(Y1)
 5409                )
 5410            ;   Inf1 = n(1), Sup1 = sup
 5411            ),
 5412            in_(n(1), U2, X2), in_(n(1), U3, Y2),
 5413            (   X2*Y2 #= Z2 ->
 5414                (   fd_get(Y2, _, Inf2, Sup2, _) -> true
 5415                ;   Inf2 = n(Y2), Sup2 = n(Y2)
 5416                )
 5417            ;   Inf2 = inf, Sup2 = n(-1)
 5418            ),
 5419            Min cis max(min(Inf1,Inf2), L3),
 5420            Max cis min(max(Sup1,Sup2), U3)
 5421        ;   min_factor(L1, U1, L2, U2, Min0),
 5422            Min cis max(L3,Min0),
 5423            max_factor(L1, U1, L2, U2, Max0),
 5424            Max cis min(U3,Max0)
 5425        ).
 5426
 5427min_factor(L1, U1, L2, U2, Min) :-
 5428        (   L1 cis_geq n(0), L2 cis_gt n(0), finite(U2) ->
 5429            Min cis div(L1+U2-n(1),U2)
 5430        ;   L1 cis_gt n(0), U2 cis_lt n(0) -> Min cis div(U1,U2)
 5431        ;   L1 cis_gt n(0), L2 cis_geq n(0) -> Min = n(1)
 5432        ;   L1 cis_gt n(0) -> Min cis -U1
 5433        ;   U1 cis_lt n(0), U2 cis_leq n(0) ->
 5434            (   finite(L2) -> Min cis div(U1+L2+n(1),L2)
 5435            ;   Min = n(1)
 5436            )
 5437        ;   U1 cis_lt n(0), L2 cis_geq n(0) -> Min cis div(L1,L2)
 5438        ;   U1 cis_lt n(0) -> Min = L1
 5439        ;   L2 cis_leq n(0), U2 cis_geq n(0) -> Min = inf
 5440        ;   Min cis min(min(div(L1,L2),div(L1,U2)),min(div(U1,L2),div(U1,U2)))
 5441        ).
 5442max_factor(L1, U1, L2, U2, Max) :-
 5443        (   L1 cis_geq n(0), L2 cis_geq n(0) -> Max cis div(U1,L2)
 5444        ;   L1 cis_gt n(0), U2 cis_leq n(0) ->
 5445            (   finite(L2) -> Max cis div(L1-L2-n(1),L2)
 5446            ;   Max = n(-1)
 5447            )
 5448        ;   L1 cis_gt n(0) -> Max = U1
 5449        ;   U1 cis_lt n(0), U2 cis_lt n(0) -> Max cis div(L1,U2)
 5450        ;   U1 cis_lt n(0), L2 cis_geq n(0) ->
 5451            (   finite(U2) -> Max cis div(U1-U2+n(1),U2)
 5452            ;   Max = n(-1)
 5453            )
 5454        ;   U1 cis_lt n(0) -> Max cis -L1
 5455        ;   L2 cis_leq n(0), U2 cis_geq n(0) -> Max = sup
 5456        ;   Max cis max(max(div(L1,L2),div(L1,U2)),max(div(U1,L2),div(U1,U2)))
 5457        ).
 5458
 5459%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5460/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 5461   J-C. Régin: "A filtering algorithm for constraints of difference in
 5462   CSPs", AAAI-94, Seattle, WA, USA, pp 362--367, 1994
 5463- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 5464
 5465distinct_attach([], _, _).
 5466distinct_attach([X|Xs], Prop, Right) :-
 5467        (   var(X) ->
 5468            init_propagator(X, Prop),
 5469            make_propagator(pexclude(Xs,Right,X), P1),
 5470            init_propagator(X, P1),
 5471            trigger_prop(P1)
 5472        ;   exclude_fire(Xs, Right, X)
 5473        ),
 5474        distinct_attach(Xs, Prop, [X|Right]).
 5475
 5476/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 5477   For each integer of the union of domains, an attributed variable is
 5478   introduced, to benefit from constant-time access. Attributes are:
 5479
 5480   value ... integer corresponding to the node
 5481   free  ... whether this (right) node is still free
 5482   edges ... [flow_from(F,From)] and [flow_to(F,To)] where F has an
 5483             attribute "flow" that is either 0 or 1 and an attribute "used"
 5484             if it is part of a maximum matching
 5485   parent ... used in breadth-first search
 5486   g0_edges ... [flow_to(F,To)] as above
 5487   visited ... true if node was visited in DFS
 5488   index, in_stack, lowlink ... used in Tarjan's SCC algorithm
 5489- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 5490
 5491difference_arcs(Vars, FreeLeft, FreeRight) :-
 5492        empty_assoc(E),
 5493        phrase(difference_arcs(Vars, FreeLeft), [E], [NumVar]),
 5494        assoc_to_list(NumVar, LsNumVar),
 5495        pairs_values(LsNumVar, FreeRight).
 5496
 5497domain_to_list(Domain, List) :- phrase(domain_to_list(Domain), List).
 5498
 5499domain_to_list(split(_, Left, Right)) -->
 5500        domain_to_list(Left), domain_to_list(Right).
 5501domain_to_list(empty)                 --> [].
 5502domain_to_list(from_to(n(F),n(T)))    --> { numlist(F, T, Ns) }, list(Ns).
 5503
 5504difference_arcs([], []) --> [].
 5505difference_arcs([V|Vs], FL0) -->
 5506        (   { fd_get(V, Dom, _),
 5507              finite_domain(Dom) } ->
 5508            { FL0 = [V|FL],
 5509              domain_to_list(Dom, Ns) },
 5510            enumerate(Ns, V),
 5511            difference_arcs(Vs, FL)
 5512        ;   difference_arcs(Vs, FL0)
 5513        ).
 5514
 5515enumerate([], _) --> [].
 5516enumerate([N|Ns], V) -->
 5517        state(NumVar0, NumVar),
 5518        { (   get_assoc(N, NumVar0, Y) -> NumVar0 = NumVar
 5519          ;   put_assoc(N, NumVar0, Y, NumVar),
 5520              put_attr(Y, value, N)
 5521          ),
 5522          put_attr(F, flow, 0),
 5523          append_edge(Y, edges, flow_from(F,V)),
 5524          append_edge(V, edges, flow_to(F,Y)) },
 5525        enumerate(Ns, V).
 5526
 5527append_edge(V, Attr, E) :-
 5528        (   get_attr(V, Attr, Es) ->
 5529            put_attr(V, Attr, [E|Es])
 5530        ;   put_attr(V, Attr, [E])
 5531        ).
 5532
 5533/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 5534   Strategy: Breadth-first search until we find a free right vertex in
 5535   the value graph, then find an augmenting path in reverse.
 5536- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 5537
 5538clear_parent(V) :- del_attr(V, parent).
 5539
 5540maximum_matching([]).
 5541maximum_matching([FL|FLs]) :-
 5542        augmenting_path_to([[FL]], Levels, To),
 5543        phrase(augmenting_path(FL, To), Path),
 5544        maplist(maplist(clear_parent), Levels),
 5545        del_attr(To, free),
 5546        adjust_alternate_1(Path),
 5547        maximum_matching(FLs).
 5548
 5549reachables([]) --> [].
 5550reachables([V|Vs]) -->
 5551        { get_attr(V, edges, Es) },
 5552        reachables_(Es, V),
 5553        reachables(Vs).
 5554
 5555reachables_([], _) --> [].
 5556reachables_([E|Es], V) -->
 5557        edge_reachable(E, V),
 5558        reachables_(Es, V).
 5559
 5560edge_reachable(flow_to(F,To), V) -->
 5561        (   { get_attr(F, flow, 0),
 5562              \+ get_attr(To, parent, _) } ->
 5563            { put_attr(To, parent, V-F) },
 5564            [To]
 5565        ;   []
 5566        ).
 5567edge_reachable(flow_from(F,From), V) -->
 5568        (   { get_attr(F, flow, 1),
 5569              \+ get_attr(From, parent, _) } ->
 5570            { put_attr(From, parent, V-F) },
 5571            [From]
 5572        ;   []
 5573        ).
 5574
 5575augmenting_path_to(Levels0, Levels, Right) :-
 5576        Levels0 = [Vs|_],
 5577        Levels1 = [Tos|Levels0],
 5578        phrase(reachables(Vs), Tos),
 5579        Tos = [_|_],
 5580        (   member(Right, Tos), get_attr(Right, free, true) ->
 5581            Levels = Levels1
 5582        ;   augmenting_path_to(Levels1, Levels, Right)
 5583        ).
 5584
 5585augmenting_path(S, V) -->
 5586        (   { V == S } -> []
 5587        ;   { get_attr(V, parent, V1-Augment) },
 5588            [Augment],
 5589            augmenting_path(S, V1)
 5590        ).
 5591
 5592adjust_alternate_1([A|Arcs]) :-
 5593        put_attr(A, flow, 1),
 5594        adjust_alternate_0(Arcs).
 5595
 5596adjust_alternate_0([]).
 5597adjust_alternate_0([A|Arcs]) :-
 5598        put_attr(A, flow, 0),
 5599        adjust_alternate_1(Arcs).
 5600
 5601% Instead of applying Berge's property directly, we can translate the
 5602% problem in such a way, that we have to search for the so-called
 5603% strongly connected components of the graph.
 5604
 5605g_g0(V) :-
 5606        get_attr(V, edges, Es),
 5607        maplist(g_g0_(V), Es).
 5608
 5609g_g0_(V, flow_to(F,To)) :-
 5610        (   get_attr(F, flow, 1) ->
 5611            append_edge(V, g0_edges, flow_to(F,To))
 5612        ;   append_edge(To, g0_edges, flow_to(F,V))
 5613        ).
 5614
 5615
 5616g0_successors(V, Tos) :-
 5617        (   get_attr(V, g0_edges, Tos0) ->
 5618            maplist(arg(2), Tos0, Tos)
 5619        ;   Tos = []
 5620        ).
 5621
 5622put_free(F) :- put_attr(F, free, true).
 5623
 5624free_node(F) :- get_attr(F, free, true).
 5625
 5626del_vars_attr(Vars, Attr) :- maplist(del_attr_(Attr), Vars).
 5627
 5628del_attr_(Attr, Var) :- del_attr(Var, Attr).
 5629
 5630with_local_attributes(Vars, Attrs, Goal, Result) :-
 5631        catch((maplist(del_vars_attr(Vars), Attrs),
 5632               Goal,
 5633               maplist(del_attrs, Vars),
 5634               % reset all attributes, only the result matters
 5635               throw(local_attributes(Result,Vars))),
 5636              local_attributes(Result,Vars),
 5637              true).
 5638
 5639distinct(Vars) :-
 5640        with_local_attributes(Vars, [edges,parent,g0_edges,index,visited],
 5641              (difference_arcs(Vars, FreeLeft, FreeRight0),
 5642               length(FreeLeft, LFL),
 5643               length(FreeRight0, LFR),
 5644               LFL =< LFR,
 5645               maplist(put_free, FreeRight0),
 5646               maximum_matching(FreeLeft),
 5647               include(free_node, FreeRight0, FreeRight),
 5648               maplist(g_g0, FreeLeft),
 5649               scc(FreeLeft, g0_successors),
 5650               maplist(dfs_used, FreeRight),
 5651               phrase(distinct_goals(FreeLeft), Gs)), Gs),
 5652        disable_queue,
 5653        maplist(call, Gs),
 5654        enable_queue.
 5655
 5656distinct_goals([]) --> [].
 5657distinct_goals([V|Vs]) -->
 5658        { get_attr(V, edges, Es) },
 5659        distinct_goals_(Es, V),
 5660        distinct_goals(Vs).
 5661
 5662distinct_goals_([], _) --> [].
 5663distinct_goals_([flow_to(F,To)|Es], V) -->
 5664        (   { get_attr(F, flow, 0),
 5665              \+ get_attr(F, used, true),
 5666              get_attr(V, lowlink, L1),
 5667              get_attr(To, lowlink, L2),
 5668              L1 =\= L2 } ->
 5669            { get_attr(To, value, N) },
 5670            [neq_num(V, N)]
 5671        ;   []
 5672        ),
 5673        distinct_goals_(Es, V).
 5674
 5675/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 5676   Mark used edges.
 5677- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 5678
 5679dfs_used(V) :-
 5680        (   get_attr(V, visited, true) -> true
 5681        ;   put_attr(V, visited, true),
 5682            (   get_attr(V, g0_edges, Es) ->
 5683                dfs_used_edges(Es)
 5684            ;   true
 5685            )
 5686        ).
 5687
 5688dfs_used_edges([]).
 5689dfs_used_edges([flow_to(F,To)|Es]) :-
 5690        put_attr(F, used, true),
 5691        dfs_used(To),
 5692        dfs_used_edges(Es).
 5693
 5694/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 5695   Tarjan's strongly connected components algorithm.
 5696
 5697   DCGs are used to implicitly pass around the global index, stack
 5698   and the predicate relating a vertex to its successors.
 5699
 5700   For more information about this technique, see:
 5701
 5702                 https://www.metalevel.at/prolog/dcg
 5703                 ===================================
 5704
 5705   A Prolog implementation of this algorithm is also available as a
 5706   standalone library from:
 5707
 5708                   https://www.metalevel.at/scc.pl
 5709- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 5710
 5711scc(Vs, Succ) :- phrase(scc(Vs), [s(0,[],Succ)], _).
 5712
 5713scc([])     --> [].
 5714scc([V|Vs]) -->
 5715        (   vindex_defined(V) -> scc(Vs)
 5716        ;   scc_(V), scc(Vs)
 5717        ).
 5718
 5719vindex_defined(V) --> { get_attr(V, index, _) }.
 5720
 5721vindex_is_index(V) -->
 5722        state(s(Index,_,_)),
 5723        { put_attr(V, index, Index) }.
 5724
 5725vlowlink_is_index(V) -->
 5726        state(s(Index,_,_)),
 5727        { put_attr(V, lowlink, Index) }.
 5728
 5729index_plus_one -->
 5730        state(s(I,Stack,Succ), s(I1,Stack,Succ)),
 5731        { I1 is I+1 }.
 5732
 5733s_push(V)  -->
 5734        state(s(I,Stack,Succ), s(I,[V|Stack],Succ)),
 5735        { put_attr(V, in_stack, true) }.
 5736
 5737vlowlink_min_lowlink(V, VP) -->
 5738        { get_attr(V, lowlink, VL),
 5739          get_attr(VP, lowlink, VPL),
 5740          VL1 is min(VL, VPL),
 5741          put_attr(V, lowlink, VL1) }.
 5742
 5743successors(V, Tos) --> state(s(_,_,Succ)), { call(Succ, V, Tos) }.
 5744
 5745scc_(V) -->
 5746        vindex_is_index(V),
 5747        vlowlink_is_index(V),
 5748        index_plus_one,
 5749        s_push(V),
 5750        successors(V, Tos),
 5751        each_edge(Tos, V),
 5752        (   { get_attr(V, index, VI),
 5753              get_attr(V, lowlink, VI) } -> pop_stack_to(V, VI)
 5754        ;   []
 5755        ).
 5756
 5757pop_stack_to(V, N) -->
 5758        state(s(I,[First|Stack],Succ), s(I,Stack,Succ)),
 5759        { del_attr(First, in_stack) },
 5760        (   { First == V } -> []
 5761        ;   { put_attr(First, lowlink, N) },
 5762            pop_stack_to(V, N)
 5763        ).
 5764
 5765each_edge([], _) --> [].
 5766each_edge([VP|VPs], V) -->
 5767        (   vindex_defined(VP) ->
 5768            (   v_in_stack(VP) ->
 5769                vlowlink_min_lowlink(V, VP)
 5770            ;   []
 5771            )
 5772        ;   scc_(VP),
 5773            vlowlink_min_lowlink(V, VP)
 5774        ),
 5775        each_edge(VPs, V).
 5776
 5777state(S), [S] --> [S].
 5778
 5779state(S0, S), [S] --> [S0].
 5780
 5781v_in_stack(V) --> { get_attr(V, in_stack, true) }.
 5782
 5783/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 5784   Weak arc consistent constraint of difference, currently only
 5785   available internally. Candidate for all_different/2 option.
 5786
 5787   See Neng-Fa Zhou: "Programming Finite-Domain Constraint Propagators
 5788   in Action Rules", Theory and Practice of Logic Programming, Vol.6,
 5789   No.5, pp 483-508, 2006
 5790- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 5791
 5792weak_arc_all_distinct(Ls) :-
 5793        must_be(list, Ls),
 5794        Orig = original_goal(_, weak_arc_all_distinct(Ls)),
 5795        all_distinct(Ls, [], Orig),
 5796        do_queue.
 5797
 5798all_distinct([], _, _).
 5799all_distinct([X|Right], Left, Orig) :-
 5800        %\+ list_contains(Right, X),
 5801        (   var(X) ->
 5802            make_propagator(weak_distinct(Left,Right,X,Orig), Prop),
 5803            init_propagator(X, Prop),
 5804            trigger_prop(Prop)
 5805%             make_propagator(check_distinct(Left,Right,X), Prop2),
 5806%             init_propagator(X, Prop2),
 5807%             trigger_prop(Prop2)
 5808        ;   exclude_fire(Left, Right, X)
 5809        ),
 5810        outof_reducer(Left, Right, X),
 5811        all_distinct(Right, [X|Left], Orig).
 5812
 5813exclude_fire(Left, Right, E) :-
 5814        all_neq(Left, E),
 5815        all_neq(Right, E).
 5816
 5817list_contains([X|Xs], Y) :-
 5818        (   X == Y -> true
 5819        ;   list_contains(Xs, Y)
 5820        ).
 5821
 5822kill_if_isolated(Left, Right, X, MState) :-
 5823        append(Left, Right, Others),
 5824        fd_get(X, XDom, _),
 5825        (   all_empty_intersection(Others, XDom) -> kill(MState)
 5826        ;   true
 5827        ).
 5828
 5829all_empty_intersection([], _).
 5830all_empty_intersection([V|Vs], XDom) :-
 5831        (   fd_get(V, VDom, _) ->
 5832            domains_intersection_(VDom, XDom, empty),
 5833            all_empty_intersection(Vs, XDom)
 5834        ;   all_empty_intersection(Vs, XDom)
 5835        ).
 5836
 5837outof_reducer(Left, Right, Var) :-
 5838        (   fd_get(Var, Dom, _) ->
 5839            append(Left, Right, Others),
 5840            domain_num_elements(Dom, N),
 5841            num_subsets(Others, Dom, 0, Num, NonSubs),
 5842            (   n(Num) cis_geq N -> false
 5843            ;   n(Num) cis N - n(1) ->
 5844                reduce_from_others(NonSubs, Dom)
 5845            ;   true
 5846            )
 5847        ;   %\+ list_contains(Right, Var),
 5848            %\+ list_contains(Left, Var)
 5849            true
 5850        ).
 5851
 5852reduce_from_others([], _).
 5853reduce_from_others([X|Xs], Dom) :-
 5854        (   fd_get(X, XDom, XPs) ->
 5855            domain_subtract(XDom, Dom, NXDom),
 5856            fd_put(X, NXDom, XPs)
 5857        ;   true
 5858        ),
 5859        reduce_from_others(Xs, Dom).
 5860
 5861num_subsets([], _Dom, Num, Num, []).
 5862num_subsets([S|Ss], Dom, Num0, Num, NonSubs) :-
 5863        (   fd_get(S, SDom, _) ->
 5864            (   domain_subdomain(Dom, SDom) ->
 5865                Num1 is Num0 + 1,
 5866                num_subsets(Ss, Dom, Num1, Num, NonSubs)
 5867            ;   NonSubs = [S|Rest],
 5868                num_subsets(Ss, Dom, Num0, Num, Rest)
 5869            )
 5870        ;   num_subsets(Ss, Dom, Num0, Num, NonSubs)
 5871        ).
 5872
 5873%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5874
 5875%%  serialized(+Starts, +Durations)
 5876%
 5877%   Describes a set of non-overlapping tasks.
 5878%   Starts = [S_1,...,S_n], is a list of variables or integers,
 5879%   Durations = [D_1,...,D_n] is a list of non-negative integers.
 5880%   Constrains Starts and Durations to denote a set of
 5881%   non-overlapping tasks, i.e.: S_i + D_i =< S_j or S_j + D_j =<
 5882%   S_i for all 1 =< i < j =< n. Example:
 5883%
 5884%   ==
 5885%   ?- length(Vs, 3),
 5886%      Vs ins 0..3,
 5887%      serialized(Vs, [1,2,3]),
 5888%      label(Vs).
 5889%   Vs = [0, 1, 3] ;
 5890%   Vs = [2, 0, 3] ;
 5891%   false.
 5892%   ==
 5893%
 5894%  @see Dorndorf et al. 2000, "Constraint Propagation Techniques for the
 5895%       Disjunctive Scheduling Problem"
 5896
 5897serialized(Starts, Durations) :-
 5898        must_be(list(integer), Durations),
 5899        pairs_keys_values(SDs, Starts, Durations),
 5900        Orig = original_goal(_, serialized(Starts, Durations)),
 5901        serialize(SDs, Orig).
 5902
 5903serialize([], _).
 5904serialize([S-D|SDs], Orig) :-
 5905        D >= 0,
 5906        serialize(SDs, S, D, Orig),
 5907        serialize(SDs, Orig).
 5908
 5909serialize([], _, _, _).
 5910serialize([S-D|Rest], S0, D0, Orig) :-
 5911        D >= 0,
 5912        propagator_init_trigger([S0,S], pserialized(S,D,S0,D0,Orig)),
 5913        serialize(Rest, S0, D0, Orig).
 5914
 5915% consistency check / propagation
 5916% Currently implements 2-b-consistency
 5917
 5918earliest_start_time(Start, EST) :-
 5919        (   fd_get(Start, D, _) ->
 5920            domain_infimum(D, EST)
 5921        ;   EST = n(Start)
 5922        ).
 5923
 5924latest_start_time(Start, LST) :-
 5925        (   fd_get(Start, D, _) ->
 5926            domain_supremum(D, LST)
 5927        ;   LST = n(Start)
 5928        ).
 5929
 5930serialize_lower_upper(S_I, D_I, S_J, D_J, MState) :-
 5931        (   var(S_I) ->
 5932            serialize_lower_bound(S_I, D_I, S_J, D_J, MState),
 5933            (   var(S_I) -> serialize_upper_bound(S_I, D_I, S_J, D_J, MState)
 5934            ;   true
 5935            )
 5936        ;   true
 5937        ).
 5938
 5939serialize_lower_bound(I, D_I, J, D_J, MState) :-
 5940        fd_get(I, DomI, Ps),
 5941        (   domain_infimum(DomI, n(EST_I)),
 5942            latest_start_time(J, n(LST_J)),
 5943            EST_I + D_I > LST_J,
 5944            earliest_start_time(J, n(EST_J)) ->
 5945            (   nonvar(J) -> kill(MState)
 5946            ;   true
 5947            ),
 5948            EST is EST_J+D_J,
 5949            domain_remove_smaller_than(DomI, EST, DomI1),
 5950            fd_put(I, DomI1, Ps)
 5951        ;   true
 5952        ).
 5953
 5954serialize_upper_bound(I, D_I, J, D_J, MState) :-
 5955        fd_get(I, DomI, Ps),
 5956        (   domain_supremum(DomI, n(LST_I)),
 5957            earliest_start_time(J, n(EST_J)),
 5958            EST_J + D_J > LST_I,
 5959            latest_start_time(J, n(LST_J)) ->
 5960            (   nonvar(J) -> kill(MState)
 5961            ;   true
 5962            ),
 5963            LST is LST_J-D_I,
 5964            domain_remove_greater_than(DomI, LST, DomI1),
 5965            fd_put(I, DomI1, Ps)
 5966        ;   true
 5967        ).
 5968
 5969%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 5970
 5971%%    element(?N, +Vs, ?V)
 5972%
 5973%     The N-th element of the list of finite domain variables Vs is V.
 5974%     Analogous to nth1/3.
 5975
 5976element(N, Is, V) :-
 5977        must_be(list, Is),
 5978        length(Is, L),
 5979        N in 1..L,
 5980        element_(Is, 1, N, V),
 5981        propagator_init_trigger([N|Is], pelement(N,Is,V)).
 5982
 5983element_domain(V, VD) :-
 5984        (   fd_get(V, VD, _) -> true
 5985        ;   VD = from_to(n(V), n(V))
 5986        ).
 5987
 5988element_([], _, _, _).
 5989element_([I|Is], N0, N, V) :-
 5990        ?(I) #\= ?(V) #==> ?(N) #\= N0,
 5991        N1 is N0 + 1,
 5992        element_(Is, N1, N, V).
 5993
 5994integers_remaining([], _, _, D, D).
 5995integers_remaining([V|Vs], N0, Dom, D0, D) :-
 5996        (   domain_contains(Dom, N0) ->
 5997            element_domain(V, VD),
 5998            domains_union(D0, VD, D1)
 5999        ;   D1 = D0
 6000        ),
 6001        N1 is N0 + 1,
 6002        integers_remaining(Vs, N1, Dom, D1, D).
 6003
 6004%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 6005
 6006%%    global_cardinality(+Vs, +Pairs)
 6007%
 6008%     Global Cardinality constraint. Equivalent to
 6009%     global_cardinality(Vs, Pairs, []). See global_cardinality/3.
 6010%
 6011%     Example:
 6012%
 6013%     ==
 6014%     ?- Vs = [_,_,_], global_cardinality(Vs, [1-2,3-_]), label(Vs).
 6015%     Vs = [1, 1, 3] ;
 6016%     Vs = [1, 3, 1] ;
 6017%     Vs = [3, 1, 1].
 6018%     ==
 6019
 6020global_cardinality(Xs, Pairs) :- global_cardinality(Xs, Pairs, []).
 6021
 6022%%    global_cardinality(+Vs, +Pairs, +Options)
 6023%
 6024%     Global Cardinality constraint. Vs  is  a   list  of  finite domain
 6025%     variables, Pairs is a list  of  Key-Num   pairs,  where  Key is an
 6026%     integer and Num is a finite  domain variable. The constraint holds
 6027%     iff each V in Vs is equal to   some key, and for each Key-Num pair
 6028%     in Pairs, the number of occurrences of   Key in Vs is Num. Options
 6029%     is a list of options. Supported options are:
 6030%
 6031%     * consistency(value)
 6032%     A weaker form of consistency is used.
 6033%
 6034%     * cost(Cost, Matrix)
 6035%     Matrix is a list of rows, one for each variable, in the order
 6036%     they occur in Vs. Each of these rows is a list of integers, one
 6037%     for each key, in the order these keys occur in Pairs. When
 6038%     variable v_i is assigned the value of key k_j, then the
 6039%     associated cost is Matrix_{ij}. Cost is the sum of all costs.
 6040
 6041global_cardinality(Xs, Pairs, Options) :-
 6042        must_be(list(list), [Xs,Pairs,Options]),
 6043        maplist(fd_variable, Xs),
 6044        maplist(gcc_pair, Pairs),
 6045        pairs_keys_values(Pairs, Keys, Nums),
 6046        (   sort(Keys, Keys1), same_length(Keys, Keys1) -> true
 6047        ;   domain_error(gcc_unique_key_pairs, Pairs)
 6048        ),
 6049        length(Xs, L),
 6050        Nums ins 0..L,
 6051        list_to_drep(Keys, Drep),
 6052        Xs ins Drep,
 6053        gcc_pairs(Pairs, Xs, Pairs1),
 6054        % pgcc_check must be installed before triggering other
 6055        % propagators
 6056        propagator_init_trigger(Xs, pgcc_check(Pairs1)),
 6057        propagator_init_trigger(Nums, pgcc_check_single(Pairs1)),
 6058        (   member(OD, Options), OD == consistency(value) -> true
 6059        ;   propagator_init_trigger(Nums, pgcc_single(Xs, Pairs1)),
 6060            propagator_init_trigger(Xs, pgcc(Xs, Pairs, Pairs1))
 6061        ),
 6062        (   member(OC, Options), functor(OC, cost, 2) ->
 6063            OC = cost(Cost, Matrix),
 6064            must_be(list(list(integer)), Matrix),
 6065            maplist(keys_costs(Keys), Xs, Matrix, Costs),
 6066            sum(Costs, #=, Cost)
 6067        ;   true
 6068        ).
 6069
 6070keys_costs(Keys, X, Row, C) :-
 6071        element(N, Keys, X),
 6072        element(N, Row, C).
 6073
 6074gcc_pair(Pair) :-
 6075        (   Pair = Key-Val ->
 6076            must_be(integer, Key),
 6077            fd_variable(Val)
 6078        ;   domain_error(gcc_pair, Pair)
 6079        ).
 6080
 6081/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 6082   For each Key-Num0 pair, we introduce an auxiliary variable Num and
 6083   attach the following attributes to it:
 6084
 6085   clpfd_gcc_num: equal Num0, the user-visible counter variable
 6086   clpfd_gcc_vs: the remaining variables in the constraint that can be
 6087   equal Key.
 6088   clpfd_gcc_occurred: stores how often Key already occurred in vs.
 6089- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 6090
 6091gcc_pairs([], _, []).
 6092gcc_pairs([Key-Num0|KNs], Vs, [Key-Num|Rest]) :-
 6093        put_attr(Num, clpfd_gcc_num, Num0),
 6094        put_attr(Num, clpfd_gcc_vs, Vs),
 6095        put_attr(Num, clpfd_gcc_occurred, 0),
 6096        gcc_pairs(KNs, Vs, Rest).
 6097
 6098/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 6099    J.-C. Régin: "Generalized Arc Consistency for Global Cardinality
 6100    Constraint", AAAI-96 Portland, OR, USA, pp 209--215, 1996
 6101- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 6102
 6103gcc_global(Vs, KNs) :-
 6104        gcc_check(KNs),
 6105        % reach fix-point: all elements of clpfd_gcc_vs must be variables
 6106        do_queue,
 6107        with_local_attributes(Vs, [edges,parent,index],
 6108              (gcc_arcs(KNs, S, Vals),
 6109               variables_with_num_occurrences(Vs, VNs),
 6110               maplist(target_to_v(T), VNs),
 6111               (   get_attr(S, edges, Es) ->
 6112                   put_attr(S, parent, none), % Mark S as seen to avoid going back to S.
 6113                   feasible_flow(Es, S, T), % First construct a feasible flow (if any)
 6114                   maximum_flow(S, T),      % only then, maximize it.
 6115                   gcc_consistent(T),
 6116                   scc(Vals, gcc_successors),
 6117                   phrase(gcc_goals(Vals), Gs)
 6118               ;   Gs = [] )), Gs),
 6119        disable_queue,
 6120        maplist(call, Gs),
 6121        enable_queue.
 6122
 6123gcc_consistent(T) :-
 6124        get_attr(T, edges, Es),
 6125        maplist(saturated_arc, Es).
 6126
 6127saturated_arc(arc_from(_,U,_,Flow)) :- get_attr(Flow, flow, U).
 6128
 6129gcc_goals([]) --> [].
 6130gcc_goals([Val|Vals]) -->
 6131        { get_attr(Val, edges, Es) },
 6132        gcc_edges_goals(Es, Val),
 6133        gcc_goals(Vals).
 6134
 6135gcc_edges_goals([], _) --> [].
 6136gcc_edges_goals([E|Es], Val) -->
 6137        gcc_edge_goal(E, Val),
 6138        gcc_edges_goals(Es, Val).
 6139
 6140gcc_edge_goal(arc_from(_,_,_,_), _) --> [].
 6141gcc_edge_goal(arc_to(_,_,V,F), Val) -->
 6142        (   { get_attr(F, flow, 0),
 6143              get_attr(V, lowlink, L1),
 6144              get_attr(Val, lowlink, L2),
 6145              L1 =\= L2,
 6146              get_attr(Val, value, Value) } ->
 6147            [neq_num(V, Value)]
 6148        ;   []
 6149        ).
 6150
 6151/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 6152   Like in all_distinct/1, first use breadth-first search, then
 6153   construct an augmenting path in reverse.
 6154- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 6155
 6156maximum_flow(S, T) :-
 6157        (   gcc_augmenting_path([[S]], Levels, T) ->
 6158            phrase(augmenting_path(S, T), Path),
 6159            Path = [augment(_,First,_)|Rest],
 6160            path_minimum(Rest, First, Min),
 6161            maplist(gcc_augment(Min), Path),
 6162            maplist(maplist(clear_parent), Levels),
 6163            maximum_flow(S, T)
 6164        ;   true
 6165        ).
 6166
 6167feasible_flow([], _, _).
 6168feasible_flow([A|As], S, T) :-
 6169        make_arc_feasible(A, S, T),
 6170        feasible_flow(As, S, T).
 6171
 6172make_arc_feasible(A, S, T) :-
 6173        A = arc_to(L,_,V,F),
 6174        get_attr(F, flow, Flow),
 6175        (   Flow >= L -> true
 6176        ;   Diff is L - Flow,
 6177            put_attr(V, parent, S-augment(F,Diff,+)),
 6178            gcc_augmenting_path([[V]], Levels, T),
 6179            phrase(augmenting_path(S, T), Path),
 6180            path_minimum(Path, Diff, Min),
 6181            maplist(gcc_augment(Min), Path),
 6182            maplist(maplist(clear_parent), Levels),
 6183            make_arc_feasible(A, S, T)
 6184        ).
 6185
 6186gcc_augmenting_path(Levels0, Levels, T) :-
 6187        Levels0 = [Vs|_],
 6188        Levels1 = [Tos|Levels0],
 6189        phrase(gcc_reachables(Vs), Tos),
 6190        Tos = [_|_],
 6191        (   member(To, Tos), To == T -> Levels = Levels1
 6192        ;   gcc_augmenting_path(Levels1, Levels, T)
 6193        ).
 6194
 6195gcc_reachables([])     --> [].
 6196gcc_reachables([V|Vs]) -->
 6197        { get_attr(V, edges, Es) },
 6198        gcc_reachables_(Es, V),
 6199        gcc_reachables(Vs).
 6200
 6201gcc_reachables_([], _)     --> [].
 6202gcc_reachables_([E|Es], V) -->
 6203        gcc_reachable(E, V),
 6204        gcc_reachables_(Es, V).
 6205
 6206gcc_reachable(arc_from(_,_,V,F), P) -->
 6207        (   { \+ get_attr(V, parent, _),
 6208              get_attr(F, flow, Flow),
 6209              Flow > 0 } ->
 6210            { put_attr(V, parent, P-augment(F,Flow,-)) },
 6211            [V]
 6212        ;   []
 6213        ).
 6214gcc_reachable(arc_to(_L,U,V,F), P) -->
 6215        (   { \+ get_attr(V, parent, _),
 6216              get_attr(F, flow, Flow),
 6217              Flow < U } ->
 6218            { Diff is U - Flow,
 6219              put_attr(V, parent, P-augment(F,Diff,+)) },
 6220            [V]
 6221        ;   []
 6222        ).
 6223
 6224
 6225path_minimum([], Min, Min).
 6226path_minimum([augment(_,A,_)|As], Min0, Min) :-
 6227        Min1 is min(Min0,A),
 6228        path_minimum(As, Min1, Min).
 6229
 6230gcc_augment(Min, augment(F,_,Sign)) :-
 6231        get_attr(F, flow, Flow0),
 6232        gcc_flow_(Sign, Flow0, Min, Flow),
 6233        put_attr(F, flow, Flow).
 6234
 6235gcc_flow_(+, F0, A, F) :- F is F0 + A.
 6236gcc_flow_(-, F0, A, F) :- F is F0 - A.
 6237
 6238/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 6239   Build value network for global cardinality constraint.
 6240- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 6241
 6242gcc_arcs([], _, []).
 6243gcc_arcs([Key-Num0|KNs], S, Vals) :-
 6244        (   get_attr(Num0, clpfd_gcc_vs, Vs) ->
 6245            get_attr(Num0, clpfd_gcc_num, Num),
 6246            get_attr(Num0, clpfd_gcc_occurred, Occ),
 6247            (   nonvar(Num) -> U is Num - Occ, U = L
 6248            ;   fd_get(Num, _, n(L0), n(U0), _),
 6249                L is L0 - Occ, U is U0 - Occ
 6250            ),
 6251            put_attr(Val, value, Key),
 6252            Vals = [Val|Rest],
 6253            put_attr(F, flow, 0),
 6254            append_edge(S, edges, arc_to(L, U, Val, F)),
 6255            put_attr(Val, edges, [arc_from(L, U, S, F)]),
 6256            variables_with_num_occurrences(Vs, VNs),
 6257            maplist(val_to_v(Val), VNs)
 6258        ;   Vals = Rest
 6259        ),
 6260        gcc_arcs(KNs, S, Rest).
 6261
 6262variables_with_num_occurrences(Vs0, VNs) :-
 6263        include(var, Vs0, Vs1),
 6264        msort(Vs1, Vs),
 6265        (   Vs == [] -> VNs = []
 6266        ;   Vs = [V|Rest],
 6267            variables_with_num_occurrences(Rest, V, 1, VNs)
 6268        ).
 6269
 6270variables_with_num_occurrences([], Prev, Count, [Prev-Count]).
 6271variables_with_num_occurrences([V|Vs], Prev, Count0, VNs) :-
 6272        (   V == Prev ->
 6273            Count1 is Count0 + 1,
 6274            variables_with_num_occurrences(Vs, Prev, Count1, VNs)
 6275        ;   VNs = [Prev-Count0|Rest],
 6276            variables_with_num_occurrences(Vs, V, 1, Rest)
 6277        ).
 6278
 6279
 6280target_to_v(T, V-Count) :-
 6281        put_attr(F, flow, 0),
 6282        append_edge(V, edges, arc_to(0, Count, T, F)),
 6283        append_edge(T, edges, arc_from(0, Count, V, F)).
 6284
 6285val_to_v(Val, V-Count) :-
 6286        put_attr(F, flow, 0),
 6287        append_edge(V, edges, arc_from(0, Count, Val, F)),
 6288        append_edge(Val, edges, arc_to(0, Count, V, F)).
 6289
 6290
 6291gcc_successors(V, Tos) :-
 6292        get_attr(V, edges, Tos0),
 6293        phrase(gcc_successors_(Tos0), Tos).
 6294
 6295gcc_successors_([])     --> [].
 6296gcc_successors_([E|Es]) --> gcc_succ_edge(E), gcc_successors_(Es).
 6297
 6298gcc_succ_edge(arc_to(_,U,V,F)) -->
 6299        (   { get_attr(F, flow, Flow),
 6300              Flow < U } -> [V]
 6301        ;   []
 6302        ).
 6303gcc_succ_edge(arc_from(_,_,V,F)) -->
 6304        (   { get_attr(F, flow, Flow),
 6305              Flow > 0 } -> [V]
 6306        ;   []
 6307        ).
 6308
 6309/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 6310   Simple consistency check, run before global propagation.
 6311   Importantly, it removes all ground values from clpfd_gcc_vs.
 6312
 6313   The pgcc_check/1 propagator in itself suffices to ensure
 6314   consistency.
 6315- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 6316
 6317gcc_check(Pairs) :-
 6318        disable_queue,
 6319        gcc_check_(Pairs),
 6320        enable_queue.
 6321
 6322gcc_done(Num) :-
 6323        del_attr(Num, clpfd_gcc_vs),
 6324        del_attr(Num, clpfd_gcc_num),
 6325        del_attr(Num, clpfd_gcc_occurred).
 6326
 6327gcc_check_([]).
 6328gcc_check_([Key-Num0|KNs]) :-
 6329        (   get_attr(Num0, clpfd_gcc_vs, Vs) ->
 6330            get_attr(Num0, clpfd_gcc_num, Num),
 6331            get_attr(Num0, clpfd_gcc_occurred, Occ0),
 6332            vs_key_min_others(Vs, Key, 0, Min, Os),
 6333            put_attr(Num0, clpfd_gcc_vs, Os),
 6334            put_attr(Num0, clpfd_gcc_occurred, Occ1),
 6335            Occ1 is Occ0 + Min,
 6336            geq(Num, Occ1),
 6337            % The queue is disabled for efficiency here in any case.
 6338            % If it were enabled, make sure to retain the invariant
 6339            % that gcc_global is never triggered during an
 6340            % inconsistent state (after gcc_done/1 but before all
 6341            % relevant constraints are posted).
 6342            (   Occ1 == Num -> all_neq(Os, Key), gcc_done(Num0)
 6343            ;   Os == [] -> gcc_done(Num0), Num = Occ1
 6344            ;   length(Os, L),
 6345                Max is Occ1 + L,
 6346                geq(Max, Num),
 6347                (   nonvar(Num) -> Diff is Num - Occ1
 6348                ;   fd_get(Num, ND, _),
 6349                    domain_infimum(ND, n(NInf)),
 6350                    Diff is NInf - Occ1
 6351                ),
 6352                L >= Diff,
 6353                (   L =:= Diff ->
 6354                    Num is Occ1 + Diff,
 6355                    maplist(=(Key), Os),
 6356                    gcc_done(Num0)
 6357                ;   true
 6358                )
 6359            )
 6360        ;   true
 6361        ),
 6362        gcc_check_(KNs).
 6363
 6364vs_key_min_others([], _, Min, Min, []).
 6365vs_key_min_others([V|Vs], Key, Min0, Min, Others) :-
 6366        (   fd_get(V, VD, _) ->
 6367            (   domain_contains(VD, Key) ->
 6368                Others = [V|Rest],
 6369                vs_key_min_others(Vs, Key, Min0, Min, Rest)
 6370            ;   vs_key_min_others(Vs, Key, Min0, Min, Others)
 6371            )
 6372        ;   (   V =:= Key ->
 6373                Min1 is Min0 + 1,
 6374                vs_key_min_others(Vs, Key, Min1, Min, Others)
 6375            ;   vs_key_min_others(Vs, Key, Min0, Min, Others)
 6376            )
 6377        ).
 6378
 6379all_neq([], _).
 6380all_neq([X|Xs], C) :-
 6381        neq_num(X, C),
 6382        all_neq(Xs, C).
 6383
 6384%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 6385
 6386%%    circuit(+Vs)
 6387%
 6388%     True iff the list Vs of finite domain variables induces a
 6389%     Hamiltonian circuit. The k-th element of Vs denotes the
 6390%     successor of node k. Node indexing starts with 1. Examples:
 6391%
 6392%     ==
 6393%     ?- length(Vs, _), circuit(Vs), label(Vs).
 6394%     Vs = [] ;
 6395%     Vs = [1] ;
 6396%     Vs = [2, 1] ;
 6397%     Vs = [2, 3, 1] ;
 6398%     Vs = [3, 1, 2] ;
 6399%     Vs = [2, 3, 4, 1] .
 6400%     ==
 6401
 6402circuit(Vs) :-
 6403        must_be(list, Vs),
 6404        maplist(fd_variable, Vs),
 6405        length(Vs, L),
 6406        Vs ins 1..L,
 6407        (   L =:= 1 -> true
 6408        ;   neq_index(Vs, 1),
 6409            make_propagator(pcircuit(Vs), Prop),
 6410            distinct_attach(Vs, Prop, []),
 6411            trigger_once(Prop)
 6412        ).
 6413
 6414neq_index([], _).
 6415neq_index([X|Xs], N) :-
 6416        neq_num(X, N),
 6417        N1 is N + 1,
 6418        neq_index(Xs, N1).
 6419
 6420/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 6421   Necessary condition for existence of a Hamiltonian circuit: The
 6422   graph has a single strongly connected component. If the list is
 6423   ground, the condition is also sufficient.
 6424
 6425   Ts are used as temporary variables to attach attributes:
 6426
 6427   lowlink, index: used for SCC
 6428   [arc_to(V)]: possible successors
 6429- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 6430
 6431propagate_circuit(Vs) :-
 6432        with_local_attributes([], [],
 6433            (same_length(Vs, Ts),
 6434             circuit_graph(Vs, Ts, Ts),
 6435             scc(Ts, circuit_successors),
 6436             maplist(single_component, Ts)), _).
 6437
 6438single_component(V) :- get_attr(V, lowlink, 0).
 6439
 6440circuit_graph([], _, _).
 6441circuit_graph([V|Vs], Ts0, [T|Ts]) :-
 6442        (   nonvar(V) -> Ns = [V]
 6443        ;   fd_get(V, Dom, _),
 6444            domain_to_list(Dom, Ns)
 6445        ),
 6446        phrase(circuit_edges(Ns, Ts0), Es),
 6447        put_attr(T, edges, Es),
 6448        circuit_graph(Vs, Ts0, Ts).
 6449
 6450circuit_edges([], _) --> [].
 6451circuit_edges([N|Ns], Ts) -->
 6452        { nth1(N, Ts, T) },
 6453        [arc_to(T)],
 6454        circuit_edges(Ns, Ts).
 6455
 6456circuit_successors(V, Tos) :-
 6457        get_attr(V, edges, Tos0),
 6458        maplist(arg(1), Tos0, Tos).
 6459
 6460%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 6461
 6462%% cumulative(+Tasks)
 6463%
 6464%  Equivalent to cumulative(Tasks, [limit(1)]). See cumulative/2.
 6465
 6466cumulative(Tasks) :- cumulative(Tasks, [limit(1)]).
 6467
 6468%% cumulative(+Tasks, +Options)
 6469%
 6470%  Schedule with a limited resource. Tasks is a list of tasks, each of
 6471%  the form task(S_i, D_i, E_i, C_i, T_i). S_i denotes the start time,
 6472%  D_i the positive duration, E_i the end time, C_i the non-negative
 6473%  resource consumption, and T_i the task identifier. Each of these
 6474%  arguments must be a finite domain variable with bounded domain, or
 6475%  an integer. The constraint holds iff at each time slot during the
 6476%  start and end of each task, the total resource consumption of all
 6477%  tasks running at that time does not exceed the global resource
 6478%  limit. Options is a list of options. Currently, the only supported
 6479%  option is:
 6480%
 6481%    * limit(L)
 6482%      The integer L is the global resource limit. Default is 1.
 6483%
 6484%  For example, given the following predicate that relates three tasks
 6485%  of durations 2 and 3 to a list containing their starting times:
 6486%
 6487%  ==
 6488%  tasks_starts(Tasks, [S1,S2,S3]) :-
 6489%          Tasks = [task(S1,3,_,1,_),
 6490%                   task(S2,2,_,1,_),
 6491%                   task(S3,2,_,1,_)].
 6492%  ==
 6493%
 6494%  We can use cumulative/2 as follows, and obtain a schedule:
 6495%
 6496%  ==
 6497%  ?- tasks_starts(Tasks, Starts), Starts ins 0..10,
 6498%     cumulative(Tasks, [limit(2)]), label(Starts).
 6499%  Tasks = [task(0, 3, 3, 1, _G36), task(0, 2, 2, 1, _G45), ...],
 6500%  Starts = [0, 0, 2] .
 6501%  ==
 6502
 6503cumulative(Tasks, Options) :-
 6504        must_be(list(list), [Tasks,Options]),
 6505        (   Options = [] -> L = 1
 6506        ;   Options = [limit(L)] -> must_be(integer, L)
 6507        ;   domain_error(cumulative_options_empty_or_limit, Options)
 6508        ),
 6509        (   Tasks = [] -> true
 6510        ;   fully_elastic_relaxation(Tasks, L),
 6511            maplist(task_bs, Tasks, Bss),
 6512            maplist(arg(1), Tasks, Starts),
 6513            maplist(fd_inf, Starts, MinStarts),
 6514            maplist(arg(3), Tasks, Ends),
 6515            maplist(fd_sup, Ends, MaxEnds),
 6516            min_list(MinStarts, Start),
 6517            max_list(MaxEnds, End),
 6518            resource_limit(Start, End, Tasks, Bss, L)
 6519        ).
 6520
 6521/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 6522   Trivial lower and upper bounds, assuming no gaps and not necessarily
 6523   retaining the rectangular shape of each task.
 6524- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 6525
 6526fully_elastic_relaxation(Tasks, Limit) :-
 6527        maplist(task_duration_consumption, Tasks, Ds, Cs),
 6528        maplist(area, Ds, Cs, As),
 6529        sum(As, #=, ?(Area)),
 6530        ?(MinTime) #= (Area + Limit - 1) // Limit,
 6531        tasks_minstart_maxend(Tasks, MinStart, MaxEnd),
 6532        MaxEnd #>= MinStart + MinTime.
 6533
 6534task_duration_consumption(task(_,D,_,C,_), D, C).
 6535
 6536area(X, Y, Area) :- ?(Area) #= ?(X) * ?(Y).
 6537
 6538tasks_minstart_maxend(Tasks, Start, End) :-
 6539        maplist(task_start_end, Tasks, [Start0|Starts], [End0|Ends]),
 6540        foldl(min_, Starts, Start0, Start),
 6541        foldl(max_, Ends, End0, End).
 6542
 6543max_(E, M0, M) :- ?(M) #= max(E, M0).
 6544
 6545min_(E, M0, M) :- ?(M) #= min(E, M0).
 6546
 6547task_start_end(task(Start,_,End,_,_), ?(Start), ?(End)).
 6548
 6549/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 6550   All time slots must respect the resource limit.
 6551- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 6552
 6553resource_limit(T, T, _, _, _) :- !.
 6554resource_limit(T0, T, Tasks, Bss, L) :-
 6555        maplist(contribution_at(T0), Tasks, Bss, Cs),
 6556        sum(Cs, #=<, L),
 6557        T1 is T0 + 1,
 6558        resource_limit(T1, T, Tasks, Bss, L).
 6559
 6560task_bs(Task, InfStart-Bs) :-
 6561        Task = task(Start,D,End,_,_Id),
 6562        ?(D) #> 0,
 6563        ?(End) #= ?(Start) + ?(D),
 6564        maplist(must_be_finite_fdvar, [End,Start,D]),
 6565        fd_inf(Start, InfStart),
 6566        fd_sup(End, SupEnd),
 6567        L is SupEnd - InfStart,
 6568        length(Bs, L),
 6569        task_running(Bs, Start, End, InfStart).
 6570
 6571task_running([], _, _, _).
 6572task_running([B|Bs], Start, End, T) :-
 6573        ((T #>= Start) #/\ (T #< End)) #<==> ?(B),
 6574        T1 is T + 1,
 6575        task_running(Bs, Start, End, T1).
 6576
 6577contribution_at(T, Task, Offset-Bs, Contribution) :-
 6578        Task = task(Start,_,End,C,_),
 6579        ?(C) #>= 0,
 6580        fd_inf(Start, InfStart),
 6581        fd_sup(End, SupEnd),
 6582        (   T < InfStart -> Contribution = 0
 6583        ;   T >= SupEnd -> Contribution = 0
 6584        ;   Index is T - Offset,
 6585            nth0(Index, Bs, B),
 6586            ?(Contribution) #= B*C
 6587        ).
 6588
 6589%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 6590
 6591%% disjoint2(+Rectangles)
 6592%
 6593%  True iff Rectangles are not overlapping. Rectangles is a list of
 6594%  terms of the form F(X_i, W_i, Y_i, H_i), where F is any functor,
 6595%  and the arguments are finite domain variables or integers that
 6596%  denote, respectively, the X coordinate, width, Y coordinate and
 6597%  height of each rectangle.
 6598
 6599disjoint2(Rs0) :-
 6600        must_be(list, Rs0),
 6601        maplist(=.., Rs0, Rs),
 6602        non_overlapping(Rs).
 6603
 6604non_overlapping([]).
 6605non_overlapping([R|Rs]) :-
 6606        maplist(non_overlapping_(R), Rs),
 6607        non_overlapping(Rs).
 6608
 6609non_overlapping_(A, B) :-
 6610        a_not_in_b(A, B),
 6611        a_not_in_b(B, A).
 6612
 6613a_not_in_b([_,AX,AW,AY,AH], [_,BX,BW,BY,BH]) :-
 6614        ?(AX) #=< ?(BX) #/\ ?(BX) #< ?(AX) + ?(AW) #==>
 6615                   ?(AY) + ?(AH) #=< ?(BY) #\/ ?(BY) + ?(BH) #=< ?(AY),
 6616        ?(AY) #=< ?(BY) #/\ ?(BY) #< ?(AY) + ?(AH) #==>
 6617                   ?(AX) + ?(AW) #=< ?(BX) #\/ ?(BX) + ?(BW) #=< ?(AX).
 6618
 6619%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 6620
 6621%% automaton(+Vs, +Nodes, +Arcs)
 6622%
 6623%  Describes a list of finite domain variables with a finite
 6624%  automaton. Equivalent to automaton(Vs, _, Vs, Nodes, Arcs,
 6625%  [], [], _), a common use case of automaton/8. In the following
 6626%  example, a list of binary finite domain variables is constrained to
 6627%  contain at least two consecutive ones:
 6628%
 6629%  ==
 6630%  two_consecutive_ones(Vs) :-
 6631%          automaton(Vs, [source(a),sink(c)],
 6632%                    [arc(a,0,a), arc(a,1,b),
 6633%                     arc(b,0,a), arc(b,1,c),
 6634%                     arc(c,0,c), arc(c,1,c)]).
 6635%  ==
 6636%
 6637%  Example query:
 6638%
 6639%  ==
 6640%  ?- length(Vs, 3), two_consecutive_ones(Vs), label(Vs).
 6641%  Vs = [0, 1, 1] ;
 6642%  Vs = [1, 1, 0] ;
 6643%  Vs = [1, 1, 1].
 6644%  ==
 6645
 6646automaton(Sigs, Ns, As) :- automaton(_, _, Sigs, Ns, As, [], [], _).
 6647
 6648
 6649%% automaton(+Sequence, ?Template, +Signature, +Nodes, +Arcs, +Counters, +Initials, ?Finals)
 6650%
 6651%  Describes a list of finite domain variables with a finite
 6652%  automaton. True iff the finite automaton induced by Nodes and Arcs
 6653%  (extended with Counters) accepts Signature. Sequence is a list of
 6654%  terms, all of the same shape. Additional constraints must link
 6655%  Sequence to Signature, if necessary. Nodes is a list of
 6656%  source(Node) and sink(Node) terms. Arcs is a list of
 6657%  arc(Node,Integer,Node) and arc(Node,Integer,Node,Exprs) terms that
 6658%  denote the automaton's transitions. Each node is represented by an
 6659%  arbitrary term. Transitions that are not mentioned go to an
 6660%  implicit failure node. `Exprs` is a list of arithmetic expressions,
 6661%  of the same length as Counters. In each expression, variables
 6662%  occurring in Counters symbolically refer to previous counter
 6663%  values, and variables occurring in Template refer to the current
 6664%  element of Sequence. When a transition containing arithmetic
 6665%  expressions is taken, each counter is updated according to the
 6666%  result of the corresponding expression. When a transition without
 6667%  arithmetic expressions is taken, all counters remain unchanged.
 6668%  Counters is a list of variables. Initials is a list of finite
 6669%  domain variables or integers denoting, in the same order, the
 6670%  initial value of each counter. These values are related to Finals
 6671%  according to the arithmetic expressions of the taken transitions.
 6672%
 6673%  The following example is taken from Beldiceanu, Carlsson, Debruyne
 6674%  and Petit: "Reformulation of Global Constraints Based on
 6675%  Constraints Checkers", Constraints 10(4), pp 339-362 (2005). It
 6676%  relates a sequence of integers and finite domain variables to its
 6677%  number of inflexions, which are switches between strictly ascending
 6678%  and strictly descending subsequences:
 6679%
 6680%  ==
 6681%  sequence_inflexions(Vs, N) :-
 6682%          variables_signature(Vs, Sigs),
 6683%          automaton(Sigs, _, Sigs,
 6684%                    [source(s),sink(i),sink(j),sink(s)],
 6685%                    [arc(s,0,s), arc(s,1,j), arc(s,2,i),
 6686%                     arc(i,0,i), arc(i,1,j,[C+1]), arc(i,2,i),
 6687%                     arc(j,0,j), arc(j,1,j),
 6688%                     arc(j,2,i,[C+1])],
 6689%                    [C], [0], [N]).
 6690%
 6691%  variables_signature([], []).
 6692%  variables_signature([V|Vs], Sigs) :-
 6693%          variables_signature_(Vs, V, Sigs).
 6694%
 6695%  variables_signature_([], _, []).
 6696%  variables_signature_([V|Vs], Prev, [S|Sigs]) :-
 6697%          V #= Prev #<==> S #= 0,
 6698%          Prev #< V #<==> S #= 1,
 6699%          Prev #> V #<==> S #= 2,
 6700%          variables_signature_(Vs, V, Sigs).
 6701%  ==
 6702%
 6703%  Example queries:
 6704%
 6705%  ==
 6706%  ?- sequence_inflexions([1,2,3,3,2,1,3,0], N).
 6707%  N = 3.
 6708%
 6709%  ?- length(Ls, 5), Ls ins 0..1,
 6710%     sequence_inflexions(Ls, 3), label(Ls).
 6711%  Ls = [0, 1, 0, 1, 0] ;
 6712%  Ls = [1, 0, 1, 0, 1].
 6713%  ==
 6714
 6715template_var_path(V, Var, []) :- var(V), !, V == Var.
 6716template_var_path(T, Var, [N|Ns]) :-
 6717        arg(N, T, Arg),
 6718        template_var_path(Arg, Var, Ns).
 6719
 6720path_term_variable([], V, V).
 6721path_term_variable([P|Ps], T, V) :-
 6722        arg(P, T, Arg),
 6723        path_term_variable(Ps, Arg, V).
 6724
 6725initial_expr(_, []-1).
 6726
 6727automaton(Seqs, Template, Sigs, Ns, As0, Cs, Is, Fs) :-
 6728        must_be(list(list), [Sigs,Ns,As0,Cs,Is]),
 6729        (   var(Seqs) ->
 6730            (   current_prolog_flag(clpfd_monotonic, true) ->
 6731                instantiation_error(Seqs)
 6732            ;   Seqs = Sigs
 6733            )
 6734        ;   must_be(list, Seqs)
 6735        ),
 6736        maplist(monotonic, Cs, CsM),
 6737        maplist(arc_normalized(CsM), As0, As),
 6738        include_args1(sink, Ns, Sinks),
 6739        include_args1(source, Ns, Sources),
 6740        maplist(initial_expr, Cs, Exprs0),
 6741        phrase((arcs_relation(As, Relation),
 6742                nodes_nums(Sinks, SinkNums0),
 6743                nodes_nums(Sources, SourceNums0)),
 6744               [s([]-0, Exprs0)], [s(_,Exprs1)]),
 6745        maplist(expr0_expr, Exprs1, Exprs),
 6746        phrase(transitions(Seqs, Template, Sigs, Start, End, Exprs, Cs, Is, Fs), Tuples),
 6747        list_to_drep(SourceNums0, SourceDrep),
 6748        Start in SourceDrep,
 6749        list_to_drep(SinkNums0, SinkDrep),
 6750        End in SinkDrep,
 6751        tuples_in(Tuples, Relation).
 6752
 6753expr0_expr(Es0-_, Es) :-
 6754        pairs_keys(Es0, Es1),
 6755        reverse(Es1, Es).
 6756
 6757transitions([], _, [], S, S, _, _, Cs, Cs) --> [].
 6758transitions([Seq|Seqs], Template, [Sig|Sigs], S0, S, Exprs, Counters, Cs0, Cs) -->
 6759        [[S0,Sig,S1|Is]],
 6760        { phrase(exprs_next(Exprs, Is, Cs1), [s(Seq,Template,Counters,Cs0)], _) },
 6761        transitions(Seqs, Template, Sigs, S1, S, Exprs, Counters, Cs1, Cs).
 6762
 6763exprs_next([], [], []) --> [].
 6764exprs_next([Es|Ess], [I|Is], [C|Cs]) -->
 6765        exprs_values(Es, Vs),
 6766        { element(I, Vs, C) },
 6767        exprs_next(Ess, Is, Cs).
 6768
 6769exprs_values([], []) --> [].
 6770exprs_values([E0|Es], [V|Vs]) -->
 6771        { term_variables(E0, EVs0),
 6772          copy_term(E0, E),
 6773          term_variables(E, EVs),
 6774          ?(V) #= E },
 6775        match_variables(EVs0, EVs),
 6776        exprs_values(Es, Vs).
 6777
 6778match_variables([], _) --> [].
 6779match_variables([V0|Vs0], [V|Vs]) -->
 6780        state(s(Seq,Template,Counters,Cs0)),
 6781        { (   template_var_path(Template, V0, Ps) ->
 6782              path_term_variable(Ps, Seq, V)
 6783          ;   template_var_path(Counters, V0, Ps) ->
 6784              path_term_variable(Ps, Cs0, V)
 6785          ;   domain_error(variable_from_template_or_counters, V0)
 6786          ) },
 6787        match_variables(Vs0, Vs).
 6788
 6789nodes_nums([], []) --> [].
 6790nodes_nums([Node|Nodes], [Num|Nums]) -->
 6791        node_num(Node, Num),
 6792        nodes_nums(Nodes, Nums).
 6793
 6794arcs_relation([], []) --> [].
 6795arcs_relation([arc(S0,L,S1,Es)|As], [[From,L,To|Ns]|Rs]) -->
 6796        node_num(S0, From),
 6797        node_num(S1, To),
 6798        state(s(Nodes, Exprs0), s(Nodes, Exprs)),
 6799        { exprs_nums(Es, Ns, Exprs0, Exprs) },
 6800        arcs_relation(As, Rs).
 6801
 6802exprs_nums([], [], [], []).
 6803exprs_nums([E|Es], [N|Ns], [Ex0-C0|Exs0], [Ex-C|Exs]) :-
 6804        (   member(Exp-N, Ex0), Exp == E -> C = C0, Ex = Ex0
 6805        ;   N = C0, C is C0 + 1, Ex = [E-C0|Ex0]
 6806        ),
 6807        exprs_nums(Es, Ns, Exs0, Exs).
 6808
 6809node_num(Node, Num) -->
 6810        state(s(Nodes0-C0, Exprs), s(Nodes-C, Exprs)),
 6811        { (   member(N-Num, Nodes0), N == Node -> C = C0, Nodes = Nodes0
 6812          ;   Num = C0, C is C0 + 1, Nodes = [Node-C0|Nodes0]
 6813          )
 6814        }.
 6815
 6816include_args1(Goal, Ls0, As) :-
 6817        include(Goal, Ls0, Ls),
 6818        maplist(arg(1), Ls, As).
 6819
 6820source(source(_)).
 6821
 6822sink(sink(_)).
 6823
 6824monotonic(Var, ?(Var)).
 6825
 6826arc_normalized(Cs, Arc0, Arc) :- arc_normalized_(Arc0, Cs, Arc).
 6827
 6828arc_normalized_(arc(S0,L,S,Cs), _, arc(S0,L,S,Cs)).
 6829arc_normalized_(arc(S0,L,S), Cs, arc(S0,L,S,Cs)).
 6830
 6831%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 6832
 6833%% transpose(+Matrix, ?Transpose)
 6834%
 6835%  Transpose a list of lists of the same length. Example:
 6836%
 6837%  ==
 6838%  ?- transpose([[1,2,3],[4,5,6],[7,8,9]], Ts).
 6839%  Ts = [[1, 4, 7], [2, 5, 8], [3, 6, 9]].
 6840%  ==
 6841%
 6842%  This predicate is useful in many constraint programs. Consider for
 6843%  instance Sudoku:
 6844%
 6845%  ==
 6846%  sudoku(Rows) :-
 6847%          length(Rows, 9), maplist(same_length(Rows), Rows),
 6848%          append(Rows, Vs), Vs ins 1..9,
 6849%          maplist(all_distinct, Rows),
 6850%          transpose(Rows, Columns),
 6851%          maplist(all_distinct, Columns),
 6852%          Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
 6853%          blocks(As, Bs, Cs), blocks(Ds, Es, Fs), blocks(Gs, Hs, Is).
 6854%
 6855%  blocks([], [], []).
 6856%  blocks([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
 6857%          all_distinct([N1,N2,N3,N4,N5,N6,N7,N8,N9]),
 6858%          blocks(Ns1, Ns2, Ns3).
 6859%
 6860%  problem(1, [[_,_,_,_,_,_,_,_,_],
 6861%              [_,_,_,_,_,3,_,8,5],
 6862%              [_,_,1,_,2,_,_,_,_],
 6863%              [_,_,_,5,_,7,_,_,_],
 6864%              [_,_,4,_,_,_,1,_,_],
 6865%              [_,9,_,_,_,_,_,_,_],
 6866%              [5,_,_,_,_,_,_,7,3],
 6867%              [_,_,2,_,1,_,_,_,_],
 6868%              [_,_,_,_,4,_,_,_,9]]).
 6869%  ==
 6870%
 6871%  Sample query:
 6872%
 6873%  ==
 6874%  ?- problem(1, Rows), sudoku(Rows), maplist(portray_clause, Rows).
 6875%  [9, 8, 7, 6, 5, 4, 3, 2, 1].
 6876%  [2, 4, 6, 1, 7, 3, 9, 8, 5].
 6877%  [3, 5, 1, 9, 2, 8, 7, 4, 6].
 6878%  [1, 2, 8, 5, 3, 7, 6, 9, 4].
 6879%  [6, 3, 4, 8, 9, 2, 1, 5, 7].
 6880%  [7, 9, 5, 4, 6, 1, 8, 3, 2].
 6881%  [5, 1, 9, 2, 8, 6, 4, 7, 3].
 6882%  [4, 7, 2, 3, 1, 9, 5, 6, 8].
 6883%  [8, 6, 3, 7, 4, 5, 2, 1, 9].
 6884%  Rows = [[9, 8, 7, 6, 5, 4, 3, 2|...], ... , [...|...]].
 6885%  ==
 6886
 6887transpose(Ls, Ts) :-
 6888        must_be(list(list), Ls),
 6889        lists_transpose(Ls, Ts).
 6890
 6891lists_transpose([], []).
 6892lists_transpose([L|Ls], Ts) :-
 6893        maplist(same_length(L), Ls),
 6894        foldl(transpose_, L, Ts, [L|Ls], _).
 6895
 6896transpose_(_, Fs, Lists0, Lists) :-
 6897        maplist(list_first_rest, Lists0, Fs, Lists).
 6898
 6899list_first_rest([L|Ls], L, Ls).
 6900
 6901%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 6902
 6903%% zcompare(?Order, ?A, ?B)
 6904%
 6905% Analogous to compare/3, with finite domain variables A and B.
 6906%
 6907% Think of zcompare/3 as _reifying_ an arithmetic comparison of two
 6908% integers. This means that we can explicitly reason about the
 6909% different cases _within_ our programs. As in compare/3, the atoms
 6910% =|<|=, =|>|= and =|=|= denote the different cases of the
 6911% trichotomy. In contrast to compare/3 though, zcompare/3 works
 6912% correctly for _all modes_, also if only a subset of the arguments is
 6913% instantiated. This allows you to make several predicates over
 6914% integers deterministic while preserving their generality and
 6915% completeness.  For example:
 6916%
 6917% ==
 6918% n_factorial(N, F) :-
 6919%         zcompare(C, N, 0),
 6920%         n_factorial_(C, N, F).
 6921%
 6922% n_factorial_(=, _, 1).
 6923% n_factorial_(>, N, F) :-
 6924%         F #= F0*N,
 6925%         N1 #= N - 1,
 6926%         n_factorial(N1, F0).
 6927% ==
 6928%
 6929% This version of n_factorial/2 is deterministic if the first argument
 6930% is instantiated, because argument indexing can distinguish the
 6931% different clauses that reflect the possible and admissible outcomes
 6932% of a comparison of `N` against 0. Example:
 6933%
 6934% ==
 6935% ?- n_factorial(30, F).
 6936% F = 265252859812191058636308480000000.
 6937% ==
 6938%
 6939% Since there is no clause for =|<|=, the predicate automatically
 6940% _fails_ if `N` is less than 0. The predicate can still be used in
 6941% all directions, including the most general query:
 6942%
 6943% ==
 6944% ?- n_factorial(N, F).
 6945% N = 0,
 6946% F = 1 ;
 6947% N = F, F = 1 ;
 6948% N = F, F = 2 .
 6949% ==
 6950%
 6951% In this case, all clauses are tried on backtracking, and zcompare/3
 6952% ensures that the respective ordering between N and 0 holds in each
 6953% case.
 6954%
 6955% The truth value of a comparison can also be reified with (#<==>)/2
 6956% in combination with one of the [_arithmetic
 6957% constraints_](<#clpfd-arith-constraints>). See
 6958% [reification](<#clpfd-reification>). However, zcompare/3 lets you
 6959% more conveniently distinguish the cases.
 6960
 6961zcompare(Order, A, B) :-
 6962        (   nonvar(Order) ->
 6963            zcompare_(Order, A, B)
 6964        ;   integer(A), integer(B) ->
 6965            compare(Order, A, B)
 6966        ;   freeze(Order, zcompare_(Order, A, B)),
 6967            fd_variable(A),
 6968            fd_variable(B),
 6969            propagator_init_trigger([A,B], pzcompare(Order, A, B))
 6970        ).
 6971
 6972zcompare_(=, A, B) :- ?(A) #= ?(B).
 6973zcompare_(<, A, B) :- ?(A) #< ?(B).
 6974zcompare_(>, A, B) :- ?(A) #> ?(B).
 6975
 6976%% chain(+Zs, +Relation)
 6977%
 6978% Zs form a chain with respect to Relation. Zs is a list of finite
 6979% domain variables that are a chain with respect to the partial order
 6980% Relation, in the order they appear in the list. Relation must be #=,
 6981% #=<, #>=, #< or #>. For example:
 6982%
 6983% ==
 6984% ?- chain([X,Y,Z], #>=).
 6985% X#>=Y,
 6986% Y#>=Z.
 6987% ==
 6988
 6989chain(Zs, Relation) :-
 6990        must_be(list, Zs),
 6991        maplist(fd_variable, Zs),
 6992        must_be(ground, Relation),
 6993        (   chain_relation(Relation) -> true
 6994        ;   domain_error(chain_relation, Relation)
 6995        ),
 6996        chain_(Zs, Relation).
 6997
 6998chain_([], _).
 6999chain_([X|Xs], Relation) :- foldl(chain(Relation), Xs, X, _).
 7000
 7001chain_relation(#=).
 7002chain_relation(#<).
 7003chain_relation(#=<).
 7004chain_relation(#>).
 7005chain_relation(#>=).
 7006
 7007chain(Relation, X, Prev, X) :- call(Relation, ?(Prev), ?(X)).
 7008
 7009%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 7010/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 7011   Reflection predicates
 7012- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 7013
 7014%% fd_var(+Var)
 7015%
 7016%  True iff Var is a CLP(FD) variable.
 7017
 7018fd_var(X) :- get_attr(X, clpfd, _).
 7019
 7020%% fd_inf(+Var, -Inf)
 7021%
 7022%  Inf is the infimum of the current domain of Var.
 7023
 7024fd_inf(X, Inf) :-
 7025        (   fd_get(X, XD, _) ->
 7026            domain_infimum(XD, Inf0),
 7027            bound_portray(Inf0, Inf)
 7028        ;   must_be(integer, X),
 7029            Inf = X
 7030        ).
 7031
 7032%% fd_sup(+Var, -Sup)
 7033%
 7034%  Sup is the supremum of the current domain of Var.
 7035
 7036fd_sup(X, Sup) :-
 7037        (   fd_get(X, XD, _) ->
 7038            domain_supremum(XD, Sup0),
 7039            bound_portray(Sup0, Sup)
 7040        ;   must_be(integer, X),
 7041            Sup = X
 7042        ).
 7043
 7044%% fd_size(+Var, -Size)
 7045%
 7046%  Reflect the current size of a domain. Size is the number of
 7047%  elements of the current domain of Var, or the atom *sup* if the
 7048%  domain is unbounded.
 7049
 7050fd_size(X, S) :-
 7051        (   fd_get(X, XD, _) ->
 7052            domain_num_elements(XD, S0),
 7053            bound_portray(S0, S)
 7054        ;   must_be(integer, X),
 7055            S = 1
 7056        ).
 7057
 7058%% fd_dom(+Var, -Dom)
 7059%
 7060%  Dom is the current domain (see in/2) of Var. This predicate is
 7061%  useful if you want to reason about domains. It is _not_ needed if
 7062%  you only want to display remaining domains; instead, separate your
 7063%  model from the search part and let the toplevel display this
 7064%  information via residual goals.
 7065%
 7066%  For example, to implement a custom labeling strategy, you may need
 7067%  to inspect the current domain of a finite domain variable. With the
 7068%  following code, you can convert a _finite_ domain to a list of
 7069%  integers:
 7070%
 7071%  ==
 7072%  dom_integers(D, Is) :- phrase(dom_integers_(D), Is).
 7073%
 7074%  dom_integers_(I)      --> { integer(I) }, [I].
 7075%  dom_integers_(L..U)   --> { numlist(L, U, Is) }, Is.
 7076%  dom_integers_(D1\/D2) --> dom_integers_(D1), dom_integers_(D2).
 7077%  ==
 7078%
 7079%  Example:
 7080%
 7081%  ==
 7082%  ?- X in 1..5, X #\= 4, fd_dom(X, D), dom_integers(D, Is).
 7083%  D = 1..3\/5,
 7084%  Is = [1,2,3,5],
 7085%  X in 1..3\/5.
 7086%  ==
 7087
 7088fd_dom(X, Drep) :-
 7089        (   fd_get(X, XD, _) ->
 7090            domain_to_drep(XD, Drep)
 7091        ;   must_be(integer, X),
 7092            Drep = X..X
 7093        ).
 7094
 7095/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 7096   Entailment detection. Subject to change.
 7097
 7098   Currently, Goals entail E if posting ({#\ E} U Goals), then
 7099   labeling all variables, fails. E must be reifiable. Examples:
 7100
 7101   %?- clpfd:goals_entail([X#>2], X #> 3).
 7102   %@ false.
 7103
 7104   %?- clpfd:goals_entail([X#>1, X#<3], X #= 2).
 7105   %@ true.
 7106
 7107   %?- clpfd:goals_entail([X#=Y+1], X #= Y+1).
 7108   %@ ERROR: Arguments are not sufficiently instantiated
 7109   %@    Exception: (15) throw(error(instantiation_error, _G2680)) ?
 7110
 7111   %?- clpfd:goals_entail([[X,Y] ins 0..10, X#=Y+1], X #= Y+1).
 7112   %@ true.
 7113
 7114- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 7115
 7116goals_entail(Goals, E) :-
 7117        must_be(list, Goals),
 7118        \+ (   maplist(call, Goals), #\ E,
 7119               term_variables(Goals-E, Vs),
 7120               label(Vs)
 7121           ).
 7122
 7123/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 7124   Unification hook and constraint projection
 7125- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 7126
 7127attr_unify_hook(clpfd_attr(_,_,_,Dom,Ps), Other) :-
 7128        (   nonvar(Other) ->
 7129            (   integer(Other) -> true
 7130            ;   type_error(integer, Other)
 7131            ),
 7132            domain_contains(Dom, Other),
 7133            trigger_props(Ps),
 7134            do_queue
 7135        ;   fd_get(Other, OD, OPs),
 7136            domains_intersection(OD, Dom, Dom1),
 7137            append_propagators(Ps, OPs, Ps1),
 7138            fd_put(Other, Dom1, Ps1),
 7139            trigger_props(Ps1),
 7140            do_queue
 7141        ).
 7142
 7143append_propagators(fd_props(Gs0,Bs0,Os0), fd_props(Gs1,Bs1,Os1), fd_props(Gs,Bs,Os)) :-
 7144        maplist(append, [Gs0,Bs0,Os0], [Gs1,Bs1,Os1], [Gs,Bs,Os]).
 7145
 7146bound_portray(inf, inf).
 7147bound_portray(sup, sup).
 7148bound_portray(n(N), N).
 7149
 7150list_to_drep(List, Drep) :-
 7151        list_to_domain(List, Dom),
 7152        domain_to_drep(Dom, Drep).
 7153
 7154domain_to_drep(Dom, Drep) :-
 7155        domain_intervals(Dom, [A0-B0|Rest]),
 7156        bound_portray(A0, A),
 7157        bound_portray(B0, B),
 7158        (   A == B -> Drep0 = A
 7159        ;   Drep0 = A..B
 7160        ),
 7161        intervals_to_drep(Rest, Drep0, Drep).
 7162
 7163intervals_to_drep([], Drep, Drep).
 7164intervals_to_drep([A0-B0|Rest], Drep0, Drep) :-
 7165        bound_portray(A0, A),
 7166        bound_portray(B0, B),
 7167        (   A == B -> D1 = A
 7168        ;   D1 = A..B
 7169        ),
 7170        intervals_to_drep(Rest, Drep0 \/ D1, Drep).
 7171
 7172attribute_goals(X) -->
 7173        % { get_attr(X, clpfd, Attr), format("A: ~w\n", [Attr]) },
 7174        { get_attr(X, clpfd, clpfd_attr(_,_,_,Dom,fd_props(Gs,Bs,Os))),
 7175          append(Gs, Bs, Ps0),
 7176          append(Ps0, Os, Ps),
 7177          domain_to_drep(Dom, Drep) },
 7178        (   { default_domain(Dom), \+ all_dead_(Ps) } -> []
 7179        ;   [clpfd:(X in Drep)]
 7180        ),
 7181        attributes_goals(Ps).
 7182
 7183clpfd_aux:attribute_goals(_) --> [].
 7184clpfd_aux:attr_unify_hook(_,_) :- false.
 7185
 7186clpfd_gcc_vs:attribute_goals(_) --> [].
 7187clpfd_gcc_vs:attr_unify_hook(_,_) :- false.
 7188
 7189clpfd_gcc_num:attribute_goals(_) --> [].
 7190clpfd_gcc_num:attr_unify_hook(_,_) :- false.
 7191
 7192clpfd_gcc_occurred:attribute_goals(_) --> [].
 7193clpfd_gcc_occurred:attr_unify_hook(_,_) :- false.
 7194
 7195clpfd_relation:attribute_goals(_) --> [].
 7196clpfd_relation:attr_unify_hook(_,_) :- false.
 7197
 7198attributes_goals([]) --> [].
 7199attributes_goals([propagator(P, State)|As]) -->
 7200        (   { ground(State) } -> []
 7201        ;   { phrase(attribute_goal_(P), Gs) } ->
 7202            { del_attr(State, clpfd_aux), State = processed,
 7203              (   current_prolog_flag(clpfd_monotonic, true) ->
 7204                  maplist(unwrap_with(bare_integer), Gs, Gs1)
 7205              ;   maplist(unwrap_with(=), Gs, Gs1)
 7206              ),
 7207              maplist(with_clpfd, Gs1, Gs2) },
 7208            list(Gs2)
 7209        ;   [P] % possibly user-defined constraint
 7210        ),
 7211        attributes_goals(As).
 7212
 7213with_clpfd(G, clpfd:G).
 7214
 7215unwrap_with(_, V, V)           :- var(V), !.
 7216unwrap_with(Goal, ?(V0), V)    :- !, call(Goal, V0, V).
 7217unwrap_with(Goal, Term0, Term) :-
 7218        Term0 =.. [F|Args0],
 7219        maplist(unwrap_with(Goal), Args0, Args),
 7220        Term =.. [F|Args].
 7221
 7222bare_integer(V0, V)    :- ( integer(V0) -> V = V0 ; V = #(V0) ).
 7223
 7224attribute_goal_(presidual(Goal))       --> [Goal].
 7225attribute_goal_(pgeq(A,B))             --> [?(A) #>= ?(B)].
 7226attribute_goal_(pplus(X,Y,Z))          --> [?(X) + ?(Y) #= ?(Z)].
 7227attribute_goal_(pneq(A,B))             --> [?(A) #\= ?(B)].
 7228attribute_goal_(ptimes(X,Y,Z))         --> [?(X) * ?(Y) #= ?(Z)].
 7229attribute_goal_(absdiff_neq(X,Y,C))    --> [abs(?(X) - ?(Y)) #\= C].
 7230attribute_goal_(absdiff_geq(X,Y,C))    --> [abs(?(X) - ?(Y)) #>= C].
 7231attribute_goal_(x_neq_y_plus_z(X,Y,Z)) --> [?(X) #\= ?(Y) + ?(Z)].
 7232attribute_goal_(x_leq_y_plus_c(X,Y,C)) --> [?(X) #=< ?(Y) + C].
 7233attribute_goal_(ptzdiv(X,Y,Z))         --> [?(X) // ?(Y) #= ?(Z)].
 7234attribute_goal_(pdiv(X,Y,Z))           --> [?(X) div ?(Y) #= ?(Z)].
 7235attribute_goal_(prdiv(X,Y,Z))          --> [?(X) rdiv ?(Y) #= ?(Z)].
 7236attribute_goal_(pexp(X,Y,Z))           --> [?(X) ^ ?(Y) #= ?(Z)].
 7237attribute_goal_(pabs(X,Y))             --> [?(Y) #= abs(?(X))].
 7238attribute_goal_(pmod(X,M,K))           --> [?(X) mod ?(M) #= ?(K)].
 7239attribute_goal_(prem(X,Y,Z))           --> [?(X) rem ?(Y) #= ?(Z)].
 7240attribute_goal_(pmax(X,Y,Z))           --> [?(Z) #= max(?(X),?(Y))].
 7241attribute_goal_(pmin(X,Y,Z))           --> [?(Z) #= min(?(X),?(Y))].
 7242attribute_goal_(scalar_product_neq(Cs,Vs,C)) -->
 7243        [Left #\= Right],
 7244        { scalar_product_left_right([-1|Cs], [C|Vs], Left, Right) }.
 7245attribute_goal_(scalar_product_eq(Cs,Vs,C)) -->
 7246        [Left #= Right],
 7247        { scalar_product_left_right([-1|Cs], [C|Vs], Left, Right) }.
 7248attribute_goal_(scalar_product_leq(Cs,Vs,C)) -->
 7249        [Left #=< Right],
 7250        { scalar_product_left_right([-1|Cs], [C|Vs], Left, Right) }.
 7251attribute_goal_(pdifferent(_,_,_,O))    --> original_goal(O).
 7252attribute_goal_(weak_distinct(_,_,_,O)) --> original_goal(O).
 7253attribute_goal_(pdistinct(Vs))          --> [all_distinct(Vs)].
 7254attribute_goal_(pexclude(_,_,_))  --> [].
 7255attribute_goal_(pelement(N,Is,V)) --> [element(N, Is, V)].
 7256attribute_goal_(pgcc(Vs, Pairs, _))   --> [global_cardinality(Vs, Pairs)].
 7257attribute_goal_(pgcc_single(_,_))     --> [].
 7258attribute_goal_(pgcc_check_single(_)) --> [].
 7259attribute_goal_(pgcc_check(_))        --> [].
 7260attribute_goal_(pcircuit(Vs))       --> [circuit(Vs)].
 7261attribute_goal_(pserialized(_,_,_,_,O)) --> original_goal(O).
 7262attribute_goal_(rel_tuple(R, Tuple)) -->
 7263        { get_attr(R, clpfd_relation, Rel) },
 7264        [tuples_in([Tuple], Rel)].
 7265attribute_goal_(pzcompare(O,A,B)) --> [zcompare(O,A,B)].
 7266% reified constraints
 7267attribute_goal_(reified_in(V, D, B)) -->
 7268        [V in Drep #<==> ?(B)],
 7269        { domain_to_drep(D, Drep) }.
 7270attribute_goal_(reified_tuple_in(Tuple, R, B)) -->
 7271        { get_attr(R, clpfd_relation, Rel) },
 7272        [tuples_in([Tuple], Rel) #<==> ?(B)].
 7273attribute_goal_(kill_reified_tuples(_,_,_)) --> [].
 7274attribute_goal_(tuples_not_in(_,_,_)) --> [].
 7275attribute_goal_(reified_fd(V,B)) --> [finite_domain(V) #<==> ?(B)].
 7276attribute_goal_(pskeleton(X,Y,D,_,Z,F)) -->
 7277        { Prop =.. [F,X,Y,Z],
 7278          phrase(attribute_goal_(Prop), Goals), list_goal(Goals, Goal) },
 7279        [?(D) #= 1 #==> Goal, ?(Y) #\= 0 #==> ?(D) #= 1].
 7280attribute_goal_(reified_neq(DX,X,DY,Y,_,B)) -->
 7281        conjunction(DX, DY, ?(X) #\= ?(Y), B).
 7282attribute_goal_(reified_eq(DX,X,DY,Y,_,B))  -->
 7283        conjunction(DX, DY, ?(X) #= ?(Y), B).
 7284attribute_goal_(reified_geq(DX,X,DY,Y,_,B)) -->
 7285        conjunction(DX, DY, ?(X) #>= ?(Y), B).
 7286attribute_goal_(reified_and(X,_,Y,_,B))    --> [?(X) #/\ ?(Y) #<==> ?(B)].
 7287attribute_goal_(reified_or(X, _, Y, _, B)) --> [?(X) #\/ ?(Y) #<==> ?(B)].
 7288attribute_goal_(reified_not(X, Y))         --> [#\ ?(X) #<==> ?(Y)].
 7289attribute_goal_(pimpl(X, Y, _))            --> [?(X) #==> ?(Y)].
 7290attribute_goal_(pfunction(Op, A, B, R)) -->
 7291        { Expr =.. [Op,?(A),?(B)] },
 7292        [?(R) #= Expr].
 7293attribute_goal_(pfunction(Op, A, R)) -->
 7294        { Expr =.. [Op,?(A)] },
 7295        [?(R) #= Expr].
 7296
 7297conjunction(A, B, G, D) -->
 7298        (   { A == 1, B == 1 } -> [G #<==> ?(D)]
 7299        ;   { A == 1 } -> [(?(B) #/\ G) #<==> ?(D)]
 7300        ;   { B == 1 } -> [(?(A) #/\ G) #<==> ?(D)]
 7301        ;   [(?(A) #/\ ?(B) #/\ G) #<==> ?(D)]
 7302        ).
 7303
 7304original_goal(original_goal(State, Goal)) -->
 7305        (   { var(State) } ->
 7306            { State = processed },
 7307            [Goal]
 7308        ;   []
 7309        ).
 7310
 7311/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 7312   Projection of scalar product.
 7313- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 7314
 7315scalar_product_left_right(Cs, Vs, Left, Right) :-
 7316        pairs_keys_values(Pairs0, Cs, Vs),
 7317        partition(ground, Pairs0, Grounds, Pairs),
 7318        maplist(pair_product, Grounds, Prods),
 7319        sum_list(Prods, Const),
 7320        NConst is -Const,
 7321        partition(compare_coeff0, Pairs, Negatives, _, Positives),
 7322        maplist(negate_coeff, Negatives, Rights),
 7323        scalar_plusterm(Rights, Right0),
 7324        scalar_plusterm(Positives, Left0),
 7325        (   Const =:= 0 -> Left = Left0, Right = Right0
 7326        ;   Right0 == 0 -> Left = Left0, Right = NConst
 7327        ;   Left0 == 0 ->  Left = Const, Right = Right0
 7328        ;   (   Const < 0 ->
 7329                Left = Left0,       Right = Right0+NConst
 7330            ;   Left = Left0+Const, Right = Right0
 7331            )
 7332        ).
 7333
 7334negate_coeff(A0-B, A-B) :- A is -A0.
 7335
 7336pair_product(A-B, Prod) :- Prod is A*B.
 7337
 7338compare_coeff0(Coeff-_, Compare) :- compare(Compare, Coeff, 0).
 7339
 7340scalar_plusterm([], 0).
 7341scalar_plusterm([CV|CVs], T) :-
 7342        coeff_var_term(CV, T0),
 7343        foldl(plusterm_, CVs, T0, T).
 7344
 7345plusterm_(CV, T0, T0+T) :- coeff_var_term(CV, T).
 7346
 7347coeff_var_term(C-V, T) :- ( C =:= 1 -> T = ?(V) ; T = C * ?(V) ).
 7348
 7349/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 7350   Generated predicates
 7351- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 7352
 7353:- discontiguous term_expansion/2. 7354
 7355term_expansion(make_parse_clpfd, Clauses)   :- make_parse_clpfd(Clauses).
 7356term_expansion(make_parse_reified, Clauses) :- make_parse_reified(Clauses).
 7357term_expansion(make_matches, Clauses)       :- make_matches(Clauses).
 7358
 7359make_parse_clpfd.
 7360make_parse_reified.
 7361make_matches.
 7362
 7363/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 7364   Global variables
 7365- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 7366
 7367make_clpfd_var('$clpfd_queue') :-
 7368        make_queue.
 7369make_clpfd_var('$clpfd_current_propagator') :-
 7370        nb_setval('$clpfd_current_propagator', []).
 7371make_clpfd_var('$clpfd_queue_status') :-
 7372        nb_setval('$clpfd_queue_status', enabled).
 7373
 7374:- multifile user:exception/3. 7375
 7376user:exception(undefined_global_variable, Name, retry) :-
 7377        make_clpfd_var(Name), !.
 7378
 7379warn_if_bounded_arithmetic :-
 7380        (   current_prolog_flag(bounded, true) ->
 7381            print_message(warning, clpfd(bounded))
 7382        ;   true
 7383        ).
 7384
 7385:- initialization(warn_if_bounded_arithmetic). 7386
 7387
 7388/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 7389   Messages
 7390- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 7391
 7392:- multifile prolog:message//1. 7393
 7394prolog:message(clpfd(bounded)) -->
 7395        ['Using CLP(FD) with bounded arithmetic may yield wrong results.'-[]].
 7396
 7397
 7398		 /*******************************
 7399		 *	      SANDBOX		*
 7400		 *******************************/
 7401
 7402/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 7403The clpfd library cannot  be   analysed  completely by library(sandbox).
 7404However, the API does not provide any  meta predicates. It provides some
 7405unification hooks, but put_attr/3 does not  allow injecting in arbitrary
 7406attributes.
 7407- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 7408
 7409:- multifile
 7410	sandbox:safe_primitive/1. 7411
 7412safe_api(Name/Arity, sandbox:safe_primitive(clpfd:Head)) :-
 7413	functor(Head, Name, Arity).
 7414
 7415term_expansion(safe_api, Clauses) :-
 7416	module_property(clpfd, exports(API)),
 7417	maplist(safe_api, API, Clauses).
 7418
 7419safe_api.
 7420% Support clpfd goal expansion.
 7421sandbox:safe_primitive(clpfd:clpfd_equal(_,_)).
 7422sandbox:safe_primitive(clpfd:clpfd_geq(_,_)).
 7423sandbox:safe_primitive(clpfd:clpfd_in(_,_)).
 7424% Enabling monotonic CLP(FD) is safe.
 7425sandbox:safe_primitive(set_prolog_flag(clpfd_monotonic, _))