/************************************************************************* * * * 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 */ open(Source,M,T) :- var(Source), !, '$do_error'(instantiation_error,open(Source,M,T)). open(Source,M,T) :- var(M), !, '$do_error'(instantiation_error,open(Source,M,T)). open(Source,M,T) :- nonvar(T), !, '$do_error'(type_error(variable,T),open(Source,M,T)). open(File0,Mode,Stream) :- '$default_encoding'(Encoding), '$default_expand'(Expansion), '$expand_filename'(Expansion, File0, File), '$open'(File,Mode,Stream,16,Encoding). /* 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(_) */ close(V) :- var(V), !, '$do_error'(instantiation_error,close(V)). close(File) :- atom(File), !, ( '$access_yap_flags'(8, 0), current_stream(_,_,Stream), '$user_file_name'(Stream,File) -> '$close'(Stream) ; '$close'(File) ). close(Stream) :- '$close'(Stream). close(V,Opts) :- var(V), !, '$do_error'(instantiation_error,close(V,Opts)). close(S,Opts) :- '$check_io_opts'(Opts,close(S,Opts)), /* YAP ignores the force/1 flag */ close(S). open(F,T,S,Opts) :- '$check_io_opts'(Opts,open(F,T,S,Opts)), '$process_open_opts'(Opts, 0, N, Aliases, E, BOM, Expand), '$expand_filename'(Expand, F, NF), '$open2'(NF, T, S, N, E), '$process_bom'(S, BOM), '$process_open_aliases'(Aliases,S). '$expand_filename'(false, F, F) :- !. '$expand_filename'(true, F, NF) :- system:true_file_name(F, NF). '$open2'(Source,M,T,N,_) :- var(Source), !, '$do_error'(instantiation_error,open(Source,M,T,N)). '$open2'(Source,M,T,N,_) :- var(M), !, '$do_error'(instantiation_error,open(Source,M,T,N)). '$open2'(Source,M,T,N,_) :- nonvar(T), !, '$do_error'(type_error(variable,T),open(Source,M,T,N)). '$open2'(File,Mode,Stream,N,Encoding) :- '$open'(File,Mode,Stream,N,Encoding). '$process_bom'(S, BOM) :- var(BOM), !, ( '$has_bom'(S) -> BOM = true ; BOM = false ). '$process_bom'(_, _). '$process_open_aliases'([],_). '$process_open_aliases'([Alias|Aliases],S) :- '$add_alias_to_stream'(Alias, S), '$process_open_aliases'(Aliases,S). '$process_open_opts'([], N, N, [], DefaultEncoding, [], DefaultExpand) :- '$default_encoding'(DefaultEncoding), '$default_expand'(DefaultExpand). '$process_open_opts'([type(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :- '$value_open_opt'(T,type,I1,I2), N1 is I1\/N0, N2 is I2/\N1, '$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand). '$process_open_opts'([expand_filename(T)|L], N0, N, Aliases, Encoding, BOM, Expand) :- '$valid_expand'(T, Expand), '$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, _). '$process_open_opts'([reposition(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :- '$value_open_opt'(T,reposition,I1,I2), N1 is I1\/N0, N2 is I2/\N1, '$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand). '$process_open_opts'([encoding(Enc)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :- '$valid_encoding'(Enc, EncCode), '$process_open_opts'(L, N0, N, Aliases, _, BOM, DefaultExpand). '$process_open_opts'([representation_errors(Mode)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :- '$valid_reperrorhandler'(Mode, Flag), NI is N0 \/ Flag, '$process_open_opts'(L, NI, N, Aliases, EncCode, BOM, DefaultExpand). '$process_open_opts'([bom(BOM)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :- ( var(BOM) -> true ; '$valid_bom'(BOM, Flag), NI is N0 \/ Flag ), '$process_open_opts'(L, NI, N, Aliases, EncCode, _, DefaultExpand). '$process_open_opts'([eof_action(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :- '$value_open_opt'(T,eof_action,I1,I2), N1 is I1\/N0, N2 is I2/\N1, '$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand). '$process_open_opts'([alias(Alias)|L], N0, N, [Alias|Aliases], Encoding, BOM, DefaultExpand) :- '$process_open_opts'(L,N0,N, Aliases, Encoding, BOM, DefaultExpand). '$value_open_opt'(text,_,1,X) :- X is 128-2. % default '$value_open_opt'(binary,_,2, X) :- X is 128-1. '$value_open_opt'(true,_,4, X) :- X is 128-8. '$value_open_opt'(false,_,8, X) :- X is 128-4. '$value_open_opt'(error,_,16, X) :- X is 128-32-64. '$value_open_opt'(eof_code,_,32, X) :- X is 128-16-64. '$value_open_opt'(reset,64, X) :- X is 128-32-16. %128 -> use bom %256 -> do not use bom %512 -> do prolog on unrepresentable char %1024 -> do XML on unrepresentable char '$valid_bom'(true, 128). '$valid_bom'(false, 256). '$valid_reperrorhandler'(error, 0). % default. '$valid_reperrorhandler'(prolog, 512). '$valid_reperrorhandler'(xml, 1024). '$valid_expand'(true, true), '$valid_expand'(false, false), /* 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'(close(_,_),Opt,G) :- !, (Opt = force(X) -> '$check_force_opt_arg'(X,G) ; '$do_error'(domain_error(close_option,Opt),G) ). '$check_opt'(open(_,_,_,_),Opt,G) :- '$check_opt_open'(Opt, 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_open'(type(T), G) :- !, '$check_open_type_arg'(T, G). '$check_opt_open'(reposition(T), G) :- !, '$check_open_reposition_arg'(T, G). '$check_opt_open'(alias(T), G) :- !, '$check_open_alias_arg'(T, G). '$check_opt_open'(eof_action(T), G) :- !, '$check_open_eof_action_arg'(T, G). '$check_opt_open'(encoding(T), G) :- !, '$check_open_encoding'(T, G). '$check_opt_open'(representation_errors(M), G) :- !, '$check_open_representation_errors'(M, G). '$check_opt_open'(bom(T), G) :- !, '$check_open_bom_arg'(T, G). '$check_opt_open'(A, G) :- '$do_error'(domain_error(stream_option,A),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'(cycles(T), G) :- !, '$check_cycles_arg'(T, G). '$check_opt_write'(quoted(T), G) :- !, '$check_write_quoted_arg'(T, G). '$check_opt_write'(ignore_ops(T), G) :- !, '$check_write_ignore_ops_arg'(T, G). '$check_opt_write'(numbervars(T), G) :- !, '$check_write_numbervars_arg'(T, G). '$check_opt_write'(portrayed(T), G) :- !, '$check_write_portrayed'(T, G). '$check_opt_write'(priority(T), G) :- !, '$check_priority_arg'(T, G). '$check_opt_write'(max_depth(T), G) :- !, '$check_write_max_depth'(T, G). '$check_opt_write'(A, G) :- '$do_error'(domain_error(write_option,A),G). % % check force arg % '$check_force_opt_arg'(X,G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_force_opt_arg'(true,_) :- !. '$check_force_opt_arg'(false,_) :- !. '$check_force_opt_arg'(X,G) :- '$do_error'(domain_error(close_option,force(X)),G). '$check_open_type_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_open_type_arg'(text,_) :- !. '$check_open_type_arg'(binary,_) :- !. '$check_open_opt_arg'(X,G) :- '$do_error'(domain_error(io_mode,type(X)),G). '$check_open_reposition_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_open_reposition_arg'(true,_) :- !. '$check_open_reposition_arg'(false,_) :- !. '$check_open_reposition_arg'(X,G) :- '$do_error'(domain_error(io_mode,reposition(X)),G). '$check_open_bom_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_open_bom_arg'(true,_) :- !. '$check_open_bom_arg'(false,_) :- !. '$check_open_bom_arg'(X,G) :- '$do_error'(domain_error(io_mode,bom(X)),G). '$check_open_alias_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_open_alias_arg'(X,G) :- atom(X), !, ( '$check_if_valid_new_alias'(X), X \= user -> true ; '$do_error'(permission_error(open, source_sink, alias(X)),G) ). '$check_open_alias_arg'(X,G) :- '$do_error'(domain_error(io_mode,alias(X)),G). '$check_open_eof_action_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_open_eof_action_arg'(error,_) :- !. '$check_open_eof_action_arg'(eof_code,_) :- !. '$check_open_eof_action_arg'(reset,_) :- !. '$check_open_eof_action_arg'(X,G) :- '$do_error'(domain_error(io_mode,eof_action(X)),G). '$check_open_encoding'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_open_encoding'(Encoding,_) :- '$valid_encoding'(Encoding,_), !. '$check_open_encoding'(Encoding,G) :- '$do_error'(domain_error(io_mode,encoding(Encoding)),G). '$check_open_representation_errors'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_open_representation_errors'(RepErrorHandler,_) :- '$valid_reperrorhandler'(RepErrorHandler,_), !. '$check_open_representation_errors'(Handler,G) :- '$do_error'(domain_error(io_mode,representation_errors(Handler)),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_quoted_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_write_quoted_arg'(true,_) :- !. '$check_write_quoted_arg'(false,_) :- !. '$check_write_quoted_arg'(X,G) :- '$do_error'(domain_error(write_option,write_quoted(X)),G). '$check_cycles_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_cycles_arg'(true,_) :- !. '$check_cycles_arg'(false,_) :- !. '$check_cycles_arg'(X,G) :- '$do_error'(domain_error(write_option,cycles(X)),G). '$check_write_ignore_ops_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_write_ignore_ops_arg'(true,_) :- !. '$check_write_ignore_ops_arg'(false,_) :- !. '$check_write_ignore_ops_arg'(X,G) :- '$do_error'(domain_error(write_option,ignore_ops(X)),G). '$check_write_numbervars_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_write_numbervars_arg'(true,_) :- !. '$check_write_numbervars_arg'(false,_) :- !. '$check_write_numbervars_arg'(X,G) :- '$do_error'(domain_error(write_option,numbervars(X)),G). '$check_write_portrayed'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_write_portrayed'(true,_) :- !. '$check_write_portrayed'(false,_) :- !. '$check_write_portrayed'(X,G) :- '$do_error'(domain_error(write_option,portrayed(X)),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_null_stream(S) :- '$open_null_stream'(S). open_pipe_streams(P1,P2) :- '$open_pipe_stream'(P1, P2). fileerrors :- set_value(fileerrors,1). nofileerrors :- set_value(fileerrors,0). exists(F) :- '$exists'(F,'$csult'). 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). /* 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(_) */ nl(Stream) :- '$put'(Stream,10). nl :- current_output(Stream), '$put'(Stream,10), fail. nl. 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(_,_). 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 \/ 1, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ 30, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 16, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ 15, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 2, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ 39, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 4, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ 27, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 \/ 8, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, Priority, CallBacks) :- FlagI is Flag0 /\ 23, '$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). print(T) :- '$write'(12,T), fail. print(_). print(Stream,T) :- '$write'(Stream,12,T), fail. print(_,_). 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 */ get(N) :- current_input(S), get(S,N). get_byte(V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, '$do_error'(type_error(in_byte,V),get_byte(V)). get_byte(V) :- current_input(S), '$get_byte'(S,V). get_byte(S,V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, '$do_error'(type_error(in_byte,V),get_byte(S,V)). get_byte(S,V) :- '$get_byte'(S,V). 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). get_char(V) :- \+ var(V), ( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, '$do_error'(type_error(in_character,V),get_char(V)). get_char(V) :- current_input(S), get0(S,I), ( I = -1 -> V = end_of_file ; atom_codes(V,[I])). get_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)). get_char(S,V) :- get0(S,I), ( I = -1 -> V = end_of_file ; atom_codes(V,[I])). 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])). get_code(S,V) :- \+ var(V), (\+ integer(V)), !, '$do_error'(type_error(in_character_code,V),get_code(S,V)). get_code(S,V) :- get0(S,V). get_code(V) :- \+ var(V), (\+ integer(V)), !, '$do_error'(type_error(in_character_code,V),get_code(V)). get_code(V) :- current_input(S), get0(S,V). 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). get0(N) :- current_input(S), get0(S,N). 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). ttyflush :- flush_output(user_output). flush_output :- current_output(Stream), flush_output(Stream). current_line_number(N) :- current_input(Stream), '$current_line_number'(Stream,N). current_line_number(user,N) :- !, '$current_line_number'(user_input,N). current_line_number(A,N) :- atom(A), current_stream(_,_,S), '$user_file_name'(S,A), !, '$current_line_number'(S,N). current_line_number(S,N) :- '$current_line_number'(S,N). line_count(Stream,N) :- current_line_number(Stream,N). character_count(user,N) :- !, '$character_count'(user_input,N). character_count(A,N) :- atom(A), current_stream(_,_,S), '$user_file_name'(S,A), !, '$character_count'(S,N). character_count(S,N) :- '$character_count'(S,N). line_position(user,N) :- !, '$line_position'(user_input,N). line_position(A,N) :- atom(A), current_stream(_,_,S), '$user_file_name'(S,A), !, '$line_position'(S,N). line_position(S,N) :- '$line_position'(S,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). stream_property(Stream, Prop) :- var(Prop), !, (var(Stream) -> '$current_stream'(_,_,Stream) ; true), '$generate_prop'(Prop), '$stream_property'(Stream, Prop). stream_property(Stream, Props) :- var(Stream), !, '$current_stream'(_,_,Stream), '$stream_property'(Stream, Props). stream_property(Stream, Props) :- '$current_stream'(_,_,Stream), !, '$stream_property'(Stream, Props). stream_property(Stream, Props) :- '$do_error'(domain_error(stream,Stream),stream_property(Stream, Props)). '$generate_prop'(file_name(_F)). '$generate_prop'(mode(_M)). '$generate_prop'(input). '$generate_prop'(output). '$generate_prop'(position(_P)). %'$generate_prop'(end_of_stream(_E)). '$generate_prop'(eof_action(_E)). %'$generate_prop'(reposition(_R)). '$generate_prop'(type(_T)). '$generate_prop'(alias(_A)). '$generate_prop'(bom(_B)). '$generate_prop'(encoding(_E)). '$generate_prop'(representation_errors(_E)). '$stream_property'(Stream, Props) :- var(Props), !, '$do_error'(instantiation_error, stream_properties(Stream, Props)). '$stream_property'(Stream, Props0) :- '$check_stream_props'(Props0, Props), '$check_io_opts'(Props, stream_property(Stream, Props)), '$current_stream'(F,Mode,Stream), '$process_stream_properties'(Props, Stream, F, Mode). '$check_stream_props'([], []) :- !. '$check_stream_props'([H|T], [H|T]) :- !. '$check_stream_props'(Prop, [Prop]). % '$process_stream_properties'([], _, _, _). '$process_stream_properties'([file_name(F)|Props], Stream, F, Mode) :- '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([mode(Mode)|Props], Stream, F, Mode) :- '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([input|Props], Stream, F, read) :- '$process_stream_properties'(Props, Stream, F, read). '$process_stream_properties'([output|Props], Stream, F, append) :- '$process_stream_properties'(Props, Stream, F, append). '$process_stream_properties'([output|Props], Stream, F, write) :- '$process_stream_properties'(Props, Stream, F, write). '$process_stream_properties'([position(P)|Props], Stream, F, Mode) :- '$show_stream_bom'(Stream, P), '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([encoding(Enc)|Props], Stream, F, Mode) :- % make sure this runs first, with EncCode unbound. '$encoding'(Stream, EncCode), '$valid_encoding'(Enc, EncCode), '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([bom(B)|Props], Stream, F, Mode) :- '$show_stream_bom'(Stream, B), '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([end_of_stream(P)|Props], Stream, F, Mode) :- '$show_stream_eof'(Stream, P), '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([eof_action(P)|Props], Stream, F, Mode) :- '$show_stream_flags'(Stream, Fl), '$show_stream_eof_action'(Fl, P), '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([reposition(P)|Props], Stream, F, Mode) :- '$show_stream_flags'(Stream, Fl), '$show_stream_reposition'(Fl, P), '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([representation_errors(B)|Props], Stream, F, Mode) :- '$stream_representation_error'(Stream, ErrorHandler), '$valid_reperrorhandler'(B, ErrorHandler), '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([type(P)|Props], Stream, F, Mode) :- '$show_stream_flags'(Stream, Fl), '$show_stream_type'(Fl, P), '$process_stream_properties'(Props, Stream, F, Mode). '$process_stream_properties'([alias(Alias)|Props], Stream, F, Mode) :- '$fetch_stream_alias'(Stream, Alias), '$process_stream_properties'(Props, Stream, F, Mode). '$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_chars'(Goal, _, [], Out). '$with_output_to_chars'(Goal, Stream, L0, Chars) :- charsio:open_mem_write_stream(Stream), current_output(SO), set_output(Stream), '$do_output_to_chars'(Goal, Stream, L0, Chars, SO). '$do_output_to_chars'(Goal, Stream, L0, Chars, SO) :- catch(Goal, Exception, '$handle_exception'(Exception,Stream,SO)), !, set_output(SO), charsio:peek_mem_write_stream(Stream, L0, Chars), close(Stream). '$do_output_to_chars'(_Goal, Stream, _L0, _Chars, SO) :- set_output(SO), close(Stream), fail. '$handle_exception'(Exception, Stream, SO) :- set_output(SO), close(Stream), throw(Exception). write_depth(T,L) :- write_depth(T,L,_). is_stream(S) :- catch('$check_stream'(S), _, fail), !. time_file(File, Time) :- '$file_age'(File, Time). stream_position_data(line_count, '$stream_position'(_,Data,_,_,_), Data). stream_position_data(line_position, '$stream_position'(_,_,Data,_,_), Data). %stream_position_data(char_count, '$stream_position'(Data,_,_,_,_), Data). stream_position_data(byte_count, '$stream_position'(Data,_,_,_,_), Data). '$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), !, system:true_file_name(File, PrologFileName). prolog_file_name(File, PrologFileName) :- '$do_error'(type_error(atom,T), prolog_file_name(File, PrologFileName)).