I have written codes semi_lex_sort/2 which sorts a list of ground possibly cyclic terms.
Due to Carson example, result can not be always lexcal ordered list.
The code has not been reviewed carefully, but runs for several test cases as expected.
To force ordering cyclic terms in compatible way in a sorting for a given list with
the standard lexical ordering, a global variable compare_history is used. Although
it may look ad hoc, this is best codes to show what I have vaguely in mind. I will be glad
if this codes is useful for you and someone else. Of course I am far from insisting that
this is a meaningful solution, but a hobby programming from curiosity inspired by the Calrson example.
% ?- semi_lex_sort([a,b,a], X).
% ?- A=f(A), B=f(B), semi_lex_sort([A, B], X).
% ?- A=f(A, 0), B=f(B,1), C=f(C, 2), semi_lex_sort([A, B, C], X).
% ?- A=f(A, 0), B=f(B,1), C=f(C, 2), semi_lex_sort([C, B, A, A, B, C], X).
%@ A = f(A, 0),
%@ B = f(B, 1),
%@ C = f(C, 2),
%@ X = [f(A, 0), f(B, 1), f(C, 2)]
semi_lex_sort(X, Y):- b_setval(compare_history, []),
predsort(semi_lex_compare, X, Y).
%
semi_lex_compare(C, X, Y):- b_getval(compare_history, H),
compare_with_stack(C, X, Y, H, H0),
b_setval(compare_history, H0).
%
compare_with_stack(C, X, Y, H, H):- X == Y, !, C = (=).
compare_with_stack(C, X, Y, H, H0):- compare_with_stack(C0, X, Y),
( C0 = (=) -> force_order(C, X, Y, H, H0)
; C = C0, H0 = H
).
%
force_order(C, X, Y, H, H0):- functor(X, F, N),
( select(F/N-G, H, H1) -> true
; G = [],
H1 = H
),
force_order_in_arity_grouping(C, X, Y, G, G1),
H0 = [F/N-G1|H1].
%
force_order_in_arity_grouping(C, X, Y, G, G0):-
( memberchk(X, G)->
( memberchk(Y, G) ->
( precede(X, Y, G) -> C = (<)
; C = (>)
),
G0 = G
; C = (>),
G0 = [Y|G]
)
; memberchk(Y, G)->
C = (<),
G0 = [X|G]
; C = (<),
G0 = [X, Y|G]
).
%
precede(X, _, [X|_]):-!.
precede(X, Y, [U|L]):- Y\==U, precede(X, Y, L).
%
compare_with_stack(C, X, Y):- compare_with_stack(C, X, Y, []).
%
compare_with_stack(C, X, Y, P):-
( X = Y -> C = (=)
; (atomic(X); atomic(Y)) -> compare(C, X, Y)
; memberchk(X-Y, P) -> C = (=)
; functor(X, F, N),
functor(Y, G, M),
compare(D, N, M),
( D = (=) ->
compare(E, F, G),
( E = (=) ->
compare_args_with_stack(C, 1, X, Y, [X-Y|P])
; C = E
)
; C = D
)
).
%
compare_args_with_stack(C, K, A, B, P):- arg(K, A, X), arg(K, B, Y), !,
compare_with_stack(D, X, Y, P),
( D = (=) ->
K0 is K+1,
compare_args_with_stack(C, K0, A, B, P)
; C = D
).
compare_args_with_stack(=, _, _, _).