Prolog "code"

Admin User, erstellt 27. Apr. 2024
         
/**
* Modern Albufeira Prolog Interpreter
*
* 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.
*/
/***************************************************************/
/* Newline */
/***************************************************************/
/**
* 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_code(Stream, 0'\n),
flush_output(Stream).
% nl(+Stream)
nl(Stream) :-
put_code(Stream, 0'\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),
put_code(Stream, Code).
% put_code(+Stream, +Code)
% defined as special
/**
* 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) :-
os_stream_flags(S, F), F /\ 2 =\= 0, !,
os_read_promise(S, P), '$YIELD'(P).
sys_read_buffer(S) :-
os_read_sync(S).
/***********************************************************************/
/* Atom I/O */
/***********************************************************************/
/**
* get_atom(C, A):
* get_atom(S, C, A):
* The built-in succeeds in A with the atom from the input
* stream up to the character C. The ternary predicate allows
* specifying an input stream S.
*/
% get_atom(+Integer, -Atom)
get_atom(C, A) :-
current_input(S),
get_atom(S, C, A).
% get_atom(+Stream, +Integer, -Atom)
get_atom(S, D, A) :-
get_compress(S, H),
sys_get_atom(H, D, S, L),
atom_codes(A, L).
% sys_get_atom(+Integer, +Integer, +Stream, -List)
sys_get_atom(-1, _, _, L) :- !,
[] = L.
sys_get_atom(H, H, _, L) :- !,
[H] = L.
sys_get_atom(H, D, S, [H|L]) :-
get_compress(S, J),
sys_get_atom(J, D, S, L).
/**
* get_compress(S, C):
* Like get_code/2 but compresses line terminators '\n',
* '\r' and '\r\n' into a single '\n'.
*/
% get_compress(+Stream, -Integer)
get_compress(S, C) :-
os_stream_flags(S, F),
get_code(S, H),
sys_get_compress(H, F, S, C).
% sys_get_compress(+Integer, +Integer, +Stream, -Integer)
sys_get_compress(13, _, _, C) :- !,
10 = C.
sys_get_compress(10, F, S, C) :- F /\ 1 =\= 0, !,
get_compress(S, C).
sys_get_compress(H, _, _, H).
/**
* 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
/***************************************************************/
/* 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, []).
% write(+Stream, +Term)
write(Stream, Term) :-
sys_write_term(Stream, Term, []).
/**
* 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),
member(Key, [last_modified, real_path, type]),
ir_object_current(Map, Key, Value),
P =.. [Key,Value].
file_property(Path, P) :-
P =.. [Key,Value],
sys_prop_map(Path, Map),
ir_object_current(Map, Key, Value).
% 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).
/****************************************************************/
/* 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 Int-Ganzzahl (nicht zwischen - 2^31 und 2^31-1).').
strings('domain_error.prolog_flag', de, 'Argument sollte ein Flag sein, gefunden ~.').
strings('domain_error.flag_value', de, 'Argument sollte ein 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 ein Operatorlevel sein (kleiner oder gleich 1200), gefunden ~.').
strings('domain_error.operator_specifier', de, 'Argument sollte ein Operatormode sein (fx, fy, xfx, yfx, xfy, xf, yf), 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.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('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 int integer (not between - 2^31 and 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('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.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 ~.').