1:- module(print_clp_constraints, [
    2		constraints_closure/2
    3	]).    4
    5
    6%------------------------------------------------------------
    7% Retrieving a set of CLP(FD) constraints
    8% Marco Gavanelli
    9% 1 October 2003
   10%-------------------------------------------------------------
   11
   12
   13:- use_module(library(clpfd)).   14
   15% constraints_closure (+Vars,-C)
   16% Returns in C the closure of the list of constraints on 
   17% the variables in the list Vars.
   18% C is a goal (i.e., a conjunction of constraints)
   19% E.g.: 
   20% | ?- A in 1..10, B #> A, constraints_closure([A],C).
   21% C = A in_set[[1|10]],B in_set[[2|sup]],clpfd:'t>=u+c'(B,A,1),
   22% A in 1..10,
   23% B in 2..sup ? 
   24% yes
   25
   26% Notice that returns only the constraints connected to the
   27% variables in Vars
   28% E.g.
   29% | ?- A in 1..10, X#>Y, constraints_closure([A],C).
   30% C = A in_set[[1|10]],
   31% A in 1..10,
   32% Y in inf..sup,
   33% X in inf..sup ? 
   34
   35
   36
   37constraints_closure(Var,C):-
   38	fd_closure(Var,L),
   39	fd_copy_term(L,LL,C),
   40	L = LL