/************************************************************************* * * * YAP Prolog * * * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * ************************************************************************** * * * File: yio.yap * * Last rev: * * mods: * * comments: Input output predicates * * * *************************************************************************/ /* stream predicates */ /* check whether a list of options is valid */ '$check_io_opts'(V,G) :- var(V), !, '$do_error'(instantiation_error,G). '$check_io_opts'([],_) :- !. '$check_io_opts'([H|_],G) :- var(H), !, '$do_error'(instantiation_error,G). '$check_io_opts'([Opt|T],G) :- !, '$check_opt'(G,Opt,G), '$check_io_opts'(T,G). '$check_io_opts'(T,G) :- '$do_error'(type_error(list,T),G). '$check_opt'(read_term(_,_),Opt,G) :- '$check_opt_read'(Opt, G). '$check_opt'(stream_property(_,_),Opt,G) :- '$check_opt_sp'(Opt, G). '$check_opt'(write_term(_,_),Opt,G) :- '$check_opt_write'(Opt, G). '$check_opt'(yap_flag(_,_),Opt,G) :- '$check_opt_write'(Opt, G). '$check_opt_read'(variables(_), _) :- !. '$check_opt_read'(variable_names(_), _) :- !. '$check_opt_read'(singletons(_), _) :- !. '$check_opt_read'(syntax_errors(T), G) :- !, '$check_read_syntax_errors_arg'(T, G). '$check_opt_read'(term_position(_), _) :- !. '$check_opt_read'(module(_), _) :- !. '$check_opt_read'(A, G) :- '$do_error'(domain_error(read_option,A),G). '$check_opt_sp'(file_name(_), _) :- !. '$check_opt_sp'(mode(_), _) :- !. '$check_opt_sp'(input, _) :- !. '$check_opt_sp'(output, _) :- !. '$check_opt_sp'(alias(_), _) :- !. '$check_opt_sp'(position(_), _) :- !. '$check_opt_sp'(end_of_stream(_), _) :- !. '$check_opt_sp'(eof_action(_), _) :- !. '$check_opt_sp'(reposition(_), _) :- !. '$check_opt_sp'(type(_), _) :- !. '$check_opt_sp'(bom(_), _) :- !. '$check_opt_sp'(encoding(_), _) :- !. '$check_opt_sp'(representation_errors(_), _) :- !. '$check_opt_sp'(A, G) :- '$do_error'(domain_error(stream_property,A),G). '$check_opt_write'(attributes(T), G) :- !, '$check_write_attributes'(T, G). '$check_opt_write'(cycles(T), G) :- !, '$check_boolean'(T, write_option, cycles(T), G). '$check_opt_write'(quoted(T), G) :- !, '$check_boolean'(T, write_option, quoted(T), G). '$check_opt_write'(ignore_ops(T), G) :- !, '$check_boolean'(T, write_option, ignore_ops(T), G). '$check_opt_write'(max_depth(T), G) :- !, '$check_write_max_depth'(T, G). '$check_opt_write'(numbervars(T), G) :- !, '$check_boolean'(T, write_option, ignore_ops(T), G). '$check_opt_write'(portrayed(T), G) :- !, '$check_boolean'(T, write_option, portrayed(T), G). '$check_opt_write'(portray(T), G) :- !, '$check_boolean'(T, write_option, portray(T), G). '$check_opt_write'(priority(T), G) :- !, '$check_priority_arg'(T, G). '$check_opt_write'(swi(T), G) :- !, '$check_boolean'(T, write_option, swi(T), G). '$check_opt_write'(A, G) :- '$do_error'(domain_error(write_option,A),G). '$check_read_syntax_errors_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_read_syntax_errors_arg'(dec10,_) :- !. '$check_read_syntax_errors_arg'(fail,_) :- !. '$check_read_syntax_errors_arg'(error,_) :- !. '$check_read_syntax_errors_arg'(quiet,_) :- !. '$check_read_syntax_errors_arg'(X,G) :- '$do_error'(domain_error(read_option,syntax_errors(X)),G). '$check_write_attributes'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_write_attributes'(ignore,_) :- !. '$check_write_attributes'(dots,_) :- !. '$check_write_attributes'(write,_) :- !. '$check_write_attributes'(portray,_) :- !. '$check_write_attributes'(X,G) :- '$do_error'(domain_error(write_option,attributes(X)),G). '$check_boolean'(X, _, _, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_boolean'(true,_,_,_) :- !. '$check_boolean'(false,_,_,_) :- !. '$check_boolean'(X,B,T,G) :- '$do_error'(domain_error(B,T),G). '$check_write_max_depth'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_write_max_depth'(I,_) :- integer(I), I >= 0, !. '$check_write_max_depth'(X,G) :- '$do_error'(domain_error(write_option,max_depth(X)),G). '$check_priority_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_priority_arg'(I,_) :- integer(I), I >= 0, I =< 1200, !. '$check_priority_arg'(X,G) :- '$do_error'(domain_error(write_option,priority(X)),G). set_input(Stream) :- '$set_input'(Stream). set_output(Stream) :- '$set_output'(Stream). open_pipe_streams(Read, Write) :- ( '$undefined'(pipe(_,_),unix) -> load_files(library(unix), [silent(true),if(not_loaded)]) ; true ), unix:pipe(Read, Write). fileerrors :- set_value(fileerrors,1). nofileerrors :- set_value(fileerrors,0). exists(F) :- access_file(F,exist). see(user) :- !, set_input(user_input). see(F) :- var(F), !, '$do_error'(instantiation_error,see(F)). see(F) :- current_input(Stream), '$user_file_name'(Stream,F). see(F) :- current_stream(_,read,Stream), '$user_file_name'(Stream,F), !, set_input(Stream). see(Stream) :- '$stream'(Stream), current_stream(_,read,Stream), !, set_input(Stream). see(F) :- open(F,read,Stream), set_input(Stream). seeing(File) :- current_input(Stream), '$user_file_name'(Stream,NFile), ( '$user_file_name'(user_input,NFile) -> File = user ; NFile = File). seen :- current_input(Stream), close(Stream), set_input(user). tell(user) :- !, set_output(user_output). tell(F) :- var(F), !, '$do_error'(instantiation_error,tell(F)). tell(F) :- current_output(Stream), '$user_file_name'(Stream,F), !. tell(F) :- current_stream(_,write,Stream), '$user_file_name'(Stream, F), !, set_output(Stream). tell(Stream) :- '$stream'(Stream), current_stream(_,write,Stream), !, set_output(Stream). tell(F) :- open(F,write,Stream), set_output(Stream). telling(File) :- current_output(Stream), '$user_file_name'(Stream,NFile), ( '$user_file_name'(user_output,NFile) -> File = user ; File = NFile ). told :- current_output(Stream), close(Stream), set_output(user). /* Term IO */ read(T) :- '$read'(false,T,_,_,_,Err), (nonvar(Err) -> print_message(error,Err), fail ; true ). read(Stream,T) :- '$read'(false,T,_,_,_,Err,Stream), (nonvar(Err) -> print_message(error,Err), fail ; true ). read_term(T, Options) :- '$check_io_opts'(Options,read_term(T, Options)), current_input(S), '$preprocess_read_terms_options'(Options,Module), '$read_vars'(S,T,Module,Pos,VL), '$postprocess_read_terms_options'(Options, T, VL, Pos). read_term(Stream, T, Options) :- '$check_io_opts'(Options,read_term(T, Options)), '$preprocess_read_terms_options'(Options,Module), '$read_vars'(Stream,T,Module,Pos,VL), '$postprocess_read_terms_options'(Options, T, VL, Pos). % % support flags to read % '$preprocess_read_terms_options'([],_). '$preprocess_read_terms_options'([syntax_errors(NewVal)|L],Mod) :- !, '$get_read_error_handler'(OldVal), set_value('$read_term_error_handler', OldVal), '$set_read_error_handler'(NewVal), '$preprocess_read_terms_options'(L,Mod). '$preprocess_read_terms_options'([module(Mod)|L],Mod) :- !, '$preprocess_read_terms_options'(L,Mod). '$preprocess_read_terms_options'([_|L],Mod) :- '$preprocess_read_terms_options'(L,Mod). '$postprocess_read_terms_options'([], _, _, _). '$postprocess_read_terms_options'([H|Tail], T, VL, Pos) :- !, '$postprocess_read_terms_option'(H, T, VL, Pos), '$postprocess_read_terms_options_list'(Tail, T, VL, Pos). '$postprocess_read_terms_options_list'([], _, _, _). '$postprocess_read_terms_options_list'([H|Tail], T, VL, Pos) :- '$postprocess_read_terms_option'(H, T, VL, Pos), '$postprocess_read_terms_options_list'(Tail, T, VL, Pos). '$postprocess_read_terms_option'(syntax_errors(_), _, _, _) :- get_value('$read_term_error_handler', OldVal), '$set_read_error_handler'(OldVal). '$postprocess_read_terms_option'(variable_names(Vars), _, VL, _) :- '$read_term_non_anonymous'(VL, Vars). '$postprocess_read_terms_option'(singletons(Val), T, VL, _) :- '$singletons_in_term'(T, Val1), '$fetch_singleton_names'(Val1,VL,Val). '$postprocess_read_terms_option'(variables(Val), T, _, _) :- '$variables_in_term'(T, [], Val). '$postprocess_read_terms_option'(term_position(Pos), _, _, Pos). '$postprocess_read_terms_option'(module(_), _, _, _). %'$postprocess_read_terms_option'(cycles(Val), _, _). '$read_term_non_anonymous'([], []). '$read_term_non_anonymous'([[S|V]|VL], [Name=V|Vars]) :- atom_codes(Name,S), '$read_term_non_anonymous'(VL, Vars). % problem is what to do about _ singletons. % no need to do ordering, the two lists already come ordered. '$fetch_singleton_names'([], _, []). '$fetch_singleton_names'([_|_], [], []) :- !. '$fetch_singleton_names'([V1|Ss], [[Na|V2]|Ns], ONs) :- V1 == V2, !, '$add_singleton_if_no_underscore'(Na,V2,NSs,ONs), '$fetch_singleton_names'(Ss, Ns, NSs). '$fetch_singleton_names'([V1|Ss], [[_|V2]|Ns], NSs) :- V1 @> V2, !, '$fetch_singleton_names'([V1|Ss], Ns, NSs). '$fetch_singleton_names'([_V1|Ss], Ns, NSs) :- % V1 @> V2, '$fetch_singleton_names'(Ss, Ns, NSs). '$add_singleton_if_no_underscore'([95|_],_,NSs,NSs) :- !. '$add_singleton_if_no_underscore'(Na,V2,NSs,[(Name=V2)|NSs]) :- atom_codes(Name, Na). nl(Stream) :- '$put'(Stream,10). nl :- current_output(Stream), '$put'(Stream,10), fail. nl. /* meaning of flags for '$write' is 1 quote illegal atoms 2 ignore operator declarations 4 output '$VAR'(N) terms as A, B, C, ... 8 use portray(_) flags are defined in yapio.h */ write(T) :- '$write'(4, T). writeln(T) :- '$write'(4, T), nl. write(Stream,T) :- '$write'(Stream,4,T). writeq(T) :- '$write'(5,T). writeq(Stream,T) :- '$write'(Stream,5,T), fail. writeq(_,_). display(T) :- '$write'(2,T). display(Stream,T) :- '$write'(Stream,2,T), fail. display(_,_). write_canonical(T) :- '$write'(3,T). write_canonical(Stream,T) :- '$write'(Stream,3,T), fail. write_canonical(_,_). print(T) :- '$write'(12,T), fail. print(_). print(Stream,T) :- '$write'(Stream,12,T), fail. print(_,_). write_term(T,Opts) :- '$check_io_opts'(Opts, write_term(T,Opts)), '$process_wt_opts'(Opts, 0, Flag, Priority, Callbacks), '$write_with_prio'(Flag, Priority, T), '$process_wt_callbacks'(Callbacks), fail. write_term(_,_). write_term(S, T, Opts) :- '$check_io_opts'(Opts, write_term(T,Opts)), '$process_wt_opts'(Opts, 0, Flag, Priority, Callbacks), '$write_with_prio'(S, Flag, Priority, T), '$process_wt_callbacks'(Callbacks), fail. write_term(_,_,_). '$process_wt_opts'([], Flag, Flag, 1200, []). '$process_wt_opts'([quoted(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 0x01, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ \0x01, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 0x02, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ \0x02, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 0x04, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ \0x04, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 0x08, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ \0x08, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portray(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 0x08, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portray(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ \0x08, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 0x20, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ \0x20, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([swi(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 0x40, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([swi(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ \0x40, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([attributes(_)|Opts], Flag0, Flag, Priority, CallBacks) :- '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([priority(Priority)|Opts], Flag0, Flag, Priority, CallBacks) :- '$process_wt_opts'(Opts, Flag0, Flag, _, CallBacks). '$process_wt_opts'([max_depth(D)|Opts], Flag0, Flag, Priority, [max_depth(D1,D0,D2)|CallBacks]) :- write_depth(D1,D0,D2), D10 is D*10, write_depth(D,D,D10), '$process_wt_opts'(Opts, Flag0, Flag, Priority, CallBacks). '$process_wt_callbacks'([]). '$process_wt_callbacks'([max_depth(D1,D0,D2)|Cs]) :- write_depth(D1,D0,D2), '$process_wt_callbacks'(Cs). format(T) :- format(T, []). /* interface to user portray */ '$portray'(T) :- \+ '$undefined'(portray(_),user), '$system_catch'(call(portray(T)),user,Error,user:'$Error'(Error)), !, set_value('$portray',true), fail. '$portray'(_) :- set_value('$portray',false), fail. /* character I/O */ peek_byte(V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, '$do_error'(type_error(in_byte,V),get_byte(V)). peek_byte(V) :- current_input(S), '$peek_byte'(S,V). peek_byte(S,V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, '$do_error'(type_error(in_byte,V),get_byte(S,V)). peek_byte(S,V) :- '$peek_byte'(S,V). peek_char(V) :- \+ var(V), ( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, '$do_error'(type_error(in_character,V),get_char(V)). peek_char(V) :- current_input(S), '$peek'(S,I), ( I = -1 -> V = end_of_file ; atom_codes(V,[I])). peek_char(S,V) :- \+ var(V), ( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, '$do_error'(type_error(in_character,V),get_char(S,V)). peek_char(S,V) :- '$peek'(S,I), ( I = -1 -> V = end_of_file ; atom_codes(V,[I])). peek_code(S,V) :- \+ var(V), (\+ integer(V)), !, '$do_error'(type_error(in_character_code,V),get_code(S,V)). peek_code(S,V) :- '$peek'(S,V). peek_code(V) :- \+ var(V), (\+ integer(V)), !, '$do_error'(type_error(in_character_code,V),get_code(V)). peek_code(V) :- current_input(S), '$peek'(S,V). put_byte(V) :- var(V), !, '$do_error'(instantiation_error,put_byte(V)). put_byte(V) :- (\+ integer(V) ; V < 0 ; V > 256), !, '$do_error'(type_error(byte,V),put_byte(V)). put_byte(V) :- current_output(S), '$put_byte'(S,V). put_byte(S,V) :- var(V), !, '$do_error'(instantiation_error,put_byte(S,V)). put_byte(S,V) :- (\+ integer(V) ; V < 0 ; V > 256), !, '$do_error'(type_error(byte,V),put_byte(S,V)). put_byte(S,V) :- '$put_byte'(S,V). put_char(V) :- var(V), !, '$do_error'(instantiation_error,put_char(V)). put_char(V) :- ( atom(V) -> atom_codes(V,[_,_|_]) ; true ), !, '$do_error'(type_error(character,V),put_char(V)). put_char(V) :- current_output(S), atom_codes(V,[I]), '$put'(S,I). put_char(S,V) :- var(V), !, '$do_error'(instantiation_error,put_char(S,V)). put_char(S,V) :- ( atom(V) -> atom_codes(V,[_,_|_]) ; true ), !, '$do_error'(type_error(character,V),put_char(S,V)). put_char(S,V) :- atom_codes(V,[I]), '$put'(S,I). put_code(V) :- var(V), !, '$do_error'(instantiation_error,put_code(V)). put_code(V) :- (\+ integer(V)), !, '$do_error'(type_error(character_code,V),put_code(V)). put_code(V) :- current_output(S), '$put'(S,V). put_code(S,V) :- var(V), !, '$do_error'(instantiation_error,put_code(S,V)). put_code(S,V) :- (\+ integer(V)), !, '$do_error'(type_error(character_code,V),put_code(S,V)). put_code(S,V) :- '$put'(S,V). put(N) :- current_output(S), N1 is N, '$put'(S,N1). put(Stream,N) :- N1 is N, '$put'(Stream,N1). skip(N) :- current_input(S), N1 is N, '$skip'(S,N1). skip(Stream,N) :- N1 is N, '$skip'(Stream,N1). '$tab'(N) :- N<1, !. '$tab'(N) :- put(32), N1 is N-1, '$tab'(N1). tab(N) :- '$tab'(N), fail. tab(_). '$tab'(_,N) :- N<1, !. '$tab'(Stream,N) :- put(Stream,32), N1 is N-1, '$tab'(Stream,N1). tab(Stream,N) :- '$tab'(Stream,N), fail. tab(_,_). ttyget(N) :- get(user_input,N). ttyget0(N) :- get0(user_input,N). ttyskip(N) :- N1 is N, '$skip'(user_input,N1). ttyput(N) :- N1 is N, '$put'(user_output,N1). ttynl :- nl(user_output). current_line_number(N) :- current_input(Stream), line_count(Stream, N). current_line_number(Stream,N) :- line_count(Stream, N). stream_position(user,N) :- !, '$show_stream_position'(user_input,N). stream_position(A,N) :- atom(A), '$current_stream'(_,_,S), '$user_file_name'(S,A), !, '$show_stream_position'(S,N). stream_position(S,N) :- '$show_stream_position'(S,N). stream_position(user,N,M) :- !, '$stream_position'(user_input,N,M). stream_position(A,N,M) :- atom(A), '$current_stream'(_,_,S), '$user_file_name'(S,A), !, '$stream_position'(S,N,M). stream_position(S,N,M) :- '$stream_position'(S,N,M). '$stream_position'(S,N,M) :- var(M), !, '$show_stream_position'(S,N), M = N. '$stream_position'(S,N,M) :- '$show_stream_position'(S,N), '$set_stream_position'(S,M). set_stream_position(S,N) :- var(S), !, '$do_error'(instantiation_error, set_stream_position(S, N)). set_stream_position(user,N) :- !, '$set_stream_position'(user_input,N). set_stream_position(A,N) :- atom(A), '$current_stream'(_,_,S), '$user_file_name'(S,A), !, '$set_stream_position'(S,N). set_stream_position(S,N) :- '$set_stream_position'(S,N). '$show_stream_eof'(Stream, past) :- '$past_eof'(Stream), !. '$show_stream_eof'(Stream, at) :- '$peek'(Stream,N), N = -1, !. '$show_stream_eof'(_, not). '$show_stream_eof_action'(Fl, error) :- Fl /\ 0x0200 =:= 0x0200, !. '$show_stream_eof_action'(Fl, reset) :- Fl /\ 0x0400 =:= 0x0400, !. '$show_stream_eof_action'(_, eof_code). '$show_stream_reposition'(Fl, true) :- Fl /\ 0x2000 =:= 0x2000, !. '$show_stream_reposition'(_, false). '$show_stream_bom'(Fl, true) :- '$has_bom'(Fl), !. '$show_stream_bom'(_, false). '$show_stream_type'(Fl, binary) :- Fl /\ 0x0100 =:= 0x0100, !. '$show_stream_type'(_, text). at_end_of_stream :- current_input(S), at_end_of_stream(S). at_end_of_stream(S) :- '$past_eof'(S), !. at_end_of_stream(S) :- '$peek'(S,N), N = -1. at_end_of_line :- current_input(S), at_end_of_line(S). at_end_of_line(S) :- '$past_eof'(S), !. at_end_of_line(S) :- '$peek'(S,N), ( N = 10 -> true ; N = -1). consult_depth(LV) :- '$show_consult_level'(LV). current_char_conversion(X,Y) :- var(X), !, '$all_char_conversions'(List), '$fetch_char_conversion'(List,X,Y). current_char_conversion(X,Y) :- '$current_char_conversion'(X,Y). '$fetch_char_conversion'([X,Y|_],X,Y). '$fetch_char_conversion'([_,_|List],X,Y) :- '$fetch_char_conversion'(List,X,Y). current_stream(File, Opts, Stream) :- '$current_stream'(File, Opts, Stream). '$extend_file_search_path'(P) :- atom_codes(P,S), '$env_separator'(ES), '$split_for_path'(S,0'=,ES,Paths), %' '$add_file_search_paths'(Paths). '$split_for_path'([], _, _, []). '$split_for_path'(S, S1, S2, [A1=A2|R]) :- '$fetch_first_path'(S, S1, A1, SR1), '$fetch_second_path'(SR1, S2, A2, SR), '$split_for_path'(SR, S1, S2, R) . '$fetch_first_path'([S1|SR],S1,[],SR) :- !. '$fetch_first_path'([C|S],S1,[C|F],SR) :- '$fetch_first_path'(S,S1,F,SR). '$fetch_second_path'([],_,[],[]). '$fetch_second_path'([S1|SR],S1,[],SR) :- !. '$fetch_second_path'([C|S],S1,[C|A2],SR) :- '$fetch_second_path'(S,S1,A2,SR). '$add_file_search_paths'([]). '$add_file_search_paths'([NS=DS|Paths]) :- atom_codes(N,NS), atom_codes(D,DS), assert(user:file_search_path(N,D)), '$add_file_search_paths'(Paths). '$format@'(Goal,Out) :- with_output_to(codes(Out), Goal). sformat(String, Form, Args) :- format(codes(String, []), Form, Args). write_depth(T,L) :- write_depth(T,L,_). %% stream_position_data(?Field, +Pos, ?Date) % % Extract values from stream position objects. '$stream_position' is % of the format '$stream_position'(Byte, Char, Line, LinePos) stream_position_data(Prop, Term, Value) :- nonvar(Prop), !, ( stream_position_field(Prop, Pos) -> arg(Pos, Term, Value) ; throw(error(domain_error(stream_position_data, Prop))) ). stream_position_data(Prop, Term, Value) :- stream_position_field(Prop, Pos), arg(Pos, Term, Value). stream_position_field(char_count, 1). stream_position_field(line_count, 2). stream_position_field(line_position, 3). stream_position_field(byte_count, 4). '$default_expand'(Expand) :- nb_getval('$open_expands_filename',Expand). '$set_default_expand'(true) :- !, nb_setval('$open_expands_filename',true). '$set_default_expand'(false) :- !, nb_setval('$open_expands_filename',false). '$set_default_expand'(V) :- !, '$do_error'(domain_error(flag_value,V),yap_flag(open_expands_file_name,X)). prolog_file_name(File, PrologFileName) :- var(File), !, '$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)). prolog_file_name(user, Out) :- !, Out = user. prolog_file_name(File, PrologFileName) :- atom(File), !, operating_system_support:true_file_name(File, PrologFileName). prolog_file_name(File, PrologFileName) :- '$do_error'(type_error(atom,T), prolog_file_name(File, PrologFileName)). '$codes_to_chars'(String0, String, String0) :- String0 == String, !. '$codes_to_chars'(String0, [Code|String], [Char|Chars]) :- atom_codes(Char, [Code]), '$codes_to_chars'(String0, String, Chars).