Prolog "advanced"
Admin User, created Apr 06. 2025
/**
* Advanced GNU Prolog compatibility with Dogelog Player.
*
* 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.
*/
% atom_join(L, A) :-
atom_join(L, A) :-
sys_atom_join(L, '', A).
% sys_atom_join(+List, +Atom, -Atom)
sys_atom_join(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_atom_join([], A, R) :- !, R = A.
sys_atom_join([T|L], S, A) :- !,
atom_concat(S, T, H),
sys_atom_join(L, H, A).
sys_atom_join(T, _, _) :-
throw(error(type_error(list,T),_)).
/***************************************************************/
/* get_atom/2 and get_atom/3 */
/***************************************************************/
% 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(+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, _).
% 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),_)).
% sys_opt_boolean(+Boolean, +Integer, +Integer, -Integer)
sys_opt_boolean(V, _, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_opt_boolean(true, M, F, G) :- !,
G is F \/ M.
sys_opt_boolean(false, M, F, G) :- !,
G is F /\ \ M.
sys_opt_boolean(B, _, _, _) :-
throw(error(type_error(boolean,B),_)).