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