Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 XLOG Technologies AG
/**
* 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.
*/
/*********************************************************************/
/* 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 and open options O.
*/
% open(+Atom, +Atom, -Stream)
open(P, M, S) :-
sys_open(P, M, 0rNone, S).
% open(+Atom, +Atom, -Stream, +List)
open(P, M, S, List) :- (sub_atom(P, 0, _, _, 'http:'); sub_atom(P, 0, _, _, 'https:')), !,
ir_object_new(Map),
sys_open_opts(List, Map),
sys_open(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(P, M, Map, S).
% sys_open(+Atom, +Atom, +Map, -Stream)
sys_open(P, read, Map, S) :- current_prolog_flag(read_async, on), !,
os_open_promise_opts(P, Map, S, Q),
'$YIELD'(Q).
sys_open(P, M, Map, S) :-
os_open_sync_opts(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) :- os_stream_flags(S, F), F /\ 2 =\= 0, !,
os_close_promise(S, P),
'$YIELD'(P).
close(S) :-
os_close_sync(S).
/***************************************************************/
/* Newline & Flush */
/***************************************************************/
/**
* 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) :-
put_atom(Stream, '\n'),
flush_output(Stream).
/**
* 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).
/**
* 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).
/***************************************************************/
/* 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) :-
os_stream_flags(S, 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(type_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),
sys_write_term(Stream, Term, [numbervars(true)]).
% write(+Stream, +Term)
write(Stream, Term) :-
sys_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),
sys_write_term(Stream, Term, [numbervars(true), quoted(true)]).
% writeq(+Stream, +Term)
writeq(Stream, Term) :-
sys_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),
sys_write_term(Stream, Term, [quoted(true), ignore_ops(true)]).
% write_canonical(+Stream, +Term)
write_canonical(Stream, Term) :-
sys_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, Opt) :-
current_output(Stream),
sys_write_term(Stream, Term, Opt).
% write_term(+Stream, +Term, +List)
write_term(Stream, Term, Opt) :-
sys_write_term(Stream, Term, Opt).
/***************************************************************/
/* 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(Path, P) :- var(P), !,
sys_prop_map(Path, Map),
ir_object_keys(Map, Keys),
member(Key, Keys),
ir_object_current(Map, Key, Value),
P =.. [Key,Value].
file_property(Path, P) :-
P =.. [Key,Value2],
sys_prop_map(Path, Map),
ir_object_current(Map, Key, Value), !,
Value2 = Value.
file_property(_, P) :-
P =.. [Key,_],
throw(error(domain_error(prolog_flag, Key),_)).
% sys_prop_map(+Atom, -Map)
sys_prop_map(Path, Map) :- current_prolog_flag(prop_async, on), !,
os_prop_promise(Path, Map, Prom),
'$YIELD'(Prom).
sys_prop_map(Path, Map) :-
os_prop_sync(Path, Map).
/**
* 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) :-
current_prolog_flag(base_url, Base),
sys_file_combine(Base, Path, Path2).
% absolute_file_name(+Atom, +Atom, +List)
absolute_file_name(Path, Path2, Opts) :-
current_prolog_flag(base_url, Base),
sys_absolute_opts(Opts, Base, Base2),
sys_file_combine(Base2, Path, Path2).
% sys_absolute_opts(+List, +Atom, -Atom)
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, +Integer, -Integer)
sys_absolute_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_absolute_opt(relative_to(R), _, R) :- !.
sys_absolute_opt(O, _, _) :-
throw(error(type_error(absolute_option,O),_)).
% 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).
/****************************************************************/
/* Error Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile strings/3.
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('representation_error.int', de, 'Unerlaubte Ganzzahl (nicht zwischen - 2^31 und 2^31-1).').
strings('representation_error.max_arity', de, 'Unerlaubte Stelligkeit (nicht kleiner oder gleich 2^31-1).').
strings('domain_error.prolog_flag', de, 'Argument sollte Flag sein, gefunden $.').
strings('domain_error.flag_value', de, 'Argument sollte Flagwert sein, gefunden $.').
strings('domain_error.not_less_than_zero', de, 'Argument sollte positiv oder 0 sein, gefunden $.').
strings('domain_error.operator_priority', de, 'Argument sollte Operatorlevel sein (kleiner oder gleich 1200), gefunden $.').
strings('domain_error.operator_specifier', de, 'Argument sollte Operatormode sein (fx, fy, xfx, yfx, xfy, xf, yf), gefunden $.').
strings('domain_error.time_format', de, 'Argument sollte Zeitformat sein, gefunden $.').
strings('type_error.atom', de, 'Argument sollte Atom sein, gefunden $.').
strings('type_error.number', de, 'Argument sollte Zahl sein, gefunden $.').
strings('type_error.integer', de, 'Argument sollte Ganzzahl sein, gefunden $.').
strings('type_error.float', de, 'Argument sollte Gleitzahl sein, gefunden $.').
strings('type_error.callable', de, 'Argument sollte aufrufbar sein (Atom oder Verbund), gefunden $.').
strings('type_error.atomic', de, 'Argument sollte atomar sein, gefunden $.').
strings('type_error.list', de, 'Argument sollte Liste sein ([] oder [_|_]), gefunden $.').
strings('type_error.evaluable', de, 'Argument sollte berechenbaren Funktor haben, gefunden $.').
strings('type_error.character', de, 'Argument sollte Zeichen sein, gefunden $.').
strings('type_error.pair', de, 'Argument sollte Paar sein (_-_), gefunden $.').
strings('type_error.predicate_indicator', de, 'Argument sollte Prädikatspezifikation sein ( _/_), gefunden $.').
strings('permission_error.modify.flag', de, 'Kann schreibgeschütztes Flag $ 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('representation_error.int', '', 'Illegal integer (not between - 2^31 and 2^31-1).').
strings('representation_error.max_arity', '', 'Illegal arity (not less or equal 2^31-1).').
strings('domain_error.prolog_flag', '', 'Argument should be a flag, found $.').
strings('domain_error.flag_value', '', 'Argument should be a flag value, found $.').
strings('domain_error.not_less_than_zero', '', 'Argument should be positive or 0, found $.').
strings('domain_error.operator_priority', '', 'Argument should be an operator level (less or equal 1200), found $.').
strings('domain_error.operator_specifier', '', 'Argument should be an operator mode (fx, fy, xfx, yfx, xfy, xf, yf), found $.').
strings('domain_error.time_format', '', 'Argument should be time format, found $.').
strings('type_error.atom', '', 'Argument should be an atom, found $.').
strings('type_error.number', '', 'Argument should be a number, found $.').
strings('type_error.integer', '', 'Argument should be an integer, found $.').
strings('type_error.float', '', 'Argument should be a float, found $.').
strings('type_error.callable', '', 'Argument should be callable (atom or compound), found $.').
strings('type_error.atomic', '', 'Argument should be an atomic, found $.').
strings('type_error.list', '', 'Argument should be a list ([] or [_|_]), found $.').
strings('type_error.evaluable', '', 'Argument should have evaluable functor, found $.').
strings('type_error.character', '', 'Argument should be a character, found $.').
strings('type_error.pair', '', 'Argument should be a pair (_-_), found $.').
strings('type_error.predicate_indicator', '', 'Argument should be a predicate specification (_/_), found $.').
strings('permission_error.modify.flag', '', 'Can\'t modify read-only flag $.').