1 % (c) 2009-2023 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
6 :- module(tools_lists,
7 [count_occurences/2,
8 ord_member_nonvar_chk/2,
9 ord_select_nonvar_chk/3,
10 ord_update_nonvar/4,
11 delete_first/3,
12 length_greater/2,
13 length_less/2,
14 member_nonvar_list/2,
15 exclude_count/4,
16 include_maplist/3,
17 optimized_nth1/3,
18 remove_dups_keep_order/2,
19 is_list_simple/1,
20 get_member_option/3,
21 convlist_max/4,
22 common_prefix_atom/2
23 ]).
24
25 :- meta_predicate exclude_count(1,-,-,-).
26 :- meta_predicate exclude_count_aux(-,1,-,-,-).
27 :- meta_predicate convlist_max(2,-,-,-).
28 :- meta_predicate conv_aux(-,2,-,-).
29 :- meta_predicate include_maplist(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(_,[],[]).
104 include_maplist(Pred,[H|T],[MH|MT]) :-
105 call(Pred,H,MH),!,
106 include_maplist(Pred,T,MT).
107 include_maplist(Pred,[_|T],Res) :- include_maplist(Pred,T,Res).
108
109 % a version of nth1 which has no choice point for singleton lists
110 optimized_nth1(Nr,[Single|T],Res) :- T==[], !, Nr=1,Res=Single. % avoid a pending choice point on the stack
111 optimized_nth1(Nr,Whens,Res) :- nth1(Nr,Whens,Res).
112
113
114 % remove_dups version which keeps order of original elements
115 remove_dups_keep_order([],[]).
116 remove_dups_keep_order([H|T],[H|Res]) :- empty_avl(E), avl_store(H,E,true,A1),
117 rem_dups(T,A1,Res).
118
119 rem_dups([],_,[]).
120 rem_dups([H|T],AVL,Res) :-
121 (avl_fetch(H,AVL) -> rem_dups(T,AVL,Res)
122 ; Res=[H|TRes],
123 avl_store(H,AVL,true,AVL1),
124 rem_dups(T,AVL1,TRes)).
125
126 /* Checks if the argument is a list, but unlike is_list/1 it just
127 checks the head and does not iterate through the list */
128 is_list_simple([]).
129 is_list_simple([_|_]).
130
131
132 % useful to extract an equality from an unsorted list of options:
133 get_member_option(Opt,List,Value) :- member(Equality,List), binding(Equality,Opt,Value).
134 binding('='(Opt,Val),Opt,Val).
135 binding('/'(Opt,Val),Opt,Val).
136
137
138
139 % a version of convlist that returns at most Max solutions
140 convlist_max(Pred,Max,List,Res) :-
141 (Max>0 -> conv_aux(List,Pred,Max,Res) ; Res=[]).
142 conv_aux([],_,_,[]).
143 conv_aux([H|T],Pred,Max,Res) :-
144 (call(Pred,H,HX)
145 -> Res=[HX|TX],
146 (Max>1 -> M1 is Max-1, conv_aux(T,Pred,M1,TX)
147 ; TX=[])
148 ; conv_aux(T,Pred,Max,Res)).
149
150
151 % common prefix of a list of atoms
152 % common_prefix_atom([ab,ac],R) -> R=a
153 common_prefix_atom([H],Res) :- !, Res=[H]. % single completion
154 common_prefix_atom([H|T],Res) :- atom_codes(H,Hs), com_all(T,Hs,ResC), atom_codes(Res,ResC).
155
156 com_all([],H,H).
157 com_all([H|T],PrevPrefix,Res) :- atom_codes(H,Hs), common_prefix(Hs,PrevPrefix,NewPrefix),
158 com_all(T,NewPrefix,Res).
159
160 common_prefix([H|T1],[H|T2],[H|Res]) :- !, common_prefix(T1,T2,Res).
161 common_prefix(_,_,[]).