1%%
2%% The following is nearly verbatim copy of file_sorter.erl from
3%% stdlib of Erlang R15B03-1. Only change we made on top is removal of
4%% compressed option in call to file:open in read_fun below.
5%%
6%% ------------
7%%
8%% %CopyrightBegin%
9%%
10%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
11%%
12%% The contents of this file are subject to the Erlang Public License,
13%% Version 1.1, (the "License"); you may not use this file except in
14%% compliance with the License. You should have received a copy of the
15%% Erlang Public License along with this software. If not, it can be
16%% retrieved online at http://www.erlang.org/.
17%%
18%% Software distributed under the License is distributed on an "AS IS"
19%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
20%% the License for the specific language governing rights and limitations
21%% under the License.
22%%
23%% %CopyrightEnd%
24%%
25-module(file_sorter_2).
26
27%% Avoid warning for local function error/2 clashing with autoimported BIF.
28-compile({no_auto_import,[error/2]}).
29-export([sort/1, sort/2, sort/3,
30         keysort/2, keysort/3, keysort/4,
31         merge/2, merge/3,
32         keymerge/3, keymerge/4,
33         check/1, check/2,
34         keycheck/2, keycheck/3]).
35
36-include_lib("kernel/include/file.hrl").
37
38-define(CHUNKSIZE, 16384).
39-define(RUNSIZE, 524288).
40-define(NOMERGE, 16).
41-define(MERGESIZE, ?CHUNKSIZE).
42
43-define(MAXSIZE, (1 bsl 31)).
44
45-record(w, {keypos, runs = [[]], seq = 1, in, out, fun_out, prefix, temp = [],
46            format, runsize, no_files, order, chunksize, wfd, ref, z, unique,
47            hdlen, inout_value}).
48
49-record(opts, {format = binary_term_fun(), size = ?RUNSIZE,
50               no_files = ?NOMERGE, tmpdir = default, order = ascending,
51               compressed = false, unique = false, header = 4}).
52
53-compile({inline, [{badarg, 2}, {make_key,2}, {make_stable_key,3}, {cfun,3}]}).
54
55%%%
56%%% Exported functions
57%%%
58
59-export_type([reason/0]).
60
61-type(file_name() :: file:name()).
62-type(file_names() :: [file:name()]).
63-type(i_command() :: read | close).
64-type(i_reply() :: end_of_input | {end_of_input, value()}
65                 | {[object()], infun()} | input_reply()).
66-type(infun() :: fun((i_command()) -> i_reply())).
67-type(input() :: file_names() | infun()).
68-type(input_reply() :: term()).
69-type(o_command() :: {value, value()} | [object()] | close).
70-type(o_reply() :: outfun() | output_reply()).
71-type(object() :: term() | binary()).
72-type(outfun() :: fun((o_command()) -> o_reply())).
73-type(output() :: file_name() | outfun()).
74-type(output_reply() :: term()).
75-type(value() :: term()).
76
77-type(options() :: [option()] | option()).
78-type(option() :: {compressed, boolean()}
79                | {header, header_length()}
80                | {format, format()}
81                | {no_files, no_files()}
82                | {order, order()}
83                | {size, size()}
84                | {tmpdir, tmp_directory()}
85                | {unique, boolean()}).
86-type(format() :: binary_term | term | binary | format_fun()).
87-type(format_fun() :: fun((binary()) -> term())).
88-type(header_length() :: pos_integer()).
89-type(key_pos() :: pos_integer() | [pos_integer()]).
90-type(no_files() :: pos_integer()). % > 1
91-type(order() :: ascending | descending | order_fun()).
92-type(order_fun() :: fun((term(), term()) -> boolean())).
93-type(size() :: non_neg_integer()).
94-type(tmp_directory() :: [] | file:name()).
95
96-type(reason() :: bad_object
97                | {bad_object, file_name()}
98                | {bad_term, file_name()}
99                | {file_error, file_name(),
100                   file:posix() | badarg | system_limit}
101                | {premature_eof, file_name()}).
102
103-spec(sort(FileName) -> Reply when
104      FileName :: file_name(),
105      Reply :: ok | {error, reason()} | input_reply() | output_reply()).
106sort(FileName) ->
107    sort([FileName], FileName).
108
109-spec(sort(Input, Output) -> Reply when
110      Input :: input(),
111      Output :: output(),
112      Reply :: ok | {error, reason()} | input_reply() | output_reply()).
113sort(Input, Output) ->
114    sort(Input, Output, []).
115
116-spec(sort(Input, Output, Options) -> Reply when
117      Input :: input(),
118      Output :: output(),
119      Options :: options(),
120      Reply :: ok | {error, reason()} | input_reply() | output_reply()).
121sort(Input0, Output0, Options) ->
122    case {is_input(Input0), maybe_output(Output0), options(Options)}  of
123        {{true,Input}, {true,Output}, #opts{}=Opts} ->
124            do_sort(0, Input, Output, Opts, sort);
125        T ->
126            badarg(culprit(tuple_to_list(T)), [Input0, Output0, Options])
127    end.
128
129-spec(keysort(KeyPos, FileName) -> Reply when
130      KeyPos :: key_pos(),
131      FileName :: file_name(),
132      Reply :: ok | {error, reason()} | input_reply() | output_reply()).
133keysort(KeyPos, FileName) ->
134    keysort(KeyPos, [FileName], FileName).
135
136-spec(keysort(KeyPos, Input, Output) -> Reply when
137      KeyPos :: key_pos(),
138      Input :: input(),
139      Output :: output(),
140      Reply :: ok | {error, reason()} | input_reply() | output_reply()).
141keysort(KeyPos, Input, Output) ->
142    keysort(KeyPos, Input, Output, []).
143
144-spec(keysort(KeyPos, Input, Output, Options) -> Reply when
145      KeyPos :: key_pos(),
146      Input :: input(),
147      Output :: output(),
148      Options :: options(),
149      Reply :: ok | {error, reason()} | input_reply() | output_reply()).
150keysort(KeyPos, Input0, Output0, Options) ->
151    R = case {is_keypos(KeyPos), is_input(Input0),
152              maybe_output(Output0), options(Options)} of
153            {_, _, _, #opts{format = binary}} ->
154                {Input0,Output0,[{badarg,format}]};
155            {_, _, _, #opts{order = Order}} when is_function(Order) ->
156                {Input0,Output0,[{badarg,order}]};
157            {true, {true,In}, {true,Out}, #opts{}=Opts} ->
158                {In,Out,Opts};
159            T ->
160                {Input0,Output0,tuple_to_list(T)}
161        end,
162    case R of
163        {Input,Output,#opts{}=O} ->
164            do_sort(KeyPos, Input, Output, O, sort);
165        {_,_,O} ->
166            badarg(culprit(O), [KeyPos, Input0, Output0, Options])
167    end.
168
169-spec(merge(FileNames, Output) -> Reply when
170      FileNames :: file_names(),
171      Output :: output(),
172      Reply :: ok | {error, reason()} | output_reply()).
173merge(Files, Output) ->
174    merge(Files, Output, []).
175
176-spec(merge(FileNames, Output, Options) -> Reply when
177      FileNames :: file_names(),
178      Output :: output(),
179      Options :: options(),
180      Reply :: ok | {error, reason()} | output_reply()).
181merge(Files0, Output0, Options) ->
182    case {is_files(Files0), maybe_output(Output0), options(Options)} of
183        %% size not used
184        {{true,Files}, {true,Output}, #opts{}=Opts} ->
185            do_sort(0, Files, Output, Opts, merge);
186        T ->
187            badarg(culprit(tuple_to_list(T)), [Files0, Output0, Options])
188    end.
189
190-spec(keymerge(KeyPos, FileNames, Output) -> Reply when
191      KeyPos :: key_pos(),
192      FileNames :: file_names(),
193      Output :: output(),
194      Reply :: ok | {error, reason()} | output_reply()).
195keymerge(KeyPos, Files, Output) ->
196    keymerge(KeyPos, Files, Output, []).
197
198-spec(keymerge(KeyPos, FileNames, Output, Options) -> Reply when
199      KeyPos :: key_pos(),
200      FileNames :: file_names(),
201      Output :: output(),
202      Options :: options(),
203      Reply :: ok | {error, reason()} | output_reply()).
204keymerge(KeyPos, Files0, Output0, Options) ->
205    R = case {is_keypos(KeyPos), is_files(Files0),
206              maybe_output(Output0), options(Options)} of
207            {_, _, _, #opts{format = binary}} ->
208                {Files0,Output0,[{badarg,format}]};
209            {_, _, _, #opts{order = Order}} when is_function(Order) ->
210                {Files0,Output0,[{badarg,order}]};
211            {true, {true,Fs}, {true,Out}, #opts{}=Opts} ->
212                {Fs,Out,Opts};
213            T ->
214                {Files0,Output0,tuple_to_list(T)}
215        end,
216    case R of
217        {Files,Output,#opts{}=O} ->
218            do_sort(KeyPos, Files, Output, O, merge);
219        {_,_,O} ->
220            badarg(culprit(O), [KeyPos, Files0, Output0, Options])
221    end.
222
223-spec(check(FileName) -> Reply when
224      FileName :: file_name(),
225      Reply :: {ok, [Result]} | {error, reason()},
226      Result :: {FileName, TermPosition, term()},
227      TermPosition :: pos_integer()).
228check(FileName) ->
229    check([FileName], []).
230
231-spec(check(FileNames, Options) -> Reply when
232      FileNames :: file_names(),
233      Options :: options(),
234      Reply :: {ok, [Result]} | {error, reason()},
235      Result :: {FileName, TermPosition, term()},
236      FileName :: file_name(),
237      TermPosition :: pos_integer()).
238check(Files0, Options) ->
239    case {is_files(Files0), options(Options)} of
240        {{true,Files}, #opts{}=Opts} ->
241            do_sort(0, Files, undefined, Opts, check);
242        T ->
243            badarg(culprit(tuple_to_list(T)), [Files0, Options])
244    end.
245
246-spec(keycheck(KeyPos, FileName) -> Reply when
247      KeyPos :: key_pos(),
248      FileName :: file_name(),
249      Reply :: {ok, [Result]} | {error, reason()},
250      Result :: {FileName, TermPosition, term()},
251      TermPosition :: pos_integer()).
252keycheck(KeyPos, FileName) ->
253    keycheck(KeyPos, [FileName], []).
254
255-spec(keycheck(KeyPos, FileNames, Options) -> Reply when
256      KeyPos :: key_pos(),
257      FileNames :: file_names(),
258      Options :: options(),
259      Reply :: {ok, [Result]} | {error, reason()},
260      Result :: {FileName, TermPosition, term()},
261      FileName :: file_name(),
262      TermPosition :: pos_integer()).
263keycheck(KeyPos, Files0, Options) ->
264    R = case {is_keypos(KeyPos), is_files(Files0), options(Options)} of
265            {_, _, #opts{format = binary}} ->
266                {Files0,[{badarg,format}]};
267            {_, _, #opts{order = Order}} when is_function(Order) ->
268                {Files0,[{badarg,order}]};
269            {true, {true,Fs}, #opts{}=Opts} ->
270                {Fs,Opts};
271            T ->
272                {Files0,tuple_to_list(T)}
273        end,
274    case R of
275        {Files,#opts{}=O} ->
276            do_sort(KeyPos, Files, undefined, O, check);
277        {_,O} ->
278            badarg(culprit(O), [KeyPos, Files0, Options])
279    end.
280
281%%%
282%%% Local functions
283%%%
284
285%%-define(debug, true).
286
287-ifdef(debug).
288-define(DEBUG(S, A), io:format(S, A)).
289-else.
290-define(DEBUG(S, A), ok).
291-endif.
292
293culprit([{error, _} = E | _]) ->
294    E;
295culprit([{badarg, _} = B | _]) ->
296    B;
297culprit([_ | B]) ->
298    culprit(B).
299
300%% Inlined.
301badarg({error, _} = E, _Args) ->
302    E;
303badarg({badarg, _} = B, Args) ->
304    erlang:error(B, Args).
305
306options(Options) when is_list(Options) ->
307    options(Options, #opts{});
308options(Option) ->
309    options([Option]).
310
311options([{format, Format} | L], Opts) when Format =:= binary;
312                                           Format =:= term;
313                                           is_function(Format),
314                                           is_function(Format, 1) ->
315    options(L, Opts#opts{format = Format});
316options([{format, binary_term} | L], Opts) ->
317    options(L, Opts#opts{format = binary_term_fun()});
318options([{size, Size} | L], Opts) when is_integer(Size), Size >= 0 ->
319    options(L, Opts#opts{size = erlang:max(Size, 1)});
320options([{no_files, NoFiles} | L], Opts) when is_integer(NoFiles),
321                                              NoFiles > 1 ->
322    options(L, Opts#opts{no_files = NoFiles});
323options([{tmpdir, ""} | L], Opts) ->
324    options(L, Opts#opts{tmpdir = default});
325options([{tmpdir, Dir} | L],  Opts) ->
326    case catch filename:absname(Dir) of
327        {'EXIT', _} ->
328            {badarg, Dir};
329        FileName ->
330            options(L, Opts#opts{tmpdir = {dir, FileName}})
331    end;
332options([{order, Fun} | L], Opts) when is_function(Fun), is_function(Fun, 2) ->
333    options(L, Opts#opts{order = Fun});
334options([{order, Order} | L], Opts) when Order =:= ascending;
335                                         Order =:= descending ->
336    options(L, Opts#opts{order = Order});
337options([{compressed, Bool} | L], Opts) when is_boolean(Bool) ->
338    options(L, Opts#opts{compressed = Bool});
339options([{unique, Bool} | L], Opts) when is_boolean(Bool) ->
340    options(L, Opts#opts{unique = Bool});
341options([{header, Len} | L], Opts)
342                when is_integer(Len), Len > 0, Len < ?MAXSIZE ->
343    options(L, Opts#opts{header = Len});
344options([], Opts) ->
345    if
346        Opts#opts.format =:= term, Opts#opts.header =/= 4 ->
347            {badarg, header};
348        true ->
349            Opts
350    end;
351options([Bad | _], _Opts) ->
352    {badarg, Bad};
353options(Bad, _Opts) ->
354    {badarg, Bad}.
355
356-define(OBJ(X, Y), {X, Y}).
357-define(SK(T, I), [T | I]). % stable key
358
359do_sort(KeyPos0, Input0, Output0, Opts, Do) ->
360    #opts{format = Format0, size = Size, no_files = NoFiles,
361          tmpdir = TmpDir, order = Order, compressed = Compressed,
362          unique = Unique, header = HdLen} = Opts,
363    Prefix = tmp_prefix(Output0, TmpDir),
364    ChunkSize = ?CHUNKSIZE,
365    Ref = make_ref(),
366    KeyPos = case KeyPos0 of [Kp] -> Kp; _ -> KeyPos0 end,
367    {Format, Input} = wrap_input(Format0, Do, Input0),
368    Z = if Compressed -> [compressed]; true -> [] end,
369    {Output, FunOut} = wrap_output_terms(Format0, Output0, Z),
370    W = #w{keypos = KeyPos, out = Output, fun_out = FunOut,
371           prefix = Prefix, format = Format, runsize = Size,
372           no_files = NoFiles, order = Order, chunksize = ChunkSize,
373           ref = Ref, z = Z, unique = Unique, hdlen = HdLen,
374           inout_value = no_value},
375    try
376        doit(Do, Input, W)
377    catch {Ref,Error} ->
378        Error
379    end.
380
381doit(sort, Input, W) ->
382    files(1, [], 0, W, Input);
383doit(merge, Input, W) ->
384    last_merge(Input, W);
385doit(check, Input, W) ->
386    check_files(Input, W, []).
387
388wrap_input(term, check, Files) ->
389    Fun = fun(File) ->
390                  Fn = merge_terms_fun(file_rterms(no_file, [File])),
391                  {fn, Fn, File}
392          end,
393    {binary_term_fun(), [Fun(F) || F <- Files]};
394wrap_input(Format, check, Files) ->
395    {Format, Files};
396wrap_input(term, merge, Files) ->
397    Fun = fun(File) -> merge_terms_fun(file_rterms(no_file, [File])) end,
398    Input = lists:reverse([Fun(F) || F <- Files]),
399    {binary_term_fun(), Input};
400wrap_input(Format, merge, Files) ->
401    Input = lists:reverse([merge_bins_fun(F) || F <- Files]),
402    {Format, Input};
403wrap_input(term, sort, InFun) when is_function(InFun, 1) ->
404    {binary_term_fun(), fun_rterms(InFun)};
405wrap_input(term, sort, Files) ->
406    {binary_term_fun(), file_rterms(no_file, Files)};
407wrap_input(Format, sort, Input) ->
408    {Format, Input}.
409
410merge_terms_fun(RFun) ->
411    fun(close) ->
412            RFun(close);
413       ({I, [], _LSz, W}) ->
414            case RFun(read) of
415                end_of_input ->
416                    eof;
417                {Objs, NRFun} when is_function(NRFun), is_function(NRFun, 1) ->
418                    {_, [], Ts, _} = fun_objs(Objs, [], 0, ?MAXSIZE, I, W),
419                    {{I, Ts, ?CHUNKSIZE}, merge_terms_fun(NRFun)};
420                Error ->
421                    error(Error, W)
422            end
423    end.
424
425merge_bins_fun(FileName) ->
426    fun(close) ->
427            ok;
428       ({_I, _L, _LSz, W} = A) ->
429            Fun = read_fun(FileName, user, W),
430            Fun(A)
431    end.
432
433wrap_output_terms(term, OutFun, _Z) when is_function(OutFun),
434                                         is_function(OutFun, 1) ->
435    {fun_wterms(OutFun), true};
436wrap_output_terms(term, File, Z) when File =/= undefined ->
437    {file_wterms(name, File, Z++[write]), false};
438wrap_output_terms(_Format, Output, _Z) ->
439    {Output, is_function(Output) and is_function(Output, 1)}.
440
441binary_term_fun() ->
442    fun binary_to_term/1.
443
444check_files([], _W, L) ->
445    {ok, lists:reverse(L)};
446check_files([FN | FNs], W, L) ->
447    {IFun, FileName} =
448        case FN of
449            {fn, Fun, File} ->
450                {Fun, File};
451            File ->
452                {read_fun(File, user, W), File}
453        end,
454    NW = W#w{in = IFun},
455    check_run(IFun, FileName, FNs, NW, L, 2, nolast).
456
457check_run(IFun, F, FNs, W, L, I, Last) ->
458    case IFun({{merge,I}, [], 0, W}) of
459        {{_I, Objs, _LSz}, IFun1} ->
460            NW = W#w{in = IFun1},
461            check_objs0(IFun1, F, FNs, NW, L, I, Last, lists:reverse(Objs));
462        eof ->
463            NW = W#w{in = undefined},
464            check_files(FNs, NW, L)
465    end.
466
467check_objs0(IFun, F, FNs, W, L, I, nolast, [?OBJ(T,_BT) | Os]) ->
468    check_objs1(IFun, F, FNs, W, L, I, T, Os);
469check_objs0(IFun, F, FNs, W, L, I, Last, []) ->
470    check_run(IFun, F, FNs, W, L, I, Last);
471check_objs0(IFun, F, FNs, W, L, I, {last, Last}, Os) ->
472    check_objs1(IFun, F, FNs, W, L, I, Last, Os).
473
474check_objs1(IFun, F, FNs, W, L, I, LastT, Os) ->
475    case W of
476        #w{order = ascending, unique = true} ->
477            ucheck_objs(IFun, F, FNs, W, L, I, LastT, Os);
478        #w{order = ascending, unique = false} ->
479            check_objs(IFun, F, FNs, W, L, I, LastT, Os);
480        #w{order = descending, unique = true} ->
481            rucheck_objs(IFun, F, FNs, W, L, I, LastT, Os);
482        #w{order = descending, unique = false} ->
483            rcheck_objs(IFun, F, FNs, W, L, I, LastT, Os);
484        #w{order = CF, unique = true} ->
485            uccheck_objs(IFun, F, FNs, W, L, I, LastT, Os, CF);
486        #w{order = CF, unique = false} ->
487            ccheck_objs(IFun, F, FNs, W, L, I, LastT, Os, CF)
488    end.
489
490check_objs(IFun, F, FNs, W, L, I, Last, [?OBJ(T,_BT) | Os]) when T >= Last ->
491    check_objs(IFun, F, FNs, W, L, I+1, T, Os);
492check_objs(IFun, F, FNs, W, L, I, _Last, [?OBJ(_T,BT) | _]) ->
493    culprit_found(IFun, F, FNs, W, L, I, BT);
494check_objs(IFun, F, FNs, W, L, I, Last, []) ->
495    check_run(IFun, F, FNs, W, L, I, {last, Last}).
496
497rcheck_objs(IFun, F, FNs, W, L, I, Last, [?OBJ(T,_BT) | Os]) when T =< Last ->
498    rcheck_objs(IFun, F, FNs, W, L, I+1, T, Os);
499rcheck_objs(IFun, F, FNs, W, L, I, _Last, [?OBJ(_T,BT) | _]) ->
500    culprit_found(IFun, F, FNs, W, L, I, BT);
501rcheck_objs(IFun, F, FNs, W, L, I, Last, []) ->
502    check_run(IFun, F, FNs, W, L, I, {last, Last}).
503
504ucheck_objs(IFun, F, FNs, W, L, I, LT, [?OBJ(T,_BT) | Os]) when T > LT ->
505    ucheck_objs(IFun, F, FNs, W, L, I+1, T, Os);
506ucheck_objs(IFun, F, FNs, W, L, I, _LT, [?OBJ(_T,BT) | _]) ->
507    culprit_found(IFun, F, FNs, W, L, I, BT);
508ucheck_objs(IFun, F, FNs, W, L, I, LT, []) ->
509    check_run(IFun, F, FNs, W, L, I, {last, LT}).
510
511rucheck_objs(IFun, F, FNs, W, L, I, LT, [?OBJ(T,_BT) | Os]) when T < LT ->
512    rucheck_objs(IFun, F, FNs, W, L, I+1, T, Os);
513rucheck_objs(IFun, F, FNs, W, L, I, _LT, [?OBJ(_T,BT) | _]) ->
514    culprit_found(IFun, F, FNs, W, L, I, BT);
515rucheck_objs(IFun, F, FNs, W, L, I, LT, []) ->
516    check_run(IFun, F, FNs, W, L, I, {last, LT}).
517
518ccheck_objs(IFun, F, FNs, W, L, I, LT, [?OBJ(T,BT) | Os], CF) ->
519    case CF(LT, T) of
520        true -> % LT =< T
521            ccheck_objs(IFun, F, FNs, W, L, I+1, T, Os, CF);
522        false -> % LT > T
523            culprit_found(IFun, F, FNs, W, L, I, BT)
524    end;
525ccheck_objs(IFun, F, FNs, W, L, I, LT, [], _CF) ->
526    check_run(IFun, F, FNs, W, L, I, {last, LT}).
527
528uccheck_objs(IFun, F, FNs, W, L, I, LT, [?OBJ(T,BT) | Os], CF) ->
529    case CF(LT, T) of
530        true -> % LT =< T
531            case CF(T, LT) of
532                true -> % T equal to LT
533                    culprit_found(IFun, F, FNs, W, L, I, BT);
534                false -> % LT < T
535                    uccheck_objs(IFun, F, FNs, W, L, I+1, T, Os, CF)
536            end;
537        false -> % LT > T
538            culprit_found(IFun, F, FNs, W, L, I, BT)
539    end;
540uccheck_objs(IFun, F, FNs, W, L, I, LT, [], _CF) ->
541    check_run(IFun, F, FNs, W, L, I, {last, LT}).
542
543culprit_found(IFun, F, FNs, W, L, I, [_Size | BT]) ->
544    IFun(close),
545    check_files(FNs, W, [{F,I,binary_to_term(BT)} | L]).
546
547files(_I, L, _LSz, #w{seq = 1, out = Out}=W, []) ->
548    %% No temporary files created, everything in L.
549    case Out of
550        Fun when is_function(Fun) ->
551            SL = internal_sort(L, W),
552            W1 = outfun(binterm_objects(SL, []), W),
553            NW = close_input(W1),
554            outfun(close, NW);
555        Out ->
556            write_run(L, W, Out),
557            ok
558    end;
559files(_I, L, _LSz, W, []) ->
560    W1 = write_run(L, W),
561    last_merge(lists:append(W1#w.runs), W1);
562files(I, L, LSz, W, Fun) when is_function(Fun) ->
563    NW = W#w{in = Fun},
564    fun_run(I, L, LSz, NW, []);
565files(I, L, LSz, W, [FileName | FileNames]) ->
566    InFun = read_fun(FileName, user, W),
567    NW = W#w{in = InFun},
568    file_run(InFun, FileNames, I, L, LSz, NW).
569
570file_run(InFun, FileNames, I, L, LSz, W) when LSz < W#w.runsize ->
571    case InFun({I, L, LSz, W}) of
572        {{I1, L1, LSz1}, InFun1} ->
573            NW = W#w{in = InFun1},
574            file_run(InFun1, FileNames, I1, L1, LSz1, NW);
575        eof ->
576            NW = W#w{in = undefined},
577            files(I, L, LSz, NW, FileNames)
578    end;
579file_run(InFun, FileNames, I, L, _LSz, W) ->
580    NW = write_run(L, W),
581    file_run(InFun, FileNames, I, [], 0, NW).
582
583fun_run(I, L, LSz, W, []) ->
584    case infun(W) of
585        {end_of_input, NW} ->
586            files(I, L, LSz, NW, []);
587        {cont, NW, Objs} ->
588            fun_run(I, L, LSz, NW, Objs)
589    end;
590fun_run(I, L, LSz, #w{runsize = Runsize}=W, Objs) when LSz < Runsize ->
591    {NI, NObjs, NL, NLSz} = fun_objs(Objs, L, LSz, Runsize, I, W),
592    fun_run(NI, NL, NLSz, W, NObjs);
593fun_run(I, L, _LSz, W, Objs) ->
594    NW = write_run(L, W),
595    fun_run(I, [], 0, NW, Objs).
596
597write_run([], W) ->
598    W;
599write_run(L, W) ->
600    {W1, Temp} = next_temp(W),
601    NW = write_run(L, W1, Temp),
602    [R | Rs] = NW#w.runs,
603    merge_runs([[Temp | R] | Rs], [], NW).
604
605write_run(L, W, FileName) ->
606    SL = internal_sort(L, W),
607    BTs = binterms(SL, []),
608    {Fd, W1} = open_file(FileName, W),
609    write(Fd, FileName, BTs, W1),
610    close_file(Fd, W1).
611
612%% Returns a list in reversed order.
613internal_sort([]=L, _W) ->
614    L;
615internal_sort(L, #w{order = CFun, unique = Unique}) when is_function(CFun) ->
616    Fun = fun(?OBJ(T1, _), ?OBJ(T2, _)) -> CFun(T1, T2) end,
617    RL = lists:reverse(L),
618    lists:reverse(if
619                      Unique ->
620                          lists:usort(Fun, RL);
621                      true ->
622                          lists:sort(Fun, RL)
623                  end);
624internal_sort(L, #w{unique = true, keypos = 0}=W) ->
625    rev(lists:usort(L), W);
626internal_sort(L, #w{unique = false, keypos = 0}=W) ->
627    rev(lists:sort(L), W);
628internal_sort(L, #w{unique = true}=W) ->
629    rev(lists:ukeysort(1, lists:reverse(L)), W);
630internal_sort(L, #w{unique = false}=W) ->
631    rev(lists:keysort(1, lists:reverse(L)), W).
632
633rev(L, #w{order = ascending}) ->
634    lists:reverse(L);
635rev(L, #w{order = descending}) ->
636    L.
637
638last_merge(R, W) when length(R) =< W#w.no_files ->
639    case W#w.out of
640        Fun when is_function(Fun) ->
641            {Fs, W1} = init_merge(lists:reverse(R), 1, [], W),
642            ?DEBUG("merging ~p~n", [lists:reverse(R)]),
643            W2 = merge_files(Fs, [], 0, nolast, W1),
644            NW = close_input(W2),
645            outfun(close, NW);
646        Out ->
647            merge_files(R, W, Out),
648            ok
649    end;
650last_merge(R, W) ->
651    L = lists:sublist(R, W#w.no_files),
652    {M, NW} = merge_files(L, W),
653    last_merge([M | lists:nthtail(W#w.no_files, R)], NW).
654
655merge_runs([R | Rs], NRs0, W) when length(R) < W#w.no_files ->
656    NRs = lists:reverse(NRs0) ++ [R | Rs],
657    W#w{runs = NRs};
658merge_runs([R], NRs0, W) ->
659    {M, NW} = merge_files(R, W),
660    NRs = [[] | lists:reverse([[M] | NRs0])],
661    NW#w{runs = NRs};
662merge_runs([R, R1 | Rs], NRs0, W) ->
663    {M, NW} = merge_files(R, W),
664    merge_runs([[M | R1] | Rs], [[] | NRs0], NW).
665
666merge_files(R, W) ->
667    {W1, Temp} = next_temp(W),
668    ?DEBUG("merging ~p~nto ~p~n", [lists:reverse(R), Temp]),
669    {Temp, merge_files(R, W1, Temp)}.
670
671merge_files(R, W, FileName) ->
672    {Fs, W1} = init_merge(lists:reverse(R), 1, [], W),
673    {Fd, W2} = open_file(FileName, W1),
674    W3 = W2#w{wfd = {Fd, FileName}},
675    W4 = merge_files(Fs, [], 0, nolast, W3),
676    NW = W4#w{wfd = undefined},
677    close_file(Fd, NW).
678
679%% A file number, I, is used for making the merge phase stable.
680init_merge([FN | FNs], I, Fs, W) ->
681    IFun = case FN of
682               _ when is_function(FN) ->
683                   %% When and only when merge/2,3 or keymerge/3,4 was called.
684                   FN;
685               _ ->
686                   read_fun(FN, fsort, W)
687           end,
688    W1 = W#w{temp = [IFun | lists:delete(FN, W#w.temp)]},
689    case read_more(IFun, I, 0, W1) of
690        {Ts, _LSz, NIFun, NW} ->
691            InEtc = {I, NIFun},
692            init_merge(FNs, I+1, [[Ts | InEtc] | Fs], NW);
693        {eof, NW} -> % can only happen when merging files
694            init_merge(FNs, I+1, Fs, NW)
695    end;
696init_merge([], _I, Fs0, #w{order = ascending}=W) ->
697    {lists:sort(Fs0), W};
698init_merge([], _I, Fs0, #w{order = descending}=W) ->
699    {lists:reverse(lists:sort(Fs0)), W};
700init_merge([], _I, Fs0, #w{order = Order}=W) when is_function(Order) ->
701    {lists:sort(cfun_files(W#w.order), lists:reverse(Fs0)), W}.
702
703cfun_files(CFun) ->
704    fun(F1, F2) ->
705            [[?OBJ(T1,_) | _] | _] = F1,
706            [[?OBJ(T2,_) | _] | _] = F2,
707            CFun(T1, T2)
708    end.
709
710%% The argument Last is used when unique = true. It is the last kept
711%% element.
712%% LSz is not the sum of the sizes of objects in L. Instead it is
713%% the number of bytes read. After init_merge it is set to 0, which
714%% means that the first chunk written may be quite large (it may take
715%% a while before buffers are exhausted).
716merge_files([F1, F2 | Fs], L0, LSz, Last0, W) when LSz < ?MERGESIZE ->
717    [Ts0 | InEtc] = F1,
718    Kind = merge_kind(W),
719    {Last, L, Ts} = case {Last0, Kind} of
720                        {{last, Lst}, Kind} ->
721                            {Lst, L0, Ts0};
722                        {nolast, {ukmerge, _Kp}} ->
723                            [?OBJ(?SK(T, _I), BT) | Ts1] = Ts0,
724                            {T, [BT], Ts1};
725                        {nolast, {rukmerge, _Kp}} ->
726                            [?OBJ(?SK(T, _I), BT) | Ts1] = Ts0,
727                            {{T, BT}, [], Ts1};
728                        {nolast, _} ->
729                            [?OBJ(T, BT) | Ts1] = Ts0,
730                            {T, [BT], Ts1}
731                    end,
732    [[?OBJ(T2, BT2) | Ts2T] = Ts2 | InEtc2] = F2,
733    {NInEtc, NFs, NL, NLast} =
734       case Kind of
735           umerge ->
736               umerge_files(L, F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Last);
737           {ukmerge, Kp} ->
738               ukmerge_files(L, F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Kp, Last);
739           merge ->
740               merge_files(L, F2, Fs, InEtc2, BT2, Ts2T, Ts, InEtc, T2);
741           rumerge ->
742               rumerge_files(L, F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Last);
743           {rukmerge, Kp} ->
744               {Lt, LtBT} = Last,
745               rukmerge_files(L, F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Kp,
746                              Lt, LtBT);
747           rmerge ->
748               rmerge_files(L, F2, Fs, InEtc2, BT2, Ts2T, Ts, InEtc, T2);
749           {ucmerge, CF} ->
750               {I2, _} = InEtc2,
751               {I, _} = InEtc,
752               ucmerge_files(L, F2, Fs, InEtc2, Ts2, I2, Ts, I, InEtc, T2, CF,
753                             Last);
754           {cmerge, CF} ->
755               {I2, _} = InEtc2,
756               {I, _} = InEtc,
757               cmerge_files(L, F2, Fs, InEtc2, BT2, Ts2T, I2, Ts, I, InEtc, T2,
758                            CF)
759       end,
760    read_chunk(NInEtc, NFs, NL, LSz, NLast, W);
761merge_files([F1], L, LSz, Last, W) when LSz < ?MERGESIZE ->
762    [Ts | InEtc] = F1,
763    NL = last_file(Ts, L, Last, merge_kind(W), W),
764    read_chunk(InEtc, [], NL, LSz, nolast, W);
765merge_files([], [], 0, nolast, W) ->
766    %% When merging files, ensure that the output fun (if there is
767    %% one) is called at least once before closing.
768    merge_write(W, []);
769merge_files([], L, _LSz, Last, W) ->
770    Last = nolast,
771    merge_write(W, L);
772merge_files(Fs, L, _LSz, Last, W) ->
773    NW = merge_write(W, L),
774    merge_files(Fs, [], 0, Last, NW).
775
776merge_kind(#w{order = ascending, unique = true, keypos = 0}) ->
777    umerge;
778merge_kind(#w{order = ascending, unique = true, keypos = Kp}) ->
779    {ukmerge, Kp};
780merge_kind(#w{order = ascending, unique = false}) ->
781    merge;
782merge_kind(#w{order = descending, unique = true, keypos = 0}) ->
783    rumerge;
784merge_kind(#w{order = descending, unique = true, keypos = Kp}) ->
785    {rukmerge, Kp};
786merge_kind(#w{order = descending, unique = false}) ->
787    rmerge;
788merge_kind(#w{order = CF, unique = true}) ->
789    {ucmerge, CF};
790merge_kind(#w{order = CF, unique = false}) ->
791    {cmerge, CF}.
792
793merge_write(W, L) ->
794     case {W#w.wfd, W#w.out} of
795         {undefined, Fun} when is_function(Fun) ->
796             outfun(objects(L, []), W);
797         {{Fd, FileName}, _} ->
798             write(Fd, FileName, lists:reverse(L), W),
799             W
800     end.
801
802umerge_files(L, F2, Fs, InEtc2, Ts2, [?OBJ(T, _BT) | Ts], InEtc, T2, Last)
803            when T == Last ->
804    umerge_files(L, F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Last);
805umerge_files(L, F2, Fs, InEtc2, Ts2, [?OBJ(T, BT) | Ts], InEtc, T2, _Last)
806            when T =< T2 ->
807    umerge_files([BT | L], F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, T);
808umerge_files(L, F2, Fs, _InEtc2, _Ts2, [], InEtc, _T2, Last) ->
809    {InEtc, [F2 | Fs], L, {last, Last}};
810umerge_files(L, _F2, Fs, InEtc2, Ts2, Ts, InEtc, _T2, Last) ->
811    [F3 | NFs] = insert([Ts | InEtc], Fs),
812    [[?OBJ(T3,_BT3) | _] = Ts3 | InEtc3] = F3,
813    umerge_files(L, F3, NFs, InEtc3, Ts3, Ts2, InEtc2, T3, Last).
814
815rumerge_files(L, F2, Fs, InEtc2, Ts2, [?OBJ(T, _BT) | Ts], InEtc, T2, Last)
816            when T == Last ->
817    rumerge_files(L, F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Last);
818rumerge_files(L, F2, Fs, InEtc2, Ts2, [?OBJ(T, BT) | Ts], InEtc, T2, _Last)
819            when T >= T2 ->
820    rumerge_files([BT | L], F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, T);
821rumerge_files(L, F2, Fs, _InEtc2, _Ts2, [], InEtc, _T2, Last) ->
822    {InEtc, [F2 | Fs], L, {last, Last}};
823rumerge_files(L, _F2, Fs, InEtc2, Ts2, Ts, InEtc, _T2, Last) ->
824    [F3 | NFs] = rinsert([Ts | InEtc], Fs),
825    [[?OBJ(T3,_BT3) | _] = Ts3 | InEtc3] = F3,
826    rumerge_files(L, F3, NFs, InEtc3, Ts3, Ts2, InEtc2, T3, Last).
827
828merge_files(L, F2, Fs, InEtc2, BT2, Ts2, [?OBJ(T, BT) | Ts], InEtc, T2)
829            when T =< T2 ->
830    merge_files([BT | L], F2, Fs, InEtc2, BT2, Ts2, Ts, InEtc, T2);
831merge_files(L, F2, Fs, _InEtc2, _BT2, _Ts2, [], InEtc, _T2) ->
832    {InEtc, [F2 | Fs], L, {last, foo}};
833merge_files(L, _F2, Fs, InEtc2, BT2, Ts2, Ts, InEtc, _T2) ->
834    L1 = [BT2 | L],
835    [F3 | NFs] = insert([Ts | InEtc], Fs),
836    [[?OBJ(T3,BT3) | Ts3] | InEtc3] = F3,
837    merge_files(L1, F3, NFs, InEtc3, BT3, Ts3, Ts2, InEtc2, T3).
838
839rmerge_files(L, F2, Fs, InEtc2, BT2, Ts2, [?OBJ(T, BT) | Ts], InEtc, T2)
840            when T >= T2 ->
841    rmerge_files([BT | L], F2, Fs, InEtc2, BT2, Ts2, Ts, InEtc, T2);
842rmerge_files(L, F2, Fs, _InEtc2, _BT2, _Ts2, [], InEtc, _T2) ->
843    {InEtc, [F2 | Fs], L, {last, foo}};
844rmerge_files(L, _F2, Fs, InEtc2, BT2, Ts2, Ts, InEtc, _T2) ->
845    L1 = [BT2 | L],
846    [F3 | NFs] = rinsert([Ts | InEtc], Fs),
847    [[?OBJ(T3,BT3) | Ts3] | InEtc3] = F3,
848    rmerge_files(L1, F3, NFs, InEtc3, BT3, Ts3, Ts2, InEtc2, T3).
849
850ukmerge_files(L, F2, Fs, InEtc2, Ts2, [?OBJ(?SK(T, _I),_BT) | Ts], InEtc,
851              T2, Kp, Last) when T == Last ->
852    ukmerge_files(L, F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Kp, Last);
853ukmerge_files(L, F2, Fs, InEtc2, Ts2, [?OBJ(?SK(T0,_I)=T,BT) | Ts], InEtc,
854              T2, Kp, _Last) when T =< T2 ->
855    ukmerge_files([BT | L], F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Kp, T0);
856ukmerge_files(L, F2, Fs, _InEtc2, _Ts2, [], InEtc, _T2, _Kp, Last) ->
857    {InEtc, [F2 | Fs], L, {last, Last}};
858ukmerge_files(L, _F2, Fs, InEtc2, Ts2, Ts, InEtc, _T2, Kp, Last) ->
859    [F3 | NFs] = insert([Ts | InEtc], Fs),
860    [[?OBJ(T3,_BT3) | _] = Ts3 | InEtc3] = F3,
861    ukmerge_files(L, F3, NFs, InEtc3, Ts3, Ts2, InEtc2, T3, Kp, Last).
862
863rukmerge_files(L, F2, Fs, InEtc2, Ts2, [?OBJ(?SK(T, _I), BT) | Ts], InEtc,
864               T2, Kp, Last, _LastBT) when T == Last ->
865    rukmerge_files(L, F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Kp, T, BT);
866rukmerge_files(L, F2, Fs, InEtc2, Ts2, [?OBJ(?SK(T0, _I)=T, BT) | Ts], InEtc,
867               T2, Kp, _Last, LastBT) when T >= T2 ->
868    rukmerge_files([LastBT|L], F2, Fs, InEtc2, Ts2, Ts, InEtc, T2, Kp, T0,BT);
869rukmerge_files(L, F2, Fs, _InEtc2, _Ts2, [], InEtc, _T2, _Kp, Last, LastBT) ->
870    {InEtc, [F2 | Fs], L, {last, {Last, LastBT}}};
871rukmerge_files(L, _F2, Fs, InEtc2, Ts2, Ts, InEtc, _T2, Kp, Last, LastBT) ->
872    [F3 | NFs] = rinsert([Ts | InEtc], Fs),
873    [[?OBJ(T3,_BT3) | _] = Ts3 | InEtc3] = F3,
874    rukmerge_files(L, F3, NFs, InEtc3, Ts3, Ts2, InEtc2, T3, Kp, Last,LastBT).
875
876ucmerge_files(L, F2, Fs, InEtc2, Ts2, I2, [?OBJ(T, BT) | Ts] = Ts0, I,
877              InEtc, T2, CF, Last) when I < I2 ->
878    case CF(T, T2) of
879        true -> % T =< T2
880            case CF(T, Last) of
881                true ->
882                    ucmerge_files(L, F2, Fs, InEtc2, Ts2, I2, Ts, I, InEtc, T2,
883                                  CF, Last);
884                false ->
885                    ucmerge_files([BT | L], F2, Fs, InEtc2, Ts2, I2, Ts, I,
886                                  InEtc, T2, CF, T)
887            end;
888       false -> % T > T2
889          [F3 | NFs] = cinsert([Ts0 | InEtc], Fs, CF),
890          [[?OBJ(T3,_BT3) | _] = Ts3 | {I3,_} = InEtc3] = F3,
891          ucmerge_files(L, F3, NFs, InEtc3, Ts3, I3, Ts2, I2, InEtc2, T3, CF, Last)
892    end;
893ucmerge_files(L, F2, Fs, InEtc2, Ts2, I2, [?OBJ(T, BT) | Ts] = Ts0, I,
894              InEtc, T2, CF, Last) -> % when I2 < I
895    case CF(T2, T) of
896        true -> % T2 =< T
897            [F3 | NFs] = cinsert([Ts0 | InEtc], Fs, CF),
898            [[?OBJ(T3,_BT3) | _] = Ts3 | {I3,_} = InEtc3] = F3,
899            ucmerge_files(L, F3, NFs, InEtc3, Ts3, I3, Ts2, I2, InEtc2, T3,
900                          CF, Last);
901       false -> % T < T2
902            case CF(T, Last) of
903                true ->
904                    ucmerge_files(L, F2, Fs, InEtc2, Ts2, I2, Ts, I, InEtc, T2,
905                                  CF, Last);
906                false ->
907                    ucmerge_files([BT | L], F2, Fs, InEtc2, Ts2, I2, Ts, I,
908                                  InEtc, T2, CF, T)
909            end
910    end;
911ucmerge_files(L, F2, Fs, _InEtc2, _Ts2, _I2, [], _I, InEtc, _T2, _CF, Last) ->
912    {InEtc, [F2 | Fs], L, {last, Last}}.
913
914cmerge_files(L, F2, Fs, InEtc2, BT2, Ts2, I2, [?OBJ(T, BT) | Ts] = Ts0, I,
915             InEtc, T2, CF) when I < I2 ->
916    case CF(T, T2) of
917       true -> % T =< T2
918          cmerge_files([BT|L], F2, Fs, InEtc2, BT2, Ts2, I2, Ts, I, InEtc, T2, CF);
919       false -> % T > T2
920          L1 = [BT2 | L],
921          [F3 | NFs] = cinsert([Ts0 | InEtc], Fs, CF),
922          [[?OBJ(T3,BT3) | Ts3] | {I3,_} = InEtc3] = F3,
923          cmerge_files(L1, F3, NFs, InEtc3, BT3, Ts3, I3, Ts2, I2, InEtc2, T3, CF)
924    end;
925cmerge_files(L, F2, Fs, InEtc2, BT2, Ts2, I2, [?OBJ(T, BT) | Ts] = Ts0, I,
926             InEtc, T2, CF) -> % when I2 < I
927    case CF(T2, T) of
928       true -> % T2 =< T
929          L1 = [BT2 | L],
930          [F3 | NFs] = cinsert([Ts0 | InEtc], Fs, CF),
931          [[?OBJ(T3,BT3) | Ts3] | {I3,_} = InEtc3] = F3,
932          cmerge_files(L1, F3, NFs, InEtc3, BT3, Ts3, I3, Ts2, I2, InEtc2, T3, CF);
933       false -> % T < T2
934          cmerge_files([BT|L], F2, Fs, InEtc2, BT2, Ts2, I2, Ts, I, InEtc, T2, CF)
935    end;
936cmerge_files(L, F2, Fs, _InEtc2, _BT2, _Ts2, _I2, [], _I, InEtc, _T2, _CF) ->
937    {InEtc, [F2 | Fs], L, {last, foo}}.
938
939last_file(Ts, L, {last, T}, {ukmerge,_}, _W) ->
940    kulast_file(Ts, T, L);
941last_file(Ts, L, {last, {T,BT}}, {rukmerge,_}, _W) ->
942    ruklast_file(Ts, T, BT, L);
943last_file(Ts, L, {last, T}, {ucmerge,CF}, _W) ->
944    uclast_file(Ts, T, CF, L);
945last_file(Ts, L, {last, T}, _Kind, #w{unique = true}) ->
946    ulast_file(Ts, T, L);
947last_file(Ts, L, _Last, _Kind, _W) ->
948    last_file(Ts, L).
949
950ulast_file([?OBJ(T, _BT) | Ts], Last, L) when Last == T ->
951    last_file(Ts, L);
952ulast_file(Ts, _Last, L) ->
953    last_file(Ts, L).
954
955kulast_file([?OBJ(?SK(T, _I), _BT) | Ts], Last, L) when Last == T ->
956    last_file(Ts, L);
957kulast_file(Ts, _Last, L) ->
958    last_file(Ts, L).
959
960ruklast_file([?OBJ(?SK(T, _I), BT) | Ts], Last, _LastBT, L) when Last == T ->
961    last_file(Ts, [BT | L]);
962ruklast_file(Ts, _Last, LastBT, L) ->
963    last_file(Ts, [LastBT | L]).
964
965uclast_file([?OBJ(T, BT) | Ts], Last, CF, L) ->
966    case CF(T, Last) of
967        true ->
968            last_file(Ts, L);
969        false ->
970            last_file(Ts, [BT | L])
971    end.
972
973last_file([?OBJ(_Ta, BTa), ?OBJ(_Tb, BTb) | Ts], L) ->
974    last_file(Ts, [BTb, BTa | L]);
975last_file([?OBJ(_T, BT) | Ts], L) ->
976    last_file(Ts, [BT | L]);
977last_file([], L) ->
978    L.
979
980%% OK for 16 files.
981insert(A, [X1, X2, X3, X4 | Xs]) when A > X4 ->
982    [X1, X2, X3, X4 | insert(A, Xs)];
983insert(A, [X1, X2, X3 | T]) when A > X3 ->
984    [X1, X2, X3, A | T];
985insert(A, [X1, X2 | Xs]) when A > X2 ->
986    [X1, X2, A | Xs];
987insert(A, [X1 | T]) when A > X1 ->
988    [X1, A | T];
989insert(A, Xs) ->
990    [A | Xs].
991
992rinsert(A, [X1, X2, X3, X4 | Xs]) when A < X4 ->
993    [X1, X2, X3, X4 | rinsert(A, Xs)];
994rinsert(A, [X1, X2, X3 | T]) when A < X3 ->
995    [X1, X2, X3, A | T];
996rinsert(A, [X1, X2 | Xs]) when A < X2 ->
997    [X1, X2, A | Xs];
998rinsert(A, [X1 | T]) when A < X1 ->
999    [X1, A | T];
1000rinsert(A, Xs) ->
1001    [A | Xs].
1002
1003-define(CINSERT(F, A, T1, T2),
1004        case cfun(CF, F, A) of
1005            true -> [F, A | T2];
1006            false -> [A | T1]
1007        end).
1008
1009cinsert(A, [F1 | [F2 | [F3 | [F4 | Fs]=T4]=T3]=T2]=T1, CF) ->
1010    case cfun(CF, F4, A) of
1011        true -> [F1, F2, F3, F4 | cinsert(A, Fs, CF)];
1012        false ->
1013            case cfun(CF, F2, A) of
1014                true -> [F1, F2 | ?CINSERT(F3, A, T3, T4)];
1015                false -> ?CINSERT(F1, A, T1, T2)
1016            end
1017    end;
1018cinsert(A, [F1 | [F2 | Fs]=T2]=T1, CF) ->
1019    case cfun(CF, F2, A) of
1020        true -> [F1, F2 | cinsert(A, Fs, CF)];
1021        false -> ?CINSERT(F1, A, T1, T2)
1022    end;
1023cinsert(A, [F | Fs]=T, CF) ->
1024    ?CINSERT(F, A, T, Fs);
1025cinsert(A, _, _CF) ->
1026    [A].
1027
1028%% Inlined.
1029cfun(CF, F1, F2) ->
1030    [[?OBJ(T1,_) | _] | {I1,_}] = F1,
1031    [[?OBJ(T2,_) | _] | {I2,_}] = F2,
1032    if
1033        I1 < I2 ->
1034            CF(T1, T2);
1035        true -> % I2 < I1
1036            not CF(T2, T1)
1037    end.
1038
1039binterm_objects([?OBJ(_T, [_Sz | BT]) | Ts], L) ->
1040    binterm_objects(Ts, [BT | L]);
1041binterm_objects([], L) ->
1042    L.
1043
1044objects([[_Sz | BT] | Ts], L) ->
1045    objects(Ts, [BT | L]);
1046objects([], L) ->
1047    L.
1048
1049binterms([?OBJ(_T1, BT1), ?OBJ(_T2, BT2) | Ts], L) ->
1050    binterms(Ts, [BT2, BT1 | L]);
1051binterms([?OBJ(_T, BT) | Ts], L) ->
1052    binterms(Ts, [BT | L]);
1053binterms([], L) ->
1054    L.
1055
1056read_chunk(InEtc, Fs, L, LSz, Last, W) ->
1057    {I, IFun} = InEtc,
1058    case read_more(IFun, I, LSz, W) of
1059        {Ts, NLSz, NIFun, #w{order = ascending}=NW} ->
1060            NInEtc = {I, NIFun},
1061            NFs = insert([Ts | NInEtc], Fs),
1062            merge_files(NFs, L, NLSz, Last, NW);
1063        {Ts, NLSz, NIFun, #w{order = descending}=NW} ->
1064            NInEtc = {I, NIFun},
1065            NFs = rinsert([Ts | NInEtc], Fs),
1066            merge_files(NFs, L, NLSz, Last, NW);
1067        {Ts, NLSz, NIFun, NW} ->
1068            NInEtc = {I, NIFun},
1069            NFs = cinsert([Ts | NInEtc], Fs, NW#w.order),
1070            merge_files(NFs, L, NLSz, Last, NW);
1071        {eof, NW} ->
1072            merge_files(Fs, L, LSz, Last, NW)
1073    end.
1074
1075%% -> {[{term() | binary()}], NewLSz, NewIFun, NewW} | eof | throw(Error)
1076read_more(IFun, I, LSz, W) ->
1077    case IFun({{merge, I}, [], LSz, W}) of
1078        {{_, [], NLSz}, NIFun} ->
1079            read_more(NIFun, I, NLSz, W);
1080        {{_, L, NLSz}, NInFun} ->
1081            NW = case lists:member(IFun, W#w.temp) of
1082                     true ->
1083                         %% temporary file
1084                         W#w{temp = [NInFun | lists:delete(IFun, W#w.temp)]};
1085                     false ->
1086                         %% input file
1087                         W
1088                 end,
1089            {lists:reverse(L), NLSz, NInFun, NW};
1090        eof ->
1091            %% already closed.
1092            NW = W#w{temp = lists:delete(IFun, W#w.temp)},
1093            {eof, NW}
1094    end.
1095
1096read_fun(FileName, Owner, W) ->
1097    case file:open(FileName, [raw, binary, read]) of
1098        {ok, Fd} ->
1099            read_fun2(Fd, <<>>, 0, FileName, Owner);
1100        Error ->
1101            file_error(FileName, Error, W)
1102    end.
1103
1104read_fun2(Fd, Bin, Size, FileName, Owner) ->
1105    fun(close) ->
1106            close_read_fun(Fd, FileName, Owner);
1107       ({I, L, LSz, W}) ->
1108            case read_objs(Fd, FileName, I, L, Bin, Size, LSz, W) of
1109                {{I1, L1, Bin1, Size1}, LSz1} ->
1110                    NIFun = read_fun2(Fd, Bin1, Size1, FileName, Owner),
1111                    {{I1, L1, LSz1}, NIFun};
1112                eof ->
1113                    close_read_fun(Fd, FileName, Owner),
1114                    eof
1115            end
1116    end.
1117
1118close_read_fun(Fd, _FileName, user) ->
1119    file:close(Fd);
1120close_read_fun(Fd, FileName, fsort) ->
1121    file:close(Fd),
1122    file:delete(FileName).
1123
1124read_objs(Fd, FileName, I, L, Bin0, Size0, LSz, W) ->
1125    Max = erlang:max(Size0, ?CHUNKSIZE),
1126    BSz0 = byte_size(Bin0),
1127    Min = Size0 - BSz0 + W#w.hdlen, % Min > 0
1128    NoBytes = erlang:max(Min, Max),
1129    case read(Fd, FileName, NoBytes, W) of
1130        {ok, Bin} ->
1131            BSz = byte_size(Bin),
1132            NLSz = LSz + BSz,
1133            case catch file_loop(L, I, Bin0, Bin, Size0, BSz0, BSz, Min, W)
1134                of
1135                {'EXIT', _R} ->
1136                    error({error, {bad_object, FileName}}, W);
1137                Reply ->
1138                    {Reply, NLSz}
1139            end;
1140        eof when byte_size(Bin0) =:= 0 ->
1141            eof;
1142        eof ->
1143            error({error, {premature_eof, FileName}}, W)
1144    end.
1145
1146file_loop(L, I, _B1, B2, Sz, 0, _B2Sz, _Min, W) ->
1147    file_loop(L, I, B2, Sz, W);
1148file_loop(L, I, B1, B2, Sz, _B1Sz, B2Sz, Min, W) when B2Sz > Min ->
1149    {B3, B4} = split_binary(B2, Min),
1150    {I1, L1, <<>>, Sz1} = file_loop(L, I, list_to_binary([B1, B3]), Sz, W),
1151    file_loop(L1, I1, B4, Sz1, W);
1152file_loop(L, I, B1, B2, Sz, _B1Sz, _B2Sz, _Min, W) ->
1153    file_loop(L, I, list_to_binary([B1, B2]), Sz, W).
1154
1155file_loop(L, I, B, Sz, W) ->
1156    #w{keypos = Kp, format = Format, hdlen = HdLen} = W,
1157    file_loop1(L, I, B, Sz, Kp, Format, HdLen).
1158
1159file_loop1(L, I, HB, 0, Kp, F, HdLen) ->
1160    <<Size:HdLen/unit:8, B/binary>> = HB,
1161    file_loop2(L, I, B, Size, <<Size:HdLen/unit:8>>, Kp, F, HdLen);
1162file_loop1(L, I, B, Sz, Kp, F, HdLen) ->
1163    file_loop2(L, I, B, Sz, <<Sz:HdLen/unit:8>>, Kp, F, HdLen).
1164
1165file_loop2(L, _I, B, Sz, SzB, 0, binary, HdLen) ->
1166    {NL, NB, NSz, NSzB} = file_binloop(L, Sz, SzB, B, HdLen),
1167    if
1168        byte_size(NB) =:= NSz ->
1169            <<Bin:NSz/binary>> = NB,
1170            {0, [?OBJ(Bin, [NSzB | Bin]) | NL], <<>>, 0};
1171        true ->
1172            {0, NL, NB, NSz}
1173    end;
1174file_loop2(L, _I, B, Sz, SzB, 0, Fun, HdLen) ->
1175    file_binterm_loop(L, Sz, SzB, B, Fun, HdLen);
1176file_loop2(L, {merge, I}, B, Sz, SzB, Kp, Fun, HdLen) -> % when Kp =/= 0
1177    merge_loop(Kp, I, L, Sz, SzB, B, Fun, HdLen);
1178file_loop2(L, I, B, Sz, SzB, Kp, Fun, HdLen) when is_integer(I) ->
1179    key_loop(Kp, I, L, Sz, SzB, B, Fun, HdLen).
1180
1181file_binloop(L, Size, SizeB, B, HL) ->
1182    case B of
1183        <<Bin:Size/binary, NSizeB:HL/binary, R/binary>> ->
1184            <<NSize:HL/unit:8>> = NSizeB,
1185            file_binloop([?OBJ(Bin, [SizeB | Bin]) | L], NSize, NSizeB, R, HL);
1186        _ ->
1187            {L, B, Size, SizeB}
1188    end.
1189
1190file_binterm_loop(L, Size, SizeB, B, Fun, HL) ->
1191    case B of
1192        <<BinTerm:Size/binary, NSizeB:HL/binary, R/binary>> ->
1193            <<NSize:HL/unit:8>> = NSizeB,
1194            BT = [SizeB | BinTerm],
1195            Term = Fun(BinTerm),
1196            file_binterm_loop([?OBJ(Term, BT) | L], NSize, NSizeB, R, Fun, HL);
1197        <<BinTerm:Size/binary>> ->
1198            Term = Fun(BinTerm),
1199            NL = [?OBJ(Term, [SizeB | BinTerm]) | L],
1200            {0, NL, <<>>, 0};
1201        _ ->
1202            {0, L, B, Size}
1203    end.
1204
1205key_loop(KeyPos, I, L, Size, SizeB, B, Fun, HL) ->
1206    case B of
1207        <<BinTerm:Size/binary, NSizeB:HL/binary, R/binary>> ->
1208            <<NSize:HL/unit:8>> = NSizeB,
1209            BT = [SizeB | BinTerm],
1210            UniqueKey = make_key(KeyPos, Fun(BinTerm)),
1211            E = ?OBJ(UniqueKey, BT),
1212            key_loop(KeyPos, I+1, [E | L], NSize, NSizeB, R, Fun, HL);
1213        <<BinTerm:Size/binary>> ->
1214            UniqueKey = make_key(KeyPos, Fun(BinTerm)),
1215            NL = [?OBJ(UniqueKey, [SizeB | BinTerm]) | L],
1216            {I+1, NL, <<>>, 0};
1217        _ ->
1218            {I, L, B, Size}
1219    end.
1220
1221merge_loop(KeyPos, I, L, Size, SizeB, B, Fun, HL) ->
1222    case B of
1223        <<BinTerm:Size/binary, NSizeB:HL/binary, R/binary>> ->
1224            <<NSize:HL/unit:8>> = NSizeB,
1225            BT = [SizeB | BinTerm],
1226            UniqueKey = make_stable_key(KeyPos, I, Fun(BinTerm)),
1227            E = ?OBJ(UniqueKey, BT),
1228            merge_loop(KeyPos, I, [E | L], NSize, NSizeB, R, Fun, HL);
1229        <<BinTerm:Size/binary>> ->
1230            UniqueKey = make_stable_key(KeyPos, I, Fun(BinTerm)),
1231            NL = [?OBJ(UniqueKey, [SizeB | BinTerm]) | L],
1232            {{merge, I}, NL, <<>>, 0};
1233        _ ->
1234            {{merge, I}, L, B, Size}
1235    end.
1236
1237fun_objs(Objs, L, LSz, NoBytes, I, W) ->
1238    #w{keypos = Keypos, format = Format, hdlen = HL} = W,
1239    case catch fun_loop(Objs, L, LSz, NoBytes, I, Keypos, Format, HL) of
1240        {'EXIT', _R} ->
1241            error({error, bad_object}, W);
1242        Reply ->
1243            Reply
1244    end.
1245
1246fun_loop(Objs, L, LSz, RunSize, _I, 0, binary, HdLen) ->
1247    fun_binloop(Objs, L, LSz, RunSize, HdLen);
1248fun_loop(Objs, L, LSz, RunSize, _I, 0, Fun, HdLen) ->
1249    fun_loop(Objs, L, LSz, RunSize, Fun, HdLen);
1250fun_loop(Objs, L, LSz, RunSize, {merge, I}, Keypos, Fun, HdLen) ->
1251    fun_mergeloop(Objs, L, LSz, RunSize, I, Keypos, Fun, HdLen);
1252fun_loop(Objs, L, LSz, RunSize, I, Keypos, Fun, HdLen) when is_integer(I) ->
1253    fun_keyloop(Objs, L, LSz, RunSize, I, Keypos, Fun, HdLen).
1254
1255fun_binloop([B | Bs], L, LSz, RunSize, HL) when LSz < RunSize ->
1256    Size = byte_size(B),
1257    Obj = ?OBJ(B, [<<Size:HL/unit:8>> | B]),
1258    fun_binloop(Bs, [Obj | L], LSz+Size, RunSize, HL);
1259fun_binloop(Bs, L, LSz, _RunSize, _HL) ->
1260    {0, Bs, L, LSz}.
1261
1262fun_loop([B | Bs], L, LSz, RunSize, Fun, HL) when LSz < RunSize ->
1263    Size = byte_size(B),
1264    Obj = ?OBJ(Fun(B), [<<Size:HL/unit:8>> | B]),
1265    fun_loop(Bs, [Obj | L], LSz+Size, RunSize, Fun, HL);
1266fun_loop(Bs, L, LSz, _RunSize, _Fun, _HL) ->
1267    {0, Bs, L, LSz}.
1268
1269fun_keyloop([B | Bs], L, LSz, RunSize, I, Kp, Fun, HL) when LSz < RunSize ->
1270    Size = byte_size(B),
1271    UniqueKey = make_key(Kp, Fun(B)),
1272    E = ?OBJ(UniqueKey, [<<Size:HL/unit:8>> | B]),
1273    fun_keyloop(Bs, [E | L], LSz+Size, RunSize, I+1, Kp, Fun, HL);
1274fun_keyloop(Bs, L, LSz, _RunSize, I, _Kp, _Fun, _HL) ->
1275    {I, Bs, L, LSz}.
1276
1277fun_mergeloop([B | Bs], L, LSz, RunSize, I, Kp, Fun, HL) when LSz < RunSize ->
1278    Size = byte_size(B),
1279    UniqueKey = make_stable_key(Kp, I, Fun(B)),
1280    E = ?OBJ(UniqueKey, [<<Size:HL/unit:8>> | B]),
1281    fun_mergeloop(Bs, [E | L], LSz+Size, RunSize, I, Kp, Fun, HL);
1282fun_mergeloop(Bs, L, LSz, _RunSize, I, _Kp, _Fun, _HL) ->
1283    {{merge, I}, Bs, L, LSz}. % any I would do
1284
1285%% Inlined.
1286make_key(Kp, T) when is_integer(Kp) ->
1287    element(Kp, T);
1288make_key([Kp1, Kp2], T) ->
1289    [element(Kp1, T), element(Kp2, T)];
1290make_key([Kp1, Kp2 | Kps], T) ->
1291    [element(Kp1, T), element(Kp2, T) | make_key2(Kps, T)].
1292
1293%% Inlined.
1294%% A sequence number (I) is used for making the internal sort stable.
1295%% I is ordering number of the file from which T was read.
1296make_stable_key(Kp, I, T) when is_integer(Kp) ->
1297    ?SK(element(Kp, T), I);
1298make_stable_key([Kp1, Kp2], I, T) ->
1299    ?SK([element(Kp1, T) | element(Kp2, T)], I);
1300make_stable_key([Kp1, Kp2 | Kps], I, T) ->
1301    ?SK([element(Kp1, T), element(Kp2, T) | make_key2(Kps, T)], I).
1302
1303make_key2([Kp], T) ->
1304    [element(Kp, T)];
1305make_key2([Kp | Kps], T) ->
1306    [element(Kp, T) | make_key2(Kps, T)].
1307
1308infun(W) ->
1309    W1 = W#w{in = undefined},
1310    try (W#w.in)(read) of
1311        end_of_input ->
1312            {end_of_input, W1};
1313        {end_of_input, Value} ->
1314            {end_of_input, W1#w{inout_value = {value, Value}}};
1315        {Objs, NFun} when is_function(NFun),
1316                          is_function(NFun, 1),
1317                          is_list(Objs) ->
1318            {cont, W#w{in = NFun}, Objs};
1319        Error ->
1320            error(Error, W1)
1321    catch Class:Reason ->
1322        cleanup(W1),
1323        erlang:raise(Class, Reason, erlang:get_stacktrace())
1324    end.
1325
1326outfun(A, #w{inout_value = Val} = W) when Val =/= no_value ->
1327    W1 = W#w{inout_value = no_value},
1328    W2 = if
1329             W1#w.fun_out ->
1330                 outfun(Val, W1);
1331             true -> W1
1332         end,
1333    outfun(A, W2);
1334outfun(A, W) ->
1335    W1 = W#w{out = undefined},
1336    try (W#w.out)(A) of
1337        Reply when A =:= close ->
1338            Reply;
1339        NF when is_function(NF), is_function(NF, 1) ->
1340            W#w{out = NF};
1341        Error ->
1342            error(Error, W1)
1343    catch Class:Reason ->
1344        cleanup(W1),
1345        erlang:raise(Class, Reason, erlang:get_stacktrace())
1346    end.
1347
1348is_keypos(Keypos) when is_integer(Keypos), Keypos > 0 ->
1349    true;
1350is_keypos([]) ->
1351    {badarg, []};
1352is_keypos(L) ->
1353    is_keyposs(L).
1354
1355is_keyposs([Kp | Kps]) when is_integer(Kp), Kp > 0 ->
1356    is_keyposs(Kps);
1357is_keyposs([]) ->
1358    true;
1359is_keyposs([Bad | _]) ->
1360    {badarg, Bad};
1361is_keyposs(Bad) ->
1362    {badarg, Bad}.
1363
1364is_input(Fun) when is_function(Fun), is_function(Fun, 1) ->
1365    {true, Fun};
1366is_input(Files) ->
1367    is_files(Files).
1368
1369is_files(Fs) ->
1370    is_files(Fs, []).
1371
1372is_files([F | Fs], L) ->
1373    case read_file_info(F) of
1374        {ok, File, _FI} ->
1375            is_files(Fs, [File | L]);
1376        Error ->
1377            Error
1378    end;
1379is_files([], L) ->
1380    {true, lists:reverse(L)};
1381is_files(Bad, _L) ->
1382    {badarg, Bad}.
1383
1384maybe_output(Fun) when is_function(Fun), is_function(Fun, 1) ->
1385    {true, Fun};
1386maybe_output(File) ->
1387    case read_file_info(File) of
1388        {badarg, _File} = Badarg ->
1389            Badarg;
1390        {ok, FileName, _FileInfo} ->
1391            {true, FileName};
1392        {error, {file_error, FileName, _Reason}} ->
1393            {true, FileName}
1394    end.
1395
1396read_file_info(File) ->
1397    %% Absolute names in case some process should call file:set_cwd/1.
1398    case catch filename:absname(File) of
1399        {'EXIT', _} ->
1400            {badarg, File};
1401        FileName ->
1402            case file:read_file_info(FileName) of
1403                {ok, FileInfo} ->
1404                    {ok, FileName, FileInfo};
1405                {error, einval} ->
1406                    {badarg, File};
1407                {error, Reason} ->
1408                    {error, {file_error, FileName, Reason}}
1409            end
1410    end.
1411
1412%% No attempt is made to avoid overwriting existing files.
1413next_temp(W) ->
1414    Seq = W#w.seq,
1415    NW = W#w{seq = Seq + 1},
1416    Temp = lists:concat([W#w.prefix, Seq]),
1417    {NW, Temp}.
1418
1419%% Would use the temporary directory (TMP|TEMP|TMPDIR), were it
1420%% readily accessible.
1421tmp_prefix(F, TmpDirOpt) when is_function(F); F =:= undefined ->
1422    {ok, CurDir} = file:get_cwd(),
1423    tmp_prefix1(CurDir, TmpDirOpt);
1424tmp_prefix(OutFile, TmpDirOpt) ->
1425    Dir = filename:dirname(OutFile),
1426    tmp_prefix1(Dir, TmpDirOpt).
1427
1428tmp_prefix1(Dir, TmpDirOpt) ->
1429    U = "_",
1430    Node = node(),
1431    Pid = os:getpid(),
1432    {MSecs,Secs,MySecs} = now(),
1433    F = lists:concat(["fs_",Node,U,Pid,U,MSecs,U,Secs,U,MySecs,"."]),
1434    TmpDir = case TmpDirOpt of
1435                 default ->
1436                     Dir;
1437                 {dir, TDir} ->
1438                     TDir
1439             end,
1440    filename:join(filename:absname(TmpDir), F).
1441
1442%% -> {Fd, NewW} | throw(Error)
1443open_file(FileName, W) ->
1444    case file:open(FileName, W#w.z ++ [raw, binary, write]) of
1445        {ok, Fd}  ->
1446            {Fd, W#w{temp = [{Fd,FileName} | W#w.temp]}};
1447        Error ->
1448            file_error(FileName, Error, W)
1449    end.
1450
1451read(Fd, FileName, N, W) ->
1452    case file:read(Fd, N) of
1453        {ok, Bin} ->
1454            {ok, Bin};
1455        eof ->
1456            eof;
1457        {error, enomem} ->
1458            %% Bad N
1459            error({error, {bad_object, FileName}}, W);
1460        {error, einval} ->
1461            %% Bad N
1462            error({error, {bad_object, FileName}}, W);
1463        Error ->
1464            file_error(FileName, Error, W)
1465    end.
1466
1467write(Fd, FileName, B, W) ->
1468    case file:write(Fd, B) of
1469        ok ->
1470            ok;
1471        Error ->
1472            file_error(FileName, Error, W)
1473    end.
1474
1475-spec file_error(_, {'error',atom()}, #w{}) -> no_return().
1476
1477file_error(File, {error, Reason}, W) ->
1478    error({error, {file_error, File, Reason}}, W).
1479
1480error(Error, W) ->
1481    cleanup(W),
1482    throw({W#w.ref, Error}).
1483
1484cleanup(W) ->
1485    close_out(W),
1486    W1 = close_input(W),
1487    F = fun(IFun) when is_function(IFun) ->
1488                IFun(close);
1489           ({Fd,FileName}) ->
1490                file:close(Fd),
1491                file:delete(FileName);
1492           (FileName) ->
1493                file:delete(FileName)
1494        end,
1495    lists:foreach(F, W1#w.temp).
1496
1497close_input(#w{in = In}=W) when is_function(In) ->
1498    catch In(close),
1499    W#w{in = undefined};
1500close_input(#w{in = undefined}=W) ->
1501    W.
1502
1503close_out(#w{out = Out}) when is_function(Out) ->
1504    catch Out(close);
1505close_out(_) ->
1506    ok.
1507
1508close_file(Fd, W) ->
1509    {Fd, FileName} = lists:keyfind(Fd, 1, W#w.temp),
1510    ?DEBUG("closing ~p~n", [FileName]),
1511    file:close(Fd),
1512    W#w{temp = [FileName | lists:keydelete(Fd, 1, W#w.temp)]}.
1513
1514%%%
1515%%% Format 'term'.
1516%%%
1517
1518file_rterms(no_file, Files) ->
1519    fun(close) ->
1520            ok;
1521       (read) when Files =:= [] ->
1522            end_of_input;
1523       (read) ->
1524            [F | Fs] = Files,
1525            case file:open(F, [read, compressed]) of
1526                {ok, Fd} ->
1527                    file_rterms2(Fd, [], 0, F, Fs);
1528                {error, Reason} ->
1529                    {error, {file_error, F, Reason}}
1530            end
1531    end;
1532file_rterms({Fd, FileName}, Files) ->
1533    fun(close) ->
1534            file:close(Fd);
1535       (read) ->
1536            file_rterms2(Fd, [], 0, FileName, Files)
1537    end.
1538
1539file_rterms2(Fd, L, LSz, FileName, Files) when LSz < ?CHUNKSIZE ->
1540    case io:read(Fd, '') of
1541        {ok, Term} ->
1542            B = term_to_binary(Term),
1543            file_rterms2(Fd, [B | L], LSz + byte_size(B), FileName, Files);
1544        eof ->
1545            file:close(Fd),
1546            {lists:reverse(L), file_rterms(no_file, Files)};
1547        _Error ->
1548            file:close(Fd),
1549            {error, {bad_term, FileName}}
1550    end;
1551file_rterms2(Fd, L, _LSz, FileName, Files) ->
1552    {lists:reverse(L), file_rterms({Fd, FileName}, Files)}.
1553
1554file_wterms(W, F, Args) ->
1555    fun(close) when W =:= name ->
1556            ok;
1557       (close) ->
1558            {fd, Fd} = W,
1559            file:close(Fd);
1560       (L) when W =:= name ->
1561            case file:open(F, Args) of
1562                {ok, Fd} ->
1563                    write_terms(Fd, F, L, Args);
1564                {error, Reason} ->
1565                    {error, {file_error, F, Reason}}
1566            end;
1567       (L) ->
1568            {fd, Fd} = W,
1569            write_terms(Fd, F, L, Args)
1570    end.
1571
1572write_terms(Fd, F, [B | Bs], Args) ->
1573    case io:request(Fd, {format, "~p.~n", [binary_to_term(B)]}) of
1574        ok ->
1575            write_terms(Fd, F, Bs, Args);
1576        {error, Reason} ->
1577            file:close(Fd),
1578            {error, {file_error, F, Reason}}
1579    end;
1580write_terms(Fd, F, [], Args) ->
1581    file_wterms({fd, Fd}, F, Args).
1582
1583fun_rterms(InFun) ->
1584    fun(close) ->
1585            InFun(close);
1586       (read) ->
1587            case InFun(read) of
1588                {Ts, NInFun} when is_list(Ts),
1589                                  is_function(NInFun),
1590                                  is_function(NInFun, 1) ->
1591                    {to_bin(Ts, []), fun_rterms(NInFun)};
1592                Else ->
1593                    Else
1594            end
1595    end.
1596
1597fun_wterms(OutFun) ->
1598    fun(close) ->
1599            OutFun(close);
1600       (L) ->
1601            case OutFun(wterms_arg(L)) of
1602                NOutFun when is_function(NOutFun), is_function(NOutFun, 1) ->
1603                    fun_wterms(NOutFun);
1604                Else ->
1605                    Else
1606            end
1607    end.
1608
1609to_bin([E | Es], L) ->
1610    to_bin(Es, [term_to_binary(E) | L]);
1611to_bin([], L) ->
1612    lists:reverse(L).
1613
1614wterms_arg(L) when is_list(L) ->
1615    to_term(L, []);
1616wterms_arg(Value) ->
1617    Value.
1618
1619to_term([B | Bs], L) ->
1620    to_term(Bs, [binary_to_term(B) | L]);
1621to_term([], L) ->
1622    lists:reverse(L).
1623