35
36:- module(table_util,
37 [ sort_table/2, 38 verify_table_order/1 39 ]). 40:- autoload(library(backcomp),[flush/0]). 41:- autoload(library(table),
42 [ get_table_attribute/3,
43 read_table_record_data/4,
44 compare_strings/4,
45 read_table_fields/4
46 ]).
57sort_table(Table, File) :-
58 open(File, write, OutFd), 59 get_table_attribute(Table, key_field, Key),
60 !,
61 get_table_attribute(Table, field(Key), Term),
62 get_table_attribute(Table, file, InFile),
63 functor(Term, KeyName, _),
64 arg(2, Term, Attributes),
65 format('Sorting table "~w" ', [InFile]),
66 ( memberchk(sorted(Order), Attributes)
67 -> true
68 ; memberchk(sorted, Attributes),
69 Order = exact
70 ),
71 format('sorted(~w) on field "~w" ... ', [Order, KeyName]),
72 flush,
73 read_table(Table, KeyName, Fields),
74 sort_fields(Order, Fields, SortedFields),
75 write_table(SortedFields, Table, OutFd),
76 close(OutFd),
77 format('done.~n', []).
78
79read_table(Table, KeyName, Fields) :-
80 format('(reading) ... ', []), flush,
81 read_table(Table, KeyName, 0, Fields).
82
83read_table(Table, KeyName, From, [KeyValue-From|T]) :-
84 read_field(Table, From, To, KeyName, KeyValue),
85 !,
86 read_table(Table, KeyName, To, T).
87read_table(_, _, _, []).
88
89sort_fields(Order, Fields, Sorted) :-
90 length(Fields, N),
91 format('(sorting ~D records) ... ', [N]), flush,
92 sort_keyed_strings(Order, Fields, Sorted).
93
94write_table(Records, Table, OutFd) :-
95 format('(writing) ... ', []), flush,
96 get_table_attribute(Table, record_separator, Sep),
97 write_records(Records, Table, Sep, OutFd).
98
99write_records([], _, _, _).
100write_records([_-From|T], Table, Sep, OutFd) :-
101 read_table_record_data(Table, From, _To, RecordData),
102 format(OutFd, '~s~c', [RecordData, Sep]),
103 write_records(T, Table, Sep, OutFd).
111sort_keyed_strings(Table, List, Sorted) :-
112 length(List, Length),
113 do_sort(Length, Table, List, _, Result),
114 Sorted = Result.
115
116do_sort(2, Table, [X1, X2|L], L, R) :-
117 !,
118 X1 = K1-_,
119 X2 = K2-_,
120 compare_strings(Table, K1, K2, Cmp),
121 merge2(Cmp, X1, X2, R).
122do_sort(1, _, [X|L], L, [X]) :- !.
123do_sort(0, _, L, L, []) :- !.
124do_sort(N, Table, L1, L3, R) :-
125 N1 is N // 2,
126 N2 is N - N1,
127 do_sort(N1, Table, L1, L2, R1),
128 do_sort(N2, Table, L2, L3, R2),
129 do_merge(R1, R2, Table, R).
130
131do_merge([], R, _, R) :- !.
132do_merge(R, [], _, R) :- !.
133do_merge(R1, R2, Table, [X|R]) :-
134 R1 = [X1|R1a],
135 R2 = [X2|R2a],
136 X1 = K1-_,
137 X2 = K2-_,
138 ( compare_strings(Table, K1, K2, >)
139 -> X = X2, do_merge(R1, R2a, Table, R)
140 ; X = X1, do_merge(R1a, R2, Table, R)
141 ).
142
143merge2(>, A, B, [B, A]) :- !.
144merge2(_, A, B, [A, B]).
145
146
147
157verify_table_order(Table) :-
158 get_table_attribute(Table, key_field, Key),
159 !,
160 get_table_attribute(Table, field(Key), Term),
161 get_table_attribute(Table, file, File),
162 functor(Term, KeyName, _),
163 arg(2, Term, Attributes),
164 format('Checking "~w" ', [File]),
165 ( memberchk(sorted(Order), Attributes)
166 -> true
167 ; memberchk(sorted, Attributes),
168 Order = exact
169 ),
170 ( memberchk(unique, Attributes)
171 -> Cmp = >,
172 format('uniquely ', [])
173 ; Cmp = [>, =]
174 ),
175 format('sorted(~w) on field "~w" ... ', [Order, KeyName]),
176 flush,
177 read_field(Table, 0, To, KeyName, KeyValue),
178 verify_table(Table, To, KeyName, KeyValue, Order, Cmp),
179 format('done.~n', []).
180
181verify_table(Table, From, KeyName, PrevValue, Order, Cmp) :-
182 read_field(Table, From, To, KeyName, KeyValue),
183 !,
184 ( compare_strings(Order, KeyValue, PrevValue, Rval),
185 ok_cmp(Rval, Cmp)
186 -> verify_table(Table, To, KeyName, KeyValue, Order, Cmp)
187 ; format('~N!! Order conflict: ~w < ~w~n', [KeyValue, PrevValue]),
188 verify_table(Table, To, KeyName, KeyValue, Order, Cmp)
189 ).
190verify_table(_, _, _, _, _, _).
191
192ok_cmp(Cmp, Cmp) :- !.
193ok_cmp(Cmp, List) :-
194 memberchk(Cmp, List).
195
196read_field(Table, From, To, Field, Value) :-
197 functor(Term, Field, 1),
198 read_table_fields(Table, From, To, [Term]),
199 arg(1, Term, Value)
Tabular file handling utilities
*/