1 % (c) 2009-2026 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5 :- module(tools_lists,
6 [count_occurences/2,
7 ord_member_nonvar_chk/2,
8 ord_select_nonvar_chk/3,
9 ord_update_nonvar/4,
10 delete_first/3,
11 length_greater/2,
12 length_less/2,
13 member_nonvar_list/2,
14 exclude_count/4,
15 include_maplist/3,
16 optimized_nth1/3,
17 remove_dups_keep_order/2,
18 is_list_simple/1,
19 get_member_option/3,
20 convlist_max/4,
21 common_prefix_atom/2
22 ]).
23
24 :- meta_predicate exclude_count(1,-,-,-).
25 :- meta_predicate exclude_count_aux(-,1,-,-,-).
26 :- meta_predicate convlist_max(2,-,-,-).
27 :- meta_predicate conv_aux(-,2,-,-).
28 :- meta_predicate include_maplist(2,-,-).
29 :- meta_predicate include_maplist3(-,2,-).
30
31 :- use_module(module_information).
32
33 :- module_info(group,infrastructure).
34 :- module_info(description,'A few utilities on lists seperated out from tools.pl to avoid cyclic module dependencies.').
35
36
37 % self-check in tools to avoid dependency on self_check module
38 %:- assert_must_succeed((tools:count_occurences([a,b,a,a,b],R),R == [a-3,b-2])).
39 :- use_module(library(avl), [avl_fetch/2, avl_fetch/3, avl_to_list/2, avl_store/4, empty_avl/1]).
40 :- use_module(library(lists), [nth1/3]).
41
42 % count number of occurences inside a list
43 count_occurences(L,R) :- empty_avl(E), count_occ_aux(L,E,R).
44 count_occ_aux([Term|T],A,Res) :- (avl_fetch(Term,A,Count) -> C is Count+1 ; C = 1),
45 avl_store(Term,A,C,A2),
46 count_occ_aux(T,A2,Res).
47 count_occ_aux([],A,L) :- avl_to_list(A,L).
48
49 % like ord_member but also allows nonvar lookup terms
50 % note that this test fails for ord_member:
51 %:- assert_must_succeed((tools_lists:ord_member_nonvar_chk(p(b,X),[p(a,c),p(b,d)]),R == d)).
52 ord_member_nonvar_chk(X, [H|T]) :-
53 (X=H -> true
54 ; X @>H -> ord_member_nonvar_chk(X,T)).
55
56 :- use_module(library(lists), [select/3]).
57
58 % in contrast to delete/3 we delete only first occurence
59 delete_first(List,X,NewList) :- select(X,List,Del),!,NewList=Del.
60 delete_first(L,_,L).
61
62
63
64 %:- assert_must_succeed((tools_lists:ord_select_nonvar_chk(b,[a,b,c,d],R),R == [a,c,d])).
65 ord_select_nonvar_chk(X, [H|T], Res) :-
66 (X=H -> Res=T
67 ; X @>H -> Res=[H|TR], ord_select_nonvar_chk(X,T,TR)).
68
69 %:- assert_must_succeed((tools_lists:ord_update_nonvar(b(_),[a(x),b(x),d(x)],b(y),R),R == [a(x),b(y),d(x))).
70 %:- assert_must_succeed((tools_lists:ord_update_nonvar(b(_),[a(x),d(x)],b(y),R),R == [a(x),b(y),d(x))).
71 ord_update_nonvar(_, [], Y, Res) :- !, Res = [Y].
72 ord_update_nonvar(X, [H|T], Y, Res) :-
73 (X=H -> Res=[Y|T]
74 ; X @>H -> Res=[H|TR], ord_update_nonvar(X,T, Y, TR)
75 ; Res = [Y,H|T]).
76
77
78 % length_greater([1,2,3],1)
79 length_greater(_,X) :- X<0,!.
80 length_greater([_|T],X) :- X1 is X-1, length_greater(T,X1).
81
82
83 % length_less([1,2,3],4)
84 length_less([],Nr) :- Nr>0.
85 length_less([_|T],X) :- X>1, X1 is X-1, length_less(T,X1).
86
87
88 % a version of member that stops at a variable list tail
89 member_nonvar_list(X,List) :- nonvar(List), List=[H|T],
90 (X=H ; member_nonvar_list(X,T)).
91
92 % a version of exclude with counts the number of excluded items
93 exclude_count(Pred,List,ResList,Excluded) :-
94 exclude_count_aux(List,Pred,ResList,0,Excluded).
95 exclude_count_aux([],_,[],Acc,Acc).
96 exclude_count_aux([H|T],Pred,Res,Acc,Excluded) :-
97 (call(Pred,H)
98 -> Res = RT, Acc1 is Acc+1
99 ; Res = [H|RT], Acc1 = Acc
100 ), exclude_count_aux(T,Pred,RT,Acc1,Excluded).
101
102 % a combination of include and maplist
103 include_maplist(Pred,List,ResList) :- include_maplist3(List,Pred,ResList).
104
105 include_maplist3([],_,[]).
106 include_maplist3([H|T],Pred,Res) :-
107 (call(Pred,H,MH)
108 -> Res=[MH|MT],
109 include_maplist3(T,Pred,MT)
110 ; include_maplist3(T,Pred,Res)).
111
112 % a version of nth1 which has no choice point for singleton lists
113 optimized_nth1(Nr,[Single|T],Res) :- T==[], !, Nr=1,Res=Single. % avoid a pending choice point on the stack
114 optimized_nth1(Nr,Whens,Res) :- nth1(Nr,Whens,Res).
115
116
117 % remove_dups version which keeps order of original elements
118 remove_dups_keep_order([],[]).
119 remove_dups_keep_order([H|T],[H|Res]) :- empty_avl(E), avl_store(H,E,true,A1),
120 rem_dups(T,A1,Res).
121
122 rem_dups([],_,[]).
123 rem_dups([H|T],AVL,Res) :-
124 (avl_fetch(H,AVL) -> rem_dups(T,AVL,Res)
125 ; Res=[H|TRes],
126 avl_store(H,AVL,true,AVL1),
127 rem_dups(T,AVL1,TRes)).
128
129 /* Checks if the argument is a list, but unlike is_list/1 it just
130 checks the head and does not iterate through the list */
131 is_list_simple([]).
132 is_list_simple([_|_]).
133
134
135 % useful to extract an equality from an unsorted list of options:
136 get_member_option(Opt,List,Value) :- member(Equality,List), binding(Equality,Opt,Value).
137 binding('='(Opt,Val),Opt,Val).
138 binding('/'(Opt,Val),Opt,Val).
139
140
141
142 % a version of convlist that returns at most Max solutions
143 convlist_max(Pred,Max,List,Res) :-
144 (Max>0 -> conv_aux(List,Pred,Max,Res) ; Res=[]).
145 conv_aux([],_,_,[]).
146 conv_aux([H|T],Pred,Max,Res) :-
147 (call(Pred,H,HX)
148 -> Res=[HX|TX],
149 (Max>1 -> M1 is Max-1, conv_aux(T,Pred,M1,TX)
150 ; TX=[])
151 ; conv_aux(T,Pred,Max,Res)).
152
153
154 % common prefix of a list of atoms
155 % common_prefix_atom([ab,ac],R) -> R=a
156 common_prefix_atom([H],Res) :- !, Res=[H]. % single completion
157 common_prefix_atom([H|T],Res) :- atom_codes(H,Hs), com_all(T,Hs,ResC), atom_codes(Res,ResC).
158
159 com_all([],H,H).
160 com_all([H|T],PrevPrefix,Res) :- atom_codes(H,Hs), common_prefix(Hs,PrevPrefix,NewPrefix),
161 com_all(T,NewPrefix,Res).
162
163 common_prefix([H|T1],[H|T2],[H|Res]) :- !, common_prefix(T1,T2,Res).
164 common_prefix(_,_,[]).