Daniel@0: /* Part of DML (Digital Music Laboratory) Daniel@0: Copyright 2014-2015 Samer Abdallah, University of London Daniel@0: Daniel@0: This program is free software; you can redistribute it and/or Daniel@0: modify it under the terms of the GNU General Public License Daniel@0: as published by the Free Software Foundation; either version 2 Daniel@0: of the License, or (at your option) any later version. Daniel@0: Daniel@0: This program is distributed in the hope that it will be useful, Daniel@0: but WITHOUT ANY WARRANTY; without even the implied warranty of Daniel@0: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Daniel@0: GNU General Public License for more details. Daniel@0: Daniel@0: You should have received a copy of the GNU General Public Daniel@0: License along with this library; if not, write to the Free Software Daniel@0: Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Daniel@0: */ Daniel@0: Daniel@0: :- module(compression, Daniel@0: [ with_transducer/3 Daniel@0: , stream_length/1 Daniel@0: , print_delimited_dcg/1 Daniel@0: , complexity_method/1 Daniel@0: , complexity/3 Daniel@0: , conditional_complexity/4 Daniel@0: , min_complexity/3 Daniel@0: , min_conditional_complexity/4 Daniel@0: , ncd/4 Daniel@0: , conditional_ncd/5 Daniel@0: , write_bytes/1 Daniel@0: , length_prob/3 Daniel@0: , with_stream_encoding/3 Daniel@0: , with_zlib_stream/1 Daniel@0: , zsync//1 Daniel@0: ]). Daniel@0: Daniel@0: /** Tools for applying compression programs to abitrary streams. Daniel@0: Daniel@0: This module provides a framework for applying a range of compression and Daniel@0: delta compression programs to arbitrary streams generated by Prolog code. Daniel@0: In particular, the predicates complexity/3 and conditional_complexity/4 Daniel@0: use compression programs to estimate Kolmogorov complexity and conditional Daniel@0: complexity. Daniel@0: Daniel@0: Compression programs are invoked by a collection of shell scripts included Daniel@0: with this software, in the scripts/compression subdirectory of the dml cpack. Daniel@0: The method to be used is determined by a term of type compression_method: Daniel@0: == Daniel@0: compression_method ---> id % no compression Daniel@0: ; compress(c_method) Daniel@0: ; diff(d_method,pred). Daniel@0: c_method ---> lzma ; gz ; bz. Daniel@0: Daniel@0: d_method ---> bsdiff Daniel@0: ; xdelta % using xdelta3 program Daniel@0: ; vcdiff % using open-vcdiff Daniel@0: ; vczip % using vczip tools from AT&T Daniel@0: ; xdiff % using binary to text encoding and diff Daniel@0: ; zzd(c_method, d_method) Daniel@0: ; zzcd(c_method, d_method) Daniel@0: ; dz(d_method, c_method). Daniel@0: == Daniel@0: Daniel@0: Currently we do not subtract an known overheads associated with redundant Daniel@0: information in compression program outputs, such as 'magic bytes' in a header Daniel@0: used to enable tools to recognise which program was used to compress a given file. Daniel@0: */ Daniel@0: Daniel@0: :- use_module(library(settings)). Daniel@0: :- use_module(library(memo)). Daniel@0: :- use_module(library(process)). Daniel@0: :- use_module(library(fileutils)). Daniel@0: :- use_module(library(swipe)). Daniel@0: :- use_module(library(dcg_core)). Daniel@0: :- use_module(library(dcg_codes)). Daniel@0: :- use_module(library(zlib)). Daniel@0: Daniel@0: user:file_search_path(compression,dml(scripts/compression)). Daniel@0: Daniel@0: :- initialization time(memo_attach(memo(compression),[])). Daniel@0: Daniel@0: %% print_delimited_dcg(+P:phrase(list(code))) is det. Daniel@0: % Daniel@0: % Runs the DCG phrase to generate a list of character codes, and then Daniel@0: % print the textually encoded length of the resulting list, followed by Daniel@0: % a carriage return, followed by the characters themselves. Thus, the resulting Daniel@0: % sequence of bytes is self-delimiting. Daniel@0: print_delimited_dcg(Phrase) :- Daniel@0: phrase(Phrase,Codes), Daniel@0: length(Codes,Length), Daniel@0: format('~d\n~s',[Length,Codes]). Daniel@0: Daniel@0: :- meta_predicate Daniel@0: complexity(+,0,-), Daniel@0: min_complexity(-,0,-), Daniel@0: conditional_complexity(+,0,0,-), Daniel@0: min_conditional_complexity(-,0,0,-), Daniel@0: conditional_ncd(+,0,0,0,-), Daniel@0: ncd(+,0,0,-). Daniel@0: Daniel@0: :- meta_predicate with_zlib_stream(//). Daniel@0: Daniel@0: %% complexity(+Method:compression_method, +Writer:pred, -K:nonneg) is det. Daniel@0: %% complexity(-Method:compression_method, +Writer:pred, -K:nonneg) is nondet. Daniel@0: %% complexity(-Method:compression_method, -Writer:pred, -K:nonneg) is nondet. Daniel@0: % Daniel@0: % Estimates the Kolmogorov complexity in bits of the sequence of bytes written to the Daniel@0: % current output stream by the goal Writer. If Writer is unbound on entry, then Daniel@0: % browses the set of previously computed results, which are stored in a volatile memo. Daniel@0: % Daniel@0: % Method can be =|id|= for no compression, or =|compress(M)|= for compression using Daniel@0: % program M. If Method is a ground term of the form =|diff(M,RefWriter)|=, then Daniel@0: % complexity is estimated using a delta compression with respect to the bytes written Daniel@0: % by RefWriter. Methods are described in the module header. Conditional complexity Daniel@0: % can more conveniently be estimated using conditional_complexity/4. Daniel@0: complexity(Method,Mod:Writer,K) :- Daniel@0: ( nonvar(Writer), complexity_method(Method), ground(Method) Daniel@0: *->complexity1(Method,Mod:Writer,K) Daniel@0: ; browse(complexity1(Method,Mod:Writer,K)) Daniel@0: ). Daniel@0: Daniel@0: execable(A) :- var(A), !, fail. Daniel@0: execable((A,B)) :- !, execable(A), execable(B). Daniel@0: execable(_). Daniel@0: Daniel@0: :- volatile_memo min_complexity(-ground,+callable,-number). Daniel@0: min_complexity(Best,Writer,KMin) :- Daniel@0: aggregate(min(K,Meth),complexity(Meth,Writer,K),min(KMin,Best)). Daniel@0: Daniel@0: %% conditional_complexity(+M:cc_method, +RefWriter:pred, +Writer:pred, -K:nonneg) is det. Daniel@0: % Daniel@0: % Estimate conditional Kolmogorov complexity of byte sequence produced by Writer Daniel@0: % given bit sequence produced by RefWriter, using one of several methods: Daniel@0: % == Daniel@0: % cc_method ---> id % no compression, complexity is length of data from Writer Daniel@0: % ; compress(c_method) % ignore reference sequence and compress Daniel@0: % ; delta(d_method) % do delta compression using given method Daniel@0: % ; naive(c_method). % use naive estimate using concatentation method Daniel@0: % == Daniel@0: % The naive estimate of K(x|y) is C(yx) - C(y), where C(.) is compressed length and Daniel@0: % xy is simply x concatenated with y. It may give nonsensical zero results. Daniel@0: % It is not the length of any concrete message that can produce x given y. Daniel@0: conditional_complexity(Method,Ref,Writer,K) :- Daniel@0: ( Method=delta(Diff), M=diff(Diff,Ref) Daniel@0: % ; Method=compress(C), M=compress(C) Daniel@0: % ; Method=compress(zlib), M=zlib Daniel@0: ; Method=delta(zlib), M=zlib(Ref) Daniel@0: ; Method=delta(dlzma), M=dlzma(Ref) Daniel@0: % ; Method=id, M=id Daniel@0: ), Daniel@0: complexity(M,Writer,K). Daniel@0: Daniel@0: conditional_complexity(naive(C),Ref,Writer,K) :- Daniel@0: complexity(compress(C),Ref,KY), Daniel@0: complexity(compress(C),(Ref,Writer),KXY), Daniel@0: K is KXY - KY. Daniel@0: Daniel@0: ncd(naive(C),Writer1,Writer2,D) :- Daniel@0: complexity(compress(C),Writer1,K1), Daniel@0: complexity(compress(C),Writer2,K2), Daniel@0: complexity(compress(C),(Writer1,Writer2),K12), Daniel@0: D is (K12 - min(K1,K2))/max(K1,K2). Daniel@0: Daniel@0: ncd(CM-DM,Writer1,Writer2,D) :- Daniel@0: complexity(CM,Writer1,K1), Daniel@0: complexity(CM,Writer2,K2), Daniel@0: conditional_complexity(DM,Writer1,Writer2,K2g1), Daniel@0: conditional_complexity(DM,Writer2,Writer1,K1g2), Daniel@0: D is max(min(K1,K1g2)/K1, min(K2,K2g1)/K2). Daniel@0: Daniel@0: ncd(opt,Writer1,Writer2,D) :- Daniel@0: min_complexity(_,Writer1,K1), Daniel@0: min_complexity(_,Writer2,K2), Daniel@0: min_conditional_complexity(_,Writer1,Writer2,K2g1), Daniel@0: min_conditional_complexity(_,Writer2,Writer1,K1g2), Daniel@0: D is max(min(K1,K1g2)/K1, min(K2,K2g1)/K2). Daniel@0: Daniel@0: conditional_ncd(naive(Method),Ref,Writer1,Writer2,D) :- Daniel@0: conditional_complexity(Method,Ref,Writer1,K1), Daniel@0: conditional_complexity(Method,Ref,Writer2,K2), Daniel@0: conditional_complexity(Method,Ref,(Writer1,Writer2),K12), Daniel@0: D is (K12 - min(K1,K2))/max(K1,K2). Daniel@0: Daniel@0: conditional_ncd(DM,Ref,Writer1,Writer2,D) :- Daniel@0: conditional_complexity(DM,Ref,Writer1,K1), Daniel@0: conditional_complexity(DM,Ref,Writer2,K2), Daniel@0: conditional_complexity(DM,(Ref,Writer1),Writer2,K2g1), Daniel@0: conditional_complexity(DM,(Ref,Writer2),Writer1,K1g2), Daniel@0: D is max(min(K1,K1g2)/K1, min(K2,K2g1)/K2). Daniel@0: Daniel@0: :- volatile_memo min_conditional_complexity(-ground,+callable,+callable,-number). Daniel@0: min_conditional_complexity(Best,Ref,Writer,KMin) :- Daniel@0: aggregate(min(K,Meth),(conditional_complexity(Meth,Ref,Writer,K),Meth\=naive(_)), min(KMin,Best)). Daniel@0: Daniel@0: %% complexity_method(-M:compression_method) is nondet. Daniel@0: complexity_method(diff(Diff,_)) :- command(diff0(Diff,library('swipe.pl')),_,_). Daniel@0: complexity_method(compress(Comp)) :- command(compress(Comp),_,_). Daniel@0: complexity_method(id). Daniel@0: complexity_method(zlib). Daniel@0: complexity_method(zlibi). Daniel@0: complexity_method(zlib(_)). Daniel@0: complexity_method(dlzma(_)). Daniel@0: Daniel@0: :- persistent_memo complexity1(+ground,+callable,-number). Daniel@0: complexity1(id,Writer,K) :- with_transducer(cat,Writer,stream_length(K)). Daniel@0: complexity1(compress(Meth),Writer,K) :- with_transducer(compress(Meth), Writer, stream_length(K)). Daniel@0: complexity1(diff(Diff,RefWriter),Writer,K) :- Daniel@0: with_temp_files([F1], Daniel@0: ( with_output_to_file(F1,RefWriter), Daniel@0: with_transducer(diff0(Diff,F1), Writer, stream_length(K)))). Daniel@0: complexity1(zlib,Writer,K) :- Daniel@0: with_zlib_stream(call_zsync(Writer,K)). Daniel@0: Daniel@0: complexity1(zlibi,Writer,K) :- Daniel@0: with_zlib_stream((call_zsync(write_bytes([255]),_), call_zsync(Writer,K))). Daniel@0: Daniel@0: complexity1(zlib(Ref),Writer,K) :- Daniel@0: with_zlib_stream((call_zsync(Ref,_), call_zsync(Writer,K))). Daniel@0: Daniel@0: complexity1(dlzma(RefWriter),Writer,K) :- Daniel@0: with_temp_files([F1], Daniel@0: ( with_output_to_file(F1,RefWriter), Daniel@0: with_transducer(dlzma(F1,['-b0']), Writer, read_line_to_string(current_input,KString)))), Daniel@0: number_string(K,KString). Daniel@0: Daniel@0: Daniel@0: subs(_,_,T1,T2) :- var(T1), !, T1=T2. Daniel@0: subs(Old,New,T1,T2) :- T1==Old, !, T2=New. Daniel@0: subs(Old,New,T1,T2) :- Daniel@0: T1 =.. [F | Args1], Daniel@0: maplist(subs(Old,New),Args1,Args2), Daniel@0: T2 =.. [F | Args2]. Daniel@0: Daniel@0: Daniel@0: % this is hopeless... Daniel@0: length_prob(Meth,L,Prob) :- Daniel@0: length(X,L), Daniel@0: aggregate( sum(2**(-8*B)), Daniel@0: X^(maplist(between(0,255),X), Daniel@0: with_transducer(compress(Meth), write_bytes(X), stream_length(B)), Daniel@0: format(user_error, '\r~w : ~w', [X,B]) Daniel@0: ), Daniel@0: Prob). Daniel@0: Daniel@0: %% write_bytes(+Bytes:list(between(0,255))) is det. Daniel@0: % Writes a sequence of bytes to current_output. Daniel@0: write_bytes(Bytes) :- with_stream_encoding(current_output,octet,maplist(put_code,Bytes)). Daniel@0: Daniel@0: Daniel@0: % -------------------------------- Using ZLIB ------------------------------ Daniel@0: Daniel@0: Daniel@0: with_zlib_stream(Phrase) :- Daniel@0: setup_call_cleanup( Daniel@0: open_null_stream(Out), Daniel@0: setup_call_cleanup( Daniel@0: zopen(Out,ZOut,[level(9),close_parent(false)]), Daniel@0: with_output_to(ZOut,call_dcg(Phrase,Out-0,_)), Daniel@0: close(ZOut)), Daniel@0: close(Out)). Daniel@0: Daniel@0: zpos(Pos,Out-Pos,Out-Pos). Daniel@0: zsync(Bits,Out-Pos0,Out-Pos1) :- Daniel@0: flush_output, Daniel@0: byte_count(Out,Pos1), Daniel@0: ( Pos1=Pos0 -> Bits=0 % no data since last sync Daniel@0: ; Bits is 8*((Pos1-Pos0)-4)-(3+3) % subtract estimate of final type 0 block. Daniel@0: ). Daniel@0: Daniel@0: call_zsync(Goal,Delta) --> {call(Goal)}, zsync(Delta). Daniel@0: Daniel@0: Daniel@0: % ------ Method comparison ----- Daniel@0: evaluate_delta(KRel,Method) :- Daniel@0: call_with_mode(browse, setof(K-Meth,conditional_complexity(Meth,_:_,_:_,K),KMeths)), Daniel@0: memberchk(_-delta(_),KMeths), Daniel@0: exclude(eval_exclude,KMeths,KMeths1), Daniel@0: KMeths1 = [KBest-_|_], Daniel@0: member(K-Method,KMeths1), Daniel@0: KRel is K/KBest. Daniel@0: Daniel@0: :- public method_rankings/2. Daniel@0: method_rankings(Method,Scores) :- Daniel@0: setof( Method-KRels, Daniel@0: bagof(KRel, evaluate_delta(KRel,Method), KRels), Daniel@0: AllScores), Daniel@0: member(Method-Scores,AllScores). Daniel@0: Daniel@0: eval_exclude(_-Method) :- exclude_method(Method). Daniel@0: exclude_method(naive(_)). Daniel@0: exclude_method(delta(DMethod)) :- exclude_dmethod(DMethod). Daniel@0: exclude_dmethod(xdiff). Daniel@0: exclude_dmethod(dz(DM,_)) :- exclude_dmethod(DM). Daniel@0: exclude_dmethod(zzcd(_,DM)) :- exclude_dmethod(DM). Daniel@0: exclude_dmethod(zzd(_,DM)) :- exclude_dmethod(DM). Daniel@0: Daniel@0: delta_method(compress(C),compress(C)). Daniel@0: delta_method(delta(M),delta(M)). Daniel@0: delta_method(id,id). Daniel@0: Daniel@0: Daniel@0: % ----------------------- Compression framework -------------------------------------- Daniel@0: Daniel@0: Daniel@0: swipe:def(Pipe,Def) :- def(Pipe,Def). Daniel@0: Daniel@0: def( findcat(Dir), sh(0 >> $_, '~s ~s',[compression(findcat)+execute, file(Dir,[file_type(directory)])])). Daniel@0: def( humdump(Dir), findcat(Dir) >> sh($hum >> $hum,'rid -G')). Daniel@0: def( length, sh($_ >> $number, 'wc -c')). Daniel@0: def( prepend(File^T), sh($T >> $T,'cat ~s -',[File+read])). Daniel@0: def( prepend(_> $T,'cat ~s -',[T> $T, 'tail -c +$((1+~s))',[$(File^T :> length)])). Daniel@0: def( unprepend(T> $T, 'tail -c +$((1+~s))',[$(Pipe >> length)])). Daniel@0: def( compress(Method), sh( $X >> $z(Method,X), Cmd)) :- compressor(Method,Cmd,_). Daniel@0: def( decompress(Method), sh( $z(Method,X) >> $X, Cmd)) :- compressor(Method,_,Cmd). Daniel@0: Daniel@0: def( diff0(Diff,Ref), diff(Diff,Ref)). Daniel@0: % def( diff0(dz(Diff,Comp),Ref), diff(Diff,Ref) >> compress(Comp)). Daniel@0: def( diff(Diff,Ref), diff(Diff, encode, Ref+read)). Daniel@0: % def( diff(zzd(Comp,Diff),Ref), compress(Comp) >> buf(2,diff(Diff, encode, T<(Ref^T :> compress(Comp))))). Daniel@0: def( diff(zzcd(Comp,Diff),Ref), prepend(Ref^T) >> compress(Comp) >> buf(2,diff(Diff, encode, _<(Ref^T :> compress(Comp))))). Daniel@0: Daniel@0: def( patch(Method,Ref), diff(Method, decode, Ref+read)). Daniel@0: def( patch(zzd(Comp,Diff),Ref), buf(2,diff(Diff, decode, _<(Ref^_ :> compress(Comp)))) >> decompress(Comp)). Daniel@0: def( patch(zzcd(Comp,Diff),Ref), buf(2,diff(Diff, decode, _<(Ref^T :> compress(Comp)))) >> decompress(Comp) >> unprepend(Ref^T)). Daniel@0: Daniel@0: def( diff(Method,encode,RefSource), sh( $X >> $dz(Method,X), [compression(Script)+execute, encode, RefSource | Args])) :- differ(Method,Script,Args,_). Daniel@0: def( diff(Method,decode,RefSource), sh( $dz(Method,X) >> $X, [compression(Script)+execute, decode, RefSource | Args])) :- differ(Method,Script,_,Args), Method\=zvcz. Daniel@0: def( buf(N,Pipe), sh(Type,'~s ~d ~s',[compression(bufs)+execute, \N, \Cmd])) :- command(Pipe,Type,Cmd). Daniel@0: Daniel@0: def( diff1(Diff,Ref), diff2(Diff, Ref)). Daniel@0: def( diff1(zzd(Comp,Diff),Ref), compress(Comp) >> diff2(Diff, Ref >> compress(Comp))). Daniel@0: def( diff1(zzcd(Comp,Diff),Ref), prepend(_> compress(Comp) >> diff2(Diff, Ref >> compress(Comp))). Daniel@0: def( patch1(Diff,Ref), patch2(Diff, Ref)). Daniel@0: def( patch1(zzd(Comp,Diff),Ref), patch2(Diff, Ref >> compress(Comp)) >> decompress(Comp)). Daniel@0: def( patch1(zzcd(Comp,Diff),Ref), patch2(Diff, Ref >> compress(Comp)) >> decompress(Comp) >> unprepend(_> $dz(Method,X), [compression(encode)+execute, Script, X> $X, [compression(decode)+execute, Script, X> $dz(dlzma,X), [compression(dlzma)+execute | Args])) :- Daniel@0: append(Opts,[Ref],Args). Daniel@0: Daniel@0: % compressor(xz,xz,xzcat). Daniel@0: compressor(lzma,lzma,lzcat). Daniel@0: compressor(xzraw,'xz -q -F raw','xzcat -F raw'). Daniel@0: compressor(gz,gzip,zcat). Daniel@0: compressor(bz,bzip2,bzcat). Daniel@0: Daniel@0: contains(Diff,Diff). Daniel@0: contains(dz(D1,_),D2) :- contains(D1,D2). Daniel@0: contains(zzd(_,D1),D2) :- contains(D1,D2). Daniel@0: contains(zzcd(_,D1),D2) :- contains(D1,D2). Daniel@0: Daniel@0: Daniel@0: % :- setting(max_vczip_chain_length, nonneg, 2, 'Maximum length of vczip processing chain'). Daniel@0: Daniel@0: differ(Method,Exec,[],[]) :- differ(Method,Exec). Daniel@0: differ(Method-Opts, Exec, EncArgs, []) :- differ(Method,Exec), options_for(Method,Opts,EncArgs). Daniel@0: differ(vczip(vcdiff),zvcz,['-Vcdiff'],[]). Daniel@0: differ(vczip(delta),zvcz,['-mdelta'],[]). Daniel@0: differ(vczip(sieve),zvcz,['-msieve.delta'],[]). Daniel@0: % differ(vczip(Delta,Chain,Encode),zvcz,[\Codes],[]) :- Daniel@0: % setting(max_vczip_chain_length,N), Daniel@0: % between(1,N,L), Daniel@0: % length(Chain,L), Daniel@0: % vczip_chain(Delta,Chain,Encode,Codes,[]). Daniel@0: Daniel@0: % differ(bsdiff,zbs). Daniel@0: % differ(xdelta,zxd). Daniel@0: differ(vcdiff,zvcd). Daniel@0: % differ(vczip,zvcz). Daniel@0: % differ(xdiff,zdiff). Daniel@0: Daniel@0: options_for(Method,Opts,Args) :- Daniel@0: Opts=[_|_], Daniel@0: setof(opt(Opt,Gen,A1,A2),method_option(Method,Opt,Gen,A1,A2),Possible), Daniel@0: seqmap(maybe_option,Possible,Opts-Args,[]-[]). Daniel@0: Daniel@0: maybe_option(_) --> []. Daniel@0: maybe_option(opt(Opt,Gen,A1,A2),[Opt|Opts]-A1,Opts-A2) :- call(Gen). Daniel@0: Daniel@0: method_option(xdelta, secondary(A), member(A,[djw,fgk])) --> ['-S',A]. Daniel@0: method_option(vcdiff, target_matches, true) --> ['-target_matches']. Daniel@0: Daniel@0: % vczip_chain(Delta,Chain,Encode) --> Daniel@0: % "-m", Daniel@0: % vczip_delta(Delta), ",", Daniel@0: % seqmap_with_sep(",",vczip_transform,Chain), ",", Daniel@0: % vczip_encode(Encode). Daniel@0: Daniel@0: % vczip_delta(delta) --> "delta". Daniel@0: % vczip_delta(sieve) --> "sieve.delta". Daniel@0: Daniel@0: % vczip_transform(bwt) --> "bwt". Daniel@0: % vczip_transform(mtf) --> "mtf". Daniel@0: % vczip_transform(rle) --> "rle". Daniel@0: % vczip_transform(rle(N)) --> "rle.", {between(0,1,N)}, at(N). Daniel@0: Daniel@0: % vczip_encode(huffman) --> "huffman". Daniel@0: % vczip_encode(huffgroup) --> "huffgroup". Daniel@0: % vczip_encode(huffpart) --> "huffpart". Daniel@0: Daniel@0: Daniel@0: compressor_overhead(gz,18). % see http://www.onicos.com/staff/iz/formats/gzip.html, https://tools.ietf.org/html/rfc1952 Daniel@0: compressor_overhead(bz,4). % http://en.wikipedia.org/wiki/Bzip2 (need to know number of blocks for better estimate) Daniel@0: compressor_overhead(lzma,0). % http://svn.python.org/projects/external/xz-5.0.3/doc/lzma-file-format.txt Daniel@0: Daniel@0: % ------------------------- Pipe and file tools ---------------------------------- Daniel@0: Daniel@0: splice_in(Pipe) :- with_pipe_input(S,Pipe,copy_stream_data(current_input,S)). Daniel@0: splice_out(Pipe) :- Daniel@0: with_pipe_output(S,Pipe, Daniel@0: ( with_stream_encoding(S,octet, Daniel@0: with_stream_encoding(current_output,octet, Daniel@0: copy_stream_data(S,current_output))))). Daniel@0: Daniel@0: :- op(1050,xfy,&). Daniel@0: Daniel@0: Daniel@0: %% with_transducer(+P:pipe, +Writer:pred, +Reader:pred) is det. Daniel@0: % Runs a pipeline defined using the framework provided by library(swipe), Daniel@0: % while concurrently sending data written by Writer to the process Daniel@0: % on its standard input and making data from the standard output of the Daniel@0: % process available to Reader on current_input. Daniel@0: :- meta_predicate with_transducer(+,0,0). Daniel@0: with_transducer(Pipe,Writer,Reader) :- Daniel@0: with_pipe_io( To-From, Pipe, Daniel@0: ( call_cleanup(with_output_to(To,Writer), close(To)) Daniel@0: & call_cleanup(with_input_from(From,Reader), close(From)) Daniel@0: )). Daniel@0: Daniel@0: Daniel@0: A & B :- concurrent(2, [A,B], []). Daniel@0: Daniel@0: %% with_stream_encoding(+S:stream,+E:encoding,+G:pred) is det. Daniel@0: % Call goall G with encoding of stream S temporarily set to E. Encoding Daniel@0: % is restored afterwards. Daniel@0: :- meta_predicate with_stream_encoding(+,+,0). Daniel@0: with_stream_encoding(S,Enc,Goal) :- Daniel@0: stream_property(S,encoding(Old)), Daniel@0: setup_call_cleanup(set_stream(S,encoding(Enc)), Goal, set_stream(S,encoding(Old))). Daniel@0: Daniel@0: %% stream_length(-L:natural) is det. Daniel@0: % Reads all the data available on Prolog stream current_input and returns the Daniel@0: % number of bits consumed. Daniel@0: stream_length(S,Bits) :- with_input_from(S,stream_length(Bits)). Daniel@0: stream_length(Bits) :- Daniel@0: with_stream_encoding(current_input,octet,accum_length(0,Bytes)), Daniel@0: Bits is 8*Bytes. Daniel@0: Daniel@0: accum_length(L,L) :- at_end_of_stream, !. Daniel@0: accum_length(L1,L3) :- Daniel@0: read_pending_input(current_input, Codes, []), Daniel@0: length(Codes,L), Daniel@0: L2 is L1 + L, Daniel@0: accum_length(L2,L3). Daniel@0: Daniel@0: with_temp_files(Files,Goal) :- Daniel@0: must_be(list(var),Files), Daniel@0: setup_call_cleanup( Daniel@0: maplist(tmp_file_stream(binary),Files,Streams), Daniel@0: (maplist(close,Streams), call(Goal)), Daniel@0: maplist(delete_file,Files)).