2% I re-implement the old findall_constraints that was implemented in
    3% SICStus 3. I have looked at the source code of the new CHR library
    4findall_constraints(C,L):-
    5    findall(C,'$enumerate_constraints'(C),L).
    6
    7% This version has N^2 complexity,
    8% but retains the names of the variables, ie., if two CHR constraints
    9% share a variable, the list will have two terms sharing the same variable.
   10findall_constraints_nsquare(C,L):-
   11    findall_constraints_nsquare(C,[],L).
   12findall_constraints_nsquare(C,Lin,Lout):-
   13    copy_term(C,C1),
   14    '$enumerate_constraints'(C1),
   15    not_member_eq(C1,Lin),!,
   16    findall_constraints_nsquare(C,[C1|Lin],Lout).
   17findall_constraints_nsquare(_,L,L).
   18
   19not_member_eq(_,[]).
   20not_member_eq(X,[Y|T]):- \+(X==Y), not_member_eq(X,T).
   21    
   22
   23max_constraints(C,Max):-
   24    assert('$n_constraints'(0)),
   25    ('$enumerate_constraints'(C), retract('$n_constraints'(N)),
   26        (N<Max -> N1 is N+1, assert('$n_constraints'(N1)), fail
   27            ;   !,retract('$n_constraints'(_)), fail
   28        )
   29    ; retractall('$n_constraints'(_))
   30    ).
   31
   32print_chr_list([],_).
   33print_chr_list([X|R],Sep):-
   34    portray(X), write(Sep),
   35    print_chr_list(R,Sep)