Prolog "code"
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
/***************************************************************/
/* Operators Modes */
/***************************************************************/
% sys_is_infix(-Atom, -Integer, -Imteger)
sys_is_infix(xfx, 1, 1).
sys_is_infix(yfx, 0, 1).
sys_is_infix(xfy, 1, 0).
% sys_is_prefix(-Atom, -Integer)
sys_is_prefix(fx, 1).
sys_is_prefix(fy, 0).
% sys_is_postfix(-Atom, -Integer)
sys_is_postfix(xf, 1).
sys_is_postfix(yf, 0).
/***************************************************************/
/* Syntax Operators */
/***************************************************************/
/**
* The fourth argument are the printing flags.
* 1: Suppresse left operator space.
* 2: Suppresse right operator space.
* 4: Formatting of (,)/2 and (:-)/2 like operators.
* 8: Formatting of (;)/2 and (:-)/2 like operators.
*/
% sys_op(-Atom, -Atom, -Integer, -Integer, -Atom)
:- dynamic(sys_op/5).
/**
* current_op(L, M, O): [ISO 8.14.4]
* The predicate succeeds for every operator O with mode M and level L.
*/
% current_op(-Integer, -Atom, -Atom)
current_op(L, M, O) :- sys_op(O, M, L, _, _).
/**
* op(L, M, O): [ISO 8.14.3]
* The predicate succeeds. As a side effect, a new operator O with
* mode M and level L is assserted.
*/
% op(+Integer, +Atom, +Atom)
op(L, M, O) :-
must_be(integer, L),
must_be(atom, M),
must_be(atom, O),
sys_check_priority(L),
sys_op_retract(O, M),
sys_op_assert(O, M, L).
% sys_check_priority(+Integer)
sys_check_priority(L) :- L < 0,
throw(error(domain_error(not_less_than_zero, L), _)).
sys_check_priority(L) :- L > 1200,
throw(error(domain_error(operator_priority, L), _)).
sys_check_priority(_).
% sys_op_retract(+Atom, +Atom)
sys_op_retract(O, M) :- sys_is_prefix(M, _), !,
(sys_op(O, N, R, _, _), sys_is_prefix(N, _), retract(sys_op(O, N, R, _, _)), fail; true).
sys_op_retract(O, M) :- sys_is_postfix(M, _), !,
(sys_op(O, N, R, _, _), sys_is_postfix(N, _), retract(sys_op(O, N, R, _, _)), fail; true).
sys_op_retract(O, M) :- sys_is_infix(M, _, _), !,
(sys_op(O, N, R, _, _), sys_is_infix(N, _, _), retract(sys_op(O, N, R, _, _)), fail; true).
sys_op_retract(_, M) :-
throw(error(domain_error(operator_specifier, M),_)).
% sys_op_assert(+Atom, +Atom, +Integer)
sys_op_assert(_, _, 0) :- !.
sys_op_assert(O, M, _) :- sys_is_infix(M, _, _),
sys_op(O, N, _, _, _), sys_is_postfix(N, _),
throw(error(permission_error(create,operator, O),_)).
sys_op_assert(O, M, _) :- sys_is_postfix(M, _),
sys_op(O, N, _, _, _), sys_is_infix(N, _, _),
throw(error(permission_error(create,operator, O),_)).
sys_op_assert(O, M, L) :-
sys_op_punct(O, E),
sys_op_space(M, L, F),
sys_op_format(M, L, G),
H is E \/ F \/ G,
dg_get_partition(S),
assertz(sys_op(O, M, L, H, S)).
% sys_op_punct(+Atom, -Integer)
sys_op_punct(; , 2) :- !.
sys_op_punct(',', 2) :- !.
sys_op_punct(_ , 0).
% sys_op_space(+Atom, +Integer, -Integer)
sys_op_space(_, L, 0) :- L > 699, !.
sys_op_space(M, _, 1) :- sys_is_prefix(M, _), !.
sys_op_space(M, _, 2) :- sys_is_postfix(M, _), !.
sys_op_space(_, _, 3).
% sys_op_format(+Atom, +Integer, -Integer)
sys_op_format(M, L, F) :- sys_is_infix(M, _, _), !, sys_op_format2(L, F).
sys_op_format(M, L, F) :- sys_is_prefix(M, _), !, sys_op_format3(L, F).
sys_op_format(_, _, 0).
% sys_op_format2(+Integer, -Integer)
sys_op_format2(L, 12) :- L > 1149, !.
sys_op_format2(L, 8) :- L > 1049, !.
sys_op_format2(L, 4) :- L > 949, !.
sys_op_format2(_, 0).
% sys_op_format3(Integer, -Integer)
sys_op_format3(L, 12) :- L > 1149, !.
sys_op_format3(_, 0).
/***************************************************************/
/* Predefind Operators */
/***************************************************************/
:- op(1200, fx, :-).
:- op(1200, xfx, :-).
:- op(1200, fx, ?-).
:- op(1200, xfx, -->).
:- op(1100, xfy, ;).
:- op(1050, xfy, ->).
:- op(1000, xfy, ',').
:- op(900, fy, \+).
:- op(700, xfx, is).
:- op(700, xfx, =).
:- op(700, xfx, \=).
:- op(700, xfx, =..).
:- op(700, xfx, <).
:- op(700, xfx, =<).
:- op(700, xfx, =\=).
:- op(700, xfx, >=).
:- op(700, xfx, >).
:- op(700, xfx, =:=).
:- op(700, xfx, @<).
:- op(700, xfx, @=<).
:- op(700, xfx, \==).
:- op(700, xfx, @>=).
:- op(700, xfx, @>).
:- op(700, xfx, ==).
:- op(600, xfy, :).
:- op(500, yfx, +).
:- op(500, yfx, -).
:- op(500, yfx, /\).
:- op(500, yfx, \/).
:- op(400, yfx, *).
:- op(400, yfx, /).
:- op(400, yfx, //).
:- op(400, yfx, rem).
:- op(400, yfx, div).
:- op(400, yfx, mod).
:- op(400, yfx, xor).
:- op(400, yfx, >>).
:- op(400, yfx, <<).
:- op(200, fy, -).
:- op(200, fy, \).
:- op(200, xfx, **).
:- op(200, xfy, ^).
/********************************************************************/
/* initialization/1 */
/********************************************************************/
:- dynamic(sys_init_goal/1).
/**
* initialization(G):
* The goal G is scheduled for later execution.
*/
% initialization(+Goal)
initialization(G) :- assertz(sys_init_goal(G)).
% sys_init_goals
sys_init_goals :-
retract(sys_init_goal(G)),
catch(sys_must(G), Error, sys_print_error(Error)),
fail.
sys_init_goals.
% sys_must(+Goal)
sys_must(X) :- X, !.
sys_must(_) :- throw(error(syntax_error(directive_failed),_)).
/********************************************************/
/* Prolog Baseline */
/********************************************************/
/**
* sys_baseline:
* The predicate processes the option arguments.
* Runtime Library incarnation.
*/
% sys_baseline
sys_baseline :-
current_prolog_flag(argv, L),
sys_baseline(L).
% sys_baseline(+List)
sys_baseline(['-h'|_]) :- !,
current_output(Stream),
put_message(Stream, command(runtime)), nl.
sys_baseline([H|_]) :-
sub_atom(H, 0, _, _, '-'),
throw(error(system_error(option_command), _)).
sys_baseline(_).
/*************************************************************/
/* Prolog Launch */
/*************************************************************/
/**
* sys_launch(R):
* The predicate launches the remainder arguments.
*/
% sys_launch
sys_launch :-
current_prolog_flag(argv, L),
sys_launch(L).
% sys_launch(+List)
sys_launch(['-h'|_]) :- !.
sys_launch([]) :-
ensure_loaded(library(tester/session)),
version,
prolog.
sys_launch([H|_]) :-
ensure_loaded(H),
sys_init_goals.
/*********************************************************************/
/* Net Dedection */
/*********************************************************************/
% sys_net_request(+Atom)
sys_net_request(P) :-
sys_net_path(P).
sys_net_request(_) :-
current_prolog_flag(base_url, B), sys_net_path(B).
% sys_net_path(+Atom)
sys_net_path(P) :-
sub_atom(P, 0, _, _, 'http:').
sys_net_path(P) :-
sub_atom(P, 0, _, _, 'https:').
/*********************************************************************/
/* File Open */
/*********************************************************************/
/**
* open(P, M, S): [ISO 8.11.5.4]
* open(P, M, S, O): [ISO 8.11.5.4]
* The built-in succeeds in S with a new stream for the path P and the
* mode M. The quaternary predicate allows specifying open options O.
*/
% open(+Atom, +Atom, -Stream)
open(P, M, S) :-
open(P, M, S, []).
% open(+Atom, +Atom, -Stream, +List)
open(P, M, S, List) :- sys_net_request(P), !,
ir_object_new(Map),
sys_open_opts(List, Map),
sys_open_http(P, M, Map, S),
sys_open_results(List, Map).
open(P, M, S, List) :-
ir_object_new(Map),
sys_stream_opts(List, Map),
sys_open_file(P, M, Map, S).
% sys_open_file(+Atom, +Atom, +Map, -Stream)
sys_open_file(P, read, Map, S) :- current_prolog_flag(read_async, on), !,
os_open_promise(P, Map, S, Q),
'$YIELD'(Q).
sys_open_file(P, M, Map, S) :-
os_open_sync(P, M, Map, S).
% sys_open_http(+Atom, +Atom, +Map, -Stream)
sys_open_http(P, read, Map, S) :- current_prolog_flag(read_async, on), !,
net_open_promise(P, Map, S, Q),
'$YIELD'(Q).
sys_open_http(P, M, Map, S) :-
net_open_sync(P, M, Map, S).
/**
* close(S): [ISO 8.11.6]
* The built-in succeeds. As a side effect, the stream S is closed.
*/
% close(+Stream)
close(S) :- ir_object_current(S, 'flags', F), F /\ 2 =\= 0, !,
os_close_promise(S, P),
'$YIELD'(P).
close(S) :-
os_close_sync(S).
/***************************************************************/
/* Newline, Flush and Tab */
/***************************************************************/
/**
* nl: [ISO 8.12.3]
* nl(S): [ISO 8.12.3]
* The predicate succeeds. As a side effect, a newline is written.
* The unary predicate allows specifying an output stream S.
*/
% nl
nl :-
current_output(Stream),
put_atom(Stream, '\n'),
flush_output(Stream).
% nl(+Stream)
nl(Stream) :-
ir_object_current(Stream, 'flags', F), F /\ 16 =\= 0, !,
put_atom(Stream, '\n'),
flush_output(Stream).
nl(Stream) :-
put_atom(Stream, '\n').
/**
* flush_output: [ISO 8.11.7]
* flush_output(S): [ISO 8.11.7]
* The predicate succeeds. As a side effect, the current
* output is flushed. The unary predicate allows specifying
* an output stream S.
*/
% flush_output
flush_output :-
current_output(S),
flush_output(S).
% flush_output(+Stream)
% defined as special
/***********************************************************************/
/* Code I/O */
/***********************************************************************/
/**
* put_code(C): [ISO 8.12.3]
* put_code(S, C): [ISO 8.12.3]
* The unary predicate writes the code C to the standard output.
* The binary predicate takes an additional output stream S as argument.
*/
% put_code(+Code)
put_code(Code) :-
current_output(Stream),
char_code(Atom, Code),
put_atom(Stream, Atom).
% put_code(+Stream, +Code)
put_code(Stream, Code) :-
char_code(Atom, Code),
put_atom(Stream, Atom).
/**
* get_code(C): [ISO 8.12.1]
* get_code(S, C): [ISO 8.12.1]
* The predicate reads a code from the standard input. The predicate
* succeeds when C unifies with the read code or the integer -1 when the
* end of the stream has been reached. The binary predicate takes an additional
* input stream S as argument.
*/
% get_code(-Code)
get_code(Code) :-
current_input(Stream),
get_code(Stream, Code).
% get_code(+Stream, -Code)
get_code(S, C) :- os_get_code(S, H), !, H = C.
get_code(S, C) :- sys_read_buffer(S), os_get_code(S, H), !, H = C.
get_code(_, C) :- -1 = C.
/**
* peek_code(C): [ISO 8.12.2]
* peek_code(T, C): [ISO 8.12.2]
* The predicate reads a code from the standard input and puts it back. The
* predicate succeeds when C unifies with the read code or the integer -1 when
* the end of the stream has been reached. The binary predicate takes an
* additional input stream S as argument.
*/
% peek_code(-Code)
peek_code(Code) :-
current_input(Stream),
peek_code(Stream, Code).
% peek_code(+Stream, -Code)
peek_code(S, C) :- os_peek_code(S, H), !, H = C.
peek_code(S, C) :- sys_read_buffer(S), os_peek_code(S, H), !, H = C.
peek_code(_, C) :- -1 = C.
% sys_read_buffer(+Stream)
sys_read_buffer(S) :-
ir_object_current(S, 'flags', F), F /\ 2 =\= 0, !,
os_read_promise(S, P), '$YIELD'(P).
sys_read_buffer(S) :-
os_read_sync(S).
/***************************************************************/
/* Atom I/O */
/***************************************************************/
/**
* put_atom(S):
* put_atom(S, A):
* The built-in succeeds. As a side effect, it adds the atom
* A to the output stream. The binary predicate allows
* specifying an output stream S.
*/
% put_atom(+Atom)
put_atom(A) :-
current_output(S),
put_atom(S, A).
% put_atom(+Stream, +Atom)
% defined as special
/**
* get_atom(A, O):
* get_atom(S, A, O):
* The built-in succeeds in A with the atom from the input
* stream up to the atom options O. The ternary predicate
* allows specifying an input stream S.
*/
% get_atom(-Atom, +List)
get_atom(A, O) :-
current_input(S),
get_atom(S, A, O).
% get_atom(+Stream, -Atom, +List)
get_atom(S, A, O) :-
sys_atom_opts(O, v(0'\n,1,0), v(D,F,M)),
sys_get_code(S, H, F),
sys_get_code_list(H, D, M, S, L, F),
atom_codes(A, L).
% sys_get_code_list(+Integer, +Integer, +Integer, +Stream, -List, +Integer)
sys_get_code_list(-1, _, _, _, [], _) :- !.
sys_get_code_list(H, H, _, _, [H], _) :- !.
sys_get_code_list(H, _, 1, _, [H], _) :- !.
sys_get_code_list(H, D, 0, S, [H|L], F) :- !,
sys_get_code(S, J, F),
sys_get_code_list(J, D, 0, S, L, F).
sys_get_code_list(H, D, M, S, [H|L], F) :-
sys_get_code(S, J, F),
N is M-1,
sys_get_code_list(J, D, N, S, L, F).
/**
* sys_get_code(S, C, F):
* Like get_code/2 but compresses line terminators '\n',
* '\r' and '\r\n' into a single '\n' in case the flag F
* has bit 0x00000001 set.
*/
% sys_get_code(+Stream, -Integer, +Integer)
sys_get_code(S, C, F) :- F /\ 1 =:= 0, !,
get_code(S, C).
sys_get_code(S, C, G) :-
ir_object_current(S, 'flags', F),
get_code(S, H),
sys_get_code_more(H, F, S, C, G).
% sys_get_code_more(+Integer, +Integer, +Stream, -Integer, +Integer)
sys_get_code_more(13, _, _, 10, _) :- !.
sys_get_code_more(10, F, S, C, G) :- F /\ 1 =\= 0, !,
sys_get_code(S, C, G).
sys_get_code_more(H, _, _, H, _).
/***************************************************************/
/* Decode Atom Options */
/***************************************************************/
% sys_atom_opts(+List, +Triple, -Triple)
sys_atom_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_atom_opts([X|L], I, O) :- !,
sys_atom_opt(X, I, H),
sys_atom_opts(L, H, O).
sys_atom_opts([], H, H) :- !.
sys_atom_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% sys_atom_opt(+Option, +Triple, -Triple)
sys_atom_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_atom_opt(stop(D), v(_,F,M), v(D,F,M)) :- !.
sys_atom_opt(compress(B), v(D,F,M), v(D,G,M)) :- !,
sys_opt_boolean(B, 1, F, G).
sys_atom_opt(max(M), v(D,F,_), v(D,F,M)) :- !.
sys_atom_opt(O, _, _) :-
throw(error(domain_error(atom_option,O),_)).
/***************************************************************/
/* Write Convenience */
/***************************************************************/
/**
* write(T): [ISO 8.14.2]
* write(S, T): [ISO 8.14.2]
* The predicate succeeds. As a side effect the term T is written.
* The binary predicate allows specifying an output stream S.
*/
% write(+Term)
write(Term) :-
current_output(Stream),
write_term(Stream, Term, [numbervars(true)]).
% write(+Stream, +Term)
write(Stream, Term) :-
write_term(Stream, Term, [numbervars(true)]).
/**
* writeq(T): [ISO 8.14.2]
* writeq(S, T): [ISO 8.14.2]
* The predicate succeeds. As a side effect the term T is written
* with quoted strings. The binary predicate allows specifying an
* output stream S.
*/
% writeq(+Term)
writeq(Term) :-
current_output(Stream),
write_term(Stream, Term, [numbervars(true), quoted(true)]).
% writeq(+Stream, +Term)
writeq(Stream, Term) :-
write_term(Stream, Term, [numbervars(true), quoted(true)]).
/**
* write_canonical(T): [ISO 8.14.2]
* write_canonical(S, T): [ISO 8.14.2]
* The predicate succeeds. As a side effect the term T is written
* with quoted strings and ignored operators. The binary predicate
* allows specifying an output stream S.
*/
% write_canonical(+Term)
write_canonical(Term) :-
current_output(Stream),
write_term(Stream, Term, [quoted(true), ignore_ops(true)]).
% write_canonical(+Stream, +Term)
write_canonical(Stream, Term) :-
write_term(Stream, Term, [quoted(true), ignore_ops(true)]).
/**
* write_term(T, O): [ISO 8.14.2]
* write_term(S, T, O): [ISO 8.14.2]
* The predicate succeeds. As a side effect the term T is written with
* options O. The ternary predicate allows specifying an output stream S.
* For the available options see the documentation.
*/
% write_term(+Term, +List)
write_term(Term, Opts) :-
current_output(Stream),
write_term(Stream, Term, Opts).
/****************************************************************/
/* Error Printing */
/****************************************************************/
/**
* sys_print_error(E):
* sys_print_error(S, E):
* The predicate succeeds. As a side effect it prints the
* error E to the error stream. The binary predicate allows
* specifying the destination stream.
*/
% sys_print_error(+Error)
sys_print_error(Error) :-
current_error(Stream),
sys_print_error(Stream, Error).
% sys_print_error(+Stream, +Error)
sys_print_error(Stream, Error) :-
ir_object_current(Stream, 'flags', F), F /\ 12 =\= 0, !,
sys_fancy_problem(Error, Stream).
sys_print_error(Stream, Error) :-
sys_print_problem(Error, Stream).
% sys_print_problem(+Error, +Stream)
sys_print_problem(Error, Stream) :- var(Error), !,
put_message(Stream, exception(unknown, Error), Stream),
nl(Stream).
sys_print_problem(cause(Primary, Secondary), Stream) :- !,
sys_print_problem(Primary, Stream),
sys_print_problem(Secondary, Stream).
sys_print_problem(error(Message, Trace), Stream) :- !,
put_message(Stream, exception(error)),
put_message(Stream, Message), nl(Stream),
sys_print_trace(Trace, Stream).
sys_print_problem(warning(Message, Trace), Stream) :- !,
put_message(Stream, exception(warning)),
put_message(Stream, Message), nl(Stream),
sys_print_trace(Trace, Stream).
sys_print_problem(Error, Stream) :-
put_message(Stream, exception(unknown, Error)),
nl(Stream).
% sys_print_trace(+List, +Stream)
sys_print_trace(Trace, Stream) :- var(Trace), !,
put_message(Stream, exception(context, Trace)),
nl(Stream).
sys_print_trace([Frame|Trace], Stream) :- !,
sys_print_frame(Frame, Stream),
nl(Stream),
sys_print_trace(Trace, Stream).
sys_print_trace([], _) :- !.
sys_print_trace(Trace, Stream) :-
put_message(Stream, exception(context, Trace)),
nl(Stream).
% sys_print_frame(+Term, +Stream)
sys_print_frame(sys_including(File, Include), Stream) :- atom(File), !,
file_base_name(File, Name),
ir_object_current(Include, 'lineno', Line),
put_message(Stream, file_line(Name, Line)).
sys_print_frame(Frame, Stream) :-
put_message(Stream, Frame).
/***************************************************************/
/* Read Convenience */
/***************************************************************/
/**
* read(E): [ISO 8.14.1]
* read(S, E): [ISO 8.14.1]
* The predicate succeeds in E with the read term or end_of_file.
* As a side effect, the input position is advanced. The binary
* predicate allows specifying an input stream S.
*/
% read(-Term)
read(Term) :-
current_input(Stream),
get_code(Stream, Code),
sys_read_term(Code, Stream, [], Term).
% read(+Stream, -Term)
read(Stream, Term) :-
get_code(Stream, Code),
sys_read_term(Code, Stream, [], Term).
/**
* read_term(E, O): [ISO 8.14.1]
* read_term(S, E, O): [ISO 8.14.1]
* The predicate succeeds in E with the read term or end_of_file
* and in O with the options. As a side effect, the input position
* is advanced. The ternary predicate allows specifying an input
* stream. For the available options see the documentation.
*/
% read_term(-Term, -List)
read_term(Term, Opt) :-
current_input(Stream),
get_code(Stream, Code),
sys_read_term(Code, Stream, Opt, Term).
% read_term(+Stream, -Term, -List)
read_term(Stream, Term, Opt) :-
get_code(Stream, Code),
sys_read_term(Code, Stream, Opt, Term).
/****************************************************************/
/* File Properties */
/****************************************************************/
/**
* file_property(F, P):
* The predicate succeeds in P with the properties of the file F.
*/
% file_property(+Atom, -Term)
file_property(P, Prop) :- var(Prop), !,
sys_prop_map(P, Map),
ir_object_keys(Map, Keys),
member(Key, Keys),
ir_object_current(Map, Key, Value),
Prop =.. [Key,Value].
file_property(P, Prop) :-
Prop =.. [Key,Value2],
sys_prop_map(P, Map),
ir_object_current(Map, Key, Value), !,
Value2 = Value.
file_property(_, Prop) :-
Prop =.. [Key,_],
throw(error(domain_error(prolog_flag, Key),_)).
% sys_prop_map(+Atom, -Map)
sys_prop_map(P, Map) :- sys_net_request(P), !,
sys_prop_http(P, Map).
sys_prop_map(P, Map) :-
sys_prop_file(P, Map).
% sys_prop_file(+Atom, -Map)
sys_prop_file(P, Map) :- current_prolog_flag(prop_async, on), !,
os_prop_promise(P, Map, Prom),
'$YIELD'(Prom).
sys_prop_file(P, Map) :-
os_prop_sync(P, Map).
% sys_prop_http(+Atom, -Map)
sys_prop_http(P, Map) :- current_prolog_flag(prop_async, on), !,
net_prop_promise(P, Map, Prom),
'$YIELD'(Prom).
sys_prop_http(P, Map) :-
net_prop_sync(P, Map).
/**
* set_file_property(F, P):
* The predicate assigns the property P to the file F.
*/
% set_file_property(+Atom, +Term)
set_file_property(P, Q) :- sys_net_request(P), !,
net_cntrl_sync(P, Q).
set_file_property(P, Q) :-
os_cntrl_sync(P, Q).
/**
* file_directory_name(F, G):
* The predicate succeeds in G with the directory name of the file name F.
* The trailing file separator is included in the directory name.
*/
% file_directory_name(+Atom, -Atom)
file_directory_name(Path, Dir) :-
(last_sub_atom(Path, Pos1, _, _, '/') -> true; Pos1 = -1),
(last_sub_atom(Path, Pos2, _, _, '\\') -> true; Pos2 = -1),
Pos is max(Pos1, Pos2),
Pos3 is Pos+1,
sub_atom(Path, 0, Pos3, _, Dir).
/**
* file_base_name(F, G):
* The predicate succeeds in G with the base name of the file name F.
* File names with trailing file separator return empty base name.
*/
% file_base_name(+Atom, -Atom)
file_base_name(Path, Name) :-
atom_length(Path, Len),
(last_sub_atom(Path, _, _, Pos1, '/') -> true; Pos1 = Len),
(last_sub_atom(Path, _, _, Pos2, '\\') -> true; Pos2 = Len),
Pos is min(Pos1, Pos2),
sub_atom(Path, _, Pos, 0, Name).
/***************************************************************/
/* Path Utilities */
/***************************************************************/
/**
* absolute_file_name(F, G):
* absolute_file_name(F, G, L):
* The predicate succeeds in G with the absolute file name of F.
* If F is already an absolute file name, then F is returned unchanged,
* otherwise the F is resolved against the Prolog flag base_url. The
* ternary predicate allows specifying absolute file options.
*/
% absolute_file_name(+Atom, +Atom)
absolute_file_name(Path, Path2) :-
absolute_file_name(Path, Path2, []).
% absolute_file_name(+Atom, +Atom, +List)
absolute_file_name(Path, Path3, Opts) :-
current_prolog_flag(base_url, Base),
sys_absolute_opts(Opts, v('',Base), v(Ext,Base2)),
sys_file_complete(Ext, Path, Path2),
sys_file_combine(Base2, Path2, Path3).
% sys_absolute_opts(+List, +Pair, -Pair)
sys_absolute_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_absolute_opts([X|L], F, G) :- !,
sys_absolute_opt(X, F, H),
sys_absolute_opts(L, H, G).
sys_absolute_opts([], F, F) :- !.
sys_absolute_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% sys_absolute_opt(+Term, +Pair, -Pair)
sys_absolute_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_absolute_opt(relative_to(R), v(E,_), v(E,R)) :- !.
sys_absolute_opt(extension(E), v(_,R), v(E,R)) :- !.
sys_absolute_opt(O, _, _) :-
throw(error(domain_error(absolute_option,O),_)).
% sys_file_complete(+Atom, +Atom, -Atom)
sys_file_complete('', Path, Path) :- !.
sys_file_complete(_, Path, Path) :-
file_base_name(Path, Name),
sub_atom(Name, _, _, _, '.'), !.
sys_file_complete(Ext, Path, Path2) :-
atom_concat(Path, Ext, Path2).
% sys_file_combine(+Atom, +Atom, -Atom)
sys_file_combine(_, Path, Path2) :-
is_absolute_file_name(Path), !,
Path = Path2.
sys_file_combine(Base, Path, Path3) :-
(sub_atom(Path, 0, _, _, '../'); sub_atom(Path, 0, _, _, '..\\')), !,
sub_atom(Path, 3, _, 0, Path2),
file_directory_name(Base, Dir),
sub_atom(Dir, 0, _, 1, Base2),
sys_file_combine(Base2, Path2, Path3).
sys_file_combine(Base, Path, Path2) :-
file_directory_name(Base, Dir),
atom_concat(Dir, Path, Path2).
/**
* is_absolute_file_name(F):
* The predicate succeeds if F is an absolute file name. A file name is
* considered absolute if it starts with a file separator or if it contains
* a protocol separator before the first file separator or in itself.
*/
% is_absolute_file_name(+Atom)
is_absolute_file_name(Path) :-
atom_length(Path, Len),
(sub_atom(Path, Pos1, _, _, '/') -> true; Pos1 = Len),
(sub_atom(Path, Pos2, _, _, '\\') -> true; Pos2 = Len),
Pos is min(Pos1, Pos2),
(Pos == 0 -> Pos < Len;
sub_atom(Path, Pos3, _, _, ':') -> Pos3 < Pos;
fail).
/*************************************************************/
/* Relative Utility */
/*************************************************************/
% sys_file_relative(+Term, -Atom)
sys_file_relative(V, _) :- var(V),
throw(error(instantiation_error, _)).
sys_file_relative(library(Path), Path2) :- !,
sys_file_compound(Path, 'liblet', '.p', Path2).
sys_file_relative(foreign(Path), Path2) :- !,
current_prolog_flag(foreign_ext, Ext),
sys_file_compound(Path, 'doglet', Ext, Path2).
sys_file_relative(Path, Path2) :-
sys_file_including(Base), !,
absolute_file_name(Path, Path2, [relative_to(Base),extension('.p')]).
sys_file_relative(Path, Path2) :-
absolute_file_name(Path, Path2, [extension('.p')]).
% sys_file_compound(+Path, +Atom, +Atom, -Atom)
sys_file_compound(Path, Dir, Ext, Path2) :-
sys_file_struct(Path, Path4),
atom_join([Dir, '/', Path4, Ext], Path3),
current_prolog_flag(system_url, Base),
sys_file_combine(Base, Path3, Path2).
% sys_file_including(-Atom)
sys_file_including(Base) :-
current_task(Task),
sys_including(Base, Task, _), !, Base \== user.
% sys_file_struct(+Term, -Atom)
sys_file_struct(V, _) :- var(V),
throw(error(instantiation_error, _)).
sys_file_struct(Path/Path2, Path3) :- !,
sys_file_struct(Path, Path4),
atom_join([Path4, '/', Path2], Path3).
sys_file_struct(Path, Path2) :- atom(Path), !,
Path = Path2.
sys_file_struct(Path, _) :-
throw(error(type_error(atom, Path),_)).
/****************************************************************/
/* Other Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile(strings/3).
strings('exception.unknown', de, 'Ausnahme unbekannt: ~q').
strings('exception.error', de, 'Fehler: ').
strings('exception.warning', de, 'Warnung: ').
strings('exception.template', de, 'Vorlage unbekannt: ~q').
strings('exception.context', de, ' Kontext unbekannt: ~q').
strings('file_line', de, ' ~q auf ~q').
strings('command.runtime', de, 'Benutzung: opt_1 .. opt_m [text arg_1 .. arg_n]\n\
Falls kein text spezifiziert ist, wird Banner gezeigt und dann\n\
Top-Level ausgeführt, andernfalls wird text ausgeführt.\n\
-h Diesen Hilfetext anzeigen und Vorgang beenden').
strings('system_error.option_command', de, 'Ungültige Befehlzeilenoption, -h für weitere Informationen.').
strings('exception.unknown', '', 'Unknown exception: ~q').
strings('exception.error', '', 'Error: ').
strings('exception.warning', '', 'Warning: ').
strings('exception.template', '', 'Unknown template: ~q').
strings('exception.context', '', ' Unknown context: ~q').
strings('file_line', '', ' ~q at ~q').
strings('command.runtime', '', 'Usage: opt_1 ... opt_m [text arg_1 ... arg_n]\n\
If no text is specified, banner is shown and then top-level\n\
is executed, otherwise text is executed.\n\
-h Display this help and exit.').
strings('system_error.option_command', '', 'Invalid command line option, -h for more information.').
/****************************************************************/
/* Error Texts */
/****************************************************************/
strings('evaluation_error.float_overflow', de, 'Die Funktion überschreitet hier den Gleitpunktzahlbereich.').
strings('evaluation_error.undefined', de, 'Die Funktion ist hier undefiniert.').
strings('evaluation_error.zero_divisor', de, 'Nulldivision.').
strings('resource_error.not_supported', de, 'Nicht unterstützte Operation.').
strings('resource_error.interrupted_exception', de, 'Unerwartet unterbrochene Operation.').
strings('representation_error.int', de, 'Unerlaubte Ganzzahl (nicht zwischen - 2^31 und 2^31-1).').
strings('representation_error.long', de, 'Unerlaubte Ganzzahl (nicht zwischen - 2^63 und 2^63-1).').
strings('representation_error.max_arity', de, 'Unerlaubte Stelligkeit (nicht kleiner oder gleich 2^31-1).').
strings('domain_error.prolog_flag', de, 'Flag erwartet, gefunden ~q.').
strings('domain_error.not_less_than_zero', de, 'Positiv oder 0 erwartet, gefunden ~q.').
strings('domain_error.operator_priority', de, 'Operatorlevel (kleiner oder gleich 1200) erwartet, gefunden ~q.').
strings('domain_error.operator_specifier', de, 'Operatormode (fx, fy, xfx, yfx, xfy, xf, yf) erwartet, gefunden ~q.').
strings('domain_error.time_format', de, 'Zeitformat erwartet, gefunden ~q.').
strings('domain_error.atom_option', de, 'Atomoption erwartet, gefunden ~q.').
strings('domain_error.absolute_option', de, 'Absolutoption erwartet, gefunden ~q.').
strings('type_error.atom', de, 'Atom erwartet, gefunden ~q.').
strings('type_error.number', de, 'Zahl erwartet, gefunden ~q.').
strings('type_error.integer', de, 'Ganzzahl erwartet, gefunden ~q.').
strings('type_error.callable', de, 'Argument sollte aufrufbar sein (Atom oder Verbund), gefunden ~q.').
strings('type_error.atomic', de, 'Argument sollte atomar sein, gefunden ~q.').
strings('type_error.list', de, 'Liste ([] oder [_|_]) erwartet, gefunden ~q.').
strings('type_error.evaluable', de, 'Berechenbaren Funktion erwartet, gefunden ~q.').
strings('type_error.character', de, 'Zeichen erwartet, gefunden ~q.').
strings('type_error.pair', de, 'Paar (_-_) erwartet, gefunden ~q.').
strings('type_error.predicate_indicator', de, 'Prädikatindikator (_/_) erwartet, gefunden ~q.').
strings('type_error.maybe', de, 'Option (nothing oder just(_)) erwartet, gefunden ~q.').
strings('permission_error.modify.flag', de, 'Kann schreibgeschütztes Flag ~q nicht aktualisieren.').
strings('evaluation_error.float_overflow', '', 'The function overflows the float range here.').
strings('evaluation_error.undefined', '', 'The function is undefined here.').
strings('evaluation_error.zero_divisor', '', 'Division by zero.').
strings('resource_error.not_supported', '', 'Operation not supported.').
strings('resource_error.interrupted_exception', '', 'Operation terminated unexpectedly.').
strings('representation_error.int', '', 'Illegal integer (not between - 2^31 and 2^31-1).').
strings('representation_error.long', '', 'Illegal integer (not between - 2^63 and 2^63-1).').
strings('representation_error.max_arity', '', 'Illegal arity (not less or equal 2^31-1).').
strings('domain_error.prolog_flag', '', 'Flag expected, found ~q.').
strings('domain_error.not_less_than_zero', '', 'Positive or 0 expected, found ~q.').
strings('domain_error.operator_priority', '', 'Operator level (less or equal 1200) expected, found ~q.').
strings('domain_error.operator_specifier', '', 'Operator mode (fx, fy, xfx, yfx, xfy, xf, yf) expected, found ~q.').
strings('domain_error.time_format', '', 'Time format expected, found ~q.').
strings('domain_error.atom_option', '', 'Atom option expected, found ~q.').
strings('domain_error.absolute_option', '', 'Absolute option expected, found ~q.').
strings('type_error.atom', '', 'Atom expected, found ~q.').
strings('type_error.number', '', 'Number expected, found ~q.').
strings('type_error.integer', '', 'Integer expected, found ~q.').
strings('type_error.callable', '', 'Argument should be callable (atom or compound), found ~q.').
strings('type_error.atomic', '', 'Argument should be an atomic, found ~q.').
strings('type_error.list', '', 'List ([] or [_|_]) expected, found ~q.').
strings('type_error.evaluable', '', 'Evaluable functor expected, found ~q.').
strings('type_error.character', '', 'Character expected, found ~q.').
strings('type_error.pair', '', 'Pair (_-_) expected, found ~q.').
strings('type_error.predicate_indicator', '', 'Predicate indicator (_/_) expected, found ~q.').
strings('type_error.maybe', '', 'Maybe (nothing or just(_)) expected, found ~q.').
strings('permission_error.modify.flag', '', 'Can\'t modify read-only flag ~q.').