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 :- use_module(library(avl), [avl_fetch/2, avl_fetch/3, avl_to_list/2, avl_store/4, empty_avl/1]).
37 :- use_module(library(lists), [nth1/3]).
38 :- use_module(library(samsort), [samsort/2]).
39
40 % self-check in tools to avoid dependency on self_check module
41 %:- assert_must_succeed((tools:count_occurences([a,b,a,a,b],R),R == [a-3,b-2])).
42
43 % count number of occurences inside a list
44 count_occurences(L,R) :- samsort(L,SL), count1(SL,R).
45
46 count1([],[]).
47 count1([H|T],R) :- count2(T,H,1,R).
48
49 count2([],H,Cnt,[H-Cnt]).
50 count2([H|T],Acc,Cnt,Res) :-
51 (H=Acc -> C1 is Cnt+1, count2(T,Acc,C1,Res)
52 ; Res = [Acc-Cnt|RT],
53 count2(T,H,1,RT)).
54
55 % like ord_member but also allows nonvar lookup terms
56 % note that this test fails for ord_member:
57 %:- assert_must_succeed((tools_lists:ord_member_nonvar_chk(p(b,X),[p(a,c),p(b,d)]),R == d)).
58 ord_member_nonvar_chk(X, [H|T]) :-
59 (X=H -> true
60 ; X @>H -> ord_member_nonvar_chk(X,T)).
61
62 :- use_module(library(lists), [select/3]).
63
64 % in contrast to delete/3 we delete only first occurence
65 ?delete_first(List,X,NewList) :- select(X,List,Del),!,NewList=Del.
66 delete_first(L,_,L).
67
68
69
70 %:- assert_must_succeed((tools_lists:ord_select_nonvar_chk(b,[a,b,c,d],R),R == [a,c,d])).
71 ord_select_nonvar_chk(X, [H|T], Res) :-
72 (X=H -> Res=T
73 ; X @>H -> Res=[H|TR], ord_select_nonvar_chk(X,T,TR)).
74
75 %:- 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))).
76 %:- assert_must_succeed((tools_lists:ord_update_nonvar(b(_),[a(x),d(x)],b(y),R),R == [a(x),b(y),d(x))).
77 ord_update_nonvar(_, [], Y, Res) :- !, Res = [Y].
78 ord_update_nonvar(X, [H|T], Y, Res) :-
79 (X=H -> Res=[Y|T]
80 ; X @>H -> Res=[H|TR], ord_update_nonvar(X,T, Y, TR)
81 ; Res = [Y,H|T]).
82
83
84 % length_greater([1,2,3],1)
85 length_greater(_,X) :- X<0,!.
86 length_greater([_|T],X) :- X1 is X-1, length_greater(T,X1).
87
88
89 % length_less([1,2,3],4)
90 length_less([],Nr) :- Nr>0.
91 length_less([_|T],X) :- X>1, X1 is X-1, length_less(T,X1).
92
93
94 % a version of member that stops at a variable list tail
95 member_nonvar_list(X,List) :- nonvar(List), List=[H|T],
96 (X=H ; member_nonvar_list(X,T)).
97
98 % a version of exclude with counts the number of excluded items
99 exclude_count(Pred,List,ResList,Excluded) :-
100 exclude_count_aux(List,Pred,ResList,0,Excluded).
101 exclude_count_aux([],_,[],Acc,Acc).
102 exclude_count_aux([H|T],Pred,Res,Acc,Excluded) :-
103 (call(Pred,H)
104 -> Res = RT, Acc1 is Acc+1
105 ; Res = [H|RT], Acc1 = Acc
106 ), exclude_count_aux(T,Pred,RT,Acc1,Excluded).
107
108 % a combination of include and maplist
109 include_maplist(Pred,List,ResList) :- include_maplist3(List,Pred,ResList).
110
111 include_maplist3([],_,[]).
112 include_maplist3([H|T],Pred,Res) :-
113 (call(Pred,H,MH)
114 -> Res=[MH|MT],
115 include_maplist3(T,Pred,MT)
116 ; include_maplist3(T,Pred,Res)).
117
118 % a version of nth1 which has no choice point for singleton lists
119 optimized_nth1(Nr,[Single|T],Res) :- T==[], !, Nr=1,Res=Single. % avoid a pending choice point on the stack
120 ?optimized_nth1(Nr,Whens,Res) :- nth1(Nr,Whens,Res).
121
122
123 % remove_dups version which keeps order of original elements
124 remove_dups_keep_order([],[]).
125 remove_dups_keep_order([H|T],[H|Res]) :- empty_avl(E), avl_store(H,E,true,A1),
126 rem_dups(T,A1,Res).
127
128 rem_dups([],_,[]).
129 rem_dups([H|T],AVL,Res) :-
130 (avl_fetch(H,AVL) -> rem_dups(T,AVL,Res)
131 ; Res=[H|TRes],
132 avl_store(H,AVL,true,AVL1),
133 rem_dups(T,AVL1,TRes)).
134
135 /* Checks if the argument is a list, but unlike is_list/1 it just
136 checks the head and does not iterate through the list */
137 is_list_simple([]).
138 is_list_simple([_|_]).
139
140
141 % useful to extract an equality from an unsorted list of options:
142 get_member_option(Opt,List,Value) :- member(Equality,List), binding(Equality,Opt,Value).
143 binding('='(Opt,Val),Opt,Val).
144 binding('/'(Opt,Val),Opt,Val).
145
146
147
148 % a version of convlist that returns at most Max solutions
149 convlist_max(Pred,Max,List,Res) :-
150 (Max>0 -> conv_aux(List,Pred,Max,Res) ; Res=[]).
151 conv_aux([],_,_,[]).
152 conv_aux([H|T],Pred,Max,Res) :-
153 (call(Pred,H,HX)
154 -> Res=[HX|TX],
155 (Max>1 -> M1 is Max-1, conv_aux(T,Pred,M1,TX)
156 ; TX=[])
157 ; conv_aux(T,Pred,Max,Res)).
158
159
160 % common prefix of a list of atoms
161 % common_prefix_atom([ab,ac],R) -> R=a
162 common_prefix_atom([H],Res) :- !, Res=[H]. % single completion
163 common_prefix_atom([H|T],Res) :- atom_codes(H,Hs), com_all(T,Hs,ResC), atom_codes(Res,ResC).
164
165 com_all([],H,H).
166 com_all([H|T],PrevPrefix,Res) :- atom_codes(H,Hs), common_prefix(Hs,PrevPrefix,NewPrefix),
167 com_all(T,NewPrefix,Res).
168
169 common_prefix([H|T1],[H|T2],[H|Res]) :- !, common_prefix(T1,T2,Res).
170 common_prefix(_,_,[]).