Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2024 XLOG Technologies AG
/**
* 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.
*/
/***************************************************************/
/* Source Property */
/***************************************************************/
% sys_source(-Atom, -Integer, -Integer)
:- dynamic sys_source/3.
% sys_srcprop(-Atom, -Term)
:- dynamic sys_srcprop/2.
/**
* current_source(S):
* The predicate succeeds in S with the current source paths.
*/
% current_source(-Atom)
current_source(RealPath) :- sys_source(RealPath, _, _).
/**
* source_property(S, P):
* The predicate succeeds in P with the properties of the source path S.
*/
% source_property(+Atom, -Term)
source_property(RealPath, P) :- sys_srcprop(RealPath, P).
/***************************************************************/
/* Prolog Flags */
/***************************************************************/
% sys_emulated(+Atom, -Atom)
:- dynamic sys_emulated/2.
sys_emulated(dialect, dogelog).
sys_emulated(emulator_url, '').
sys_emulated(argv, []).
sys_emulated(sys_locale, 'en_GB').
/**
* set_prolog_flag(K, V): [ISO 8.17.2]
* The built-in succeeds. As a side effect the value of
* the flag K is changed to V.
*/
% set_prolog_flag(+Atom, +Term)
set_prolog_flag(K, V) :-
sys_check_atom(K),
sys_prolog_flag_set(K, V), !.
set_prolog_flag(K, _) :-
throw(error(domain_error(prolog_flag,K),_)).
% sys_prolog_flag_get(+Atom, +Term)
sys_prolog_flag_set(double_quotes, D) :-
sys_check_atom(D),
sys_check_codes(D).
sys_prolog_flag_set(base_url, D) :-
os_set_workdir(D).
sys_prolog_flag_set(stage, D) :-
dg_set_stage(D).
sys_prolog_flag_set(partition, D) :-
dg_set_partition(D).
sys_prolog_flag_set(dialect, D) :-
sys_check_atom(D),
retractall(sys_emulated(dialect, _)),
assertz(sys_emulated(dialect, D)).
sys_prolog_flag_set(emulator_url, D) :-
sys_check_atom(D),
retractall(sys_emulated(emulator_url, _)),
assertz(sys_emulated(emulator_url, D)).
sys_prolog_flag_set(argv, D) :-
retractall(sys_emulated(argv, _)),
assertz(sys_emulated(argv, D)).
sys_prolog_flag_set(sys_locale, L) :-
sys_check_atom(L),
retractall(sys_emulated(sys_locale, _)),
assertz(sys_emulated(sys_locale, L)).
% sys_check_codes(+Atom)
sys_check_codes(codes) :- !.
sys_check_codes(C) :-
throw(error(domain_error(flag_value,C),_)).
/**
* current_prolog_flag(K, V): [ISO 8.17.2]
* The built-in succeeds for the value V of the flag K. See
* documentation for the available flags.
*/
% current_prolog_flag(-Atom, -Term)
current_prolog_flag(K, V) :- var(K), !,
sys_prolog_flag_get(K, V).
current_prolog_flag(K, V) :-
sys_check_atom(K),
sys_prolog_flag_get(K, W), !,
V = W.
current_prolog_flag(K, _) :-
throw(error(domain_error(prolog_flag,K),_)).
% sys_prolog_flag_get(-Atom, -Term)
sys_prolog_flag_get(max_code, 0x10FFFF).
sys_prolog_flag_get(dialect, D) :- sys_emulated(dialect, D).
sys_prolog_flag_get(emulator_url, D) :- sys_emulated(emulator_url, D).
sys_prolog_flag_get(argv, D) :- sys_emulated(argv, D).
sys_prolog_flag_get(sys_locale, L) :- sys_emulated(sys_locale, L).
sys_prolog_flag_get(single_quotes, atom).
sys_prolog_flag_get(double_quotes, codes).
sys_prolog_flag_get(back_quotes, variable).
sys_prolog_flag_get(version, 10200).
sys_prolog_flag_get(version_data, dogelog(1,2,0,[date(1713912157538)])).
sys_prolog_flag_get(iso, false).
sys_prolog_flag_get(max_arity, 2147483647).
sys_prolog_flag_get(stage, D) :- dg_get_stage(D).
sys_prolog_flag_get(partition, D) :- dg_get_partition(D).
sys_prolog_flag_get(async_mode, D) :- dg_gc_flags(F),
sys_prolog_flag_decode(F, 1, D).
sys_prolog_flag_get(allow_yield, D) :- dg_gc_flags(F),
sys_prolog_flag_decode(F, 8, D).
sys_prolog_flag_get(base_url, D) :- os_get_workdir(D).
sys_prolog_flag_get(system_url, D) :- os_get_libpath(D).
sys_prolog_flag_get(foreign_ext, D) :- os_get_natext(D).
sys_prolog_flag_get(host_info, D) :- os_host_info(D).
sys_prolog_flag_get(import_async, D) :- dg_gc_flags(F),
sys_prolog_flag_decode(F, 16, D).
sys_prolog_flag_get(prop_async, D) :- dg_gc_flags(F),
sys_prolog_flag_decode(F, 32, D).
sys_prolog_flag_get(read_async, D) :- dg_gc_flags(F),
sys_prolog_flag_decode(F, 64, D).
% sys_prolog_flag_decode(-Integer, -Integer, -Atom)
sys_prolog_flag_decode(F, M, D) :- F /\ M =\= 0, !, D = on.
sys_prolog_flag_decode(_, _, off).
/*********************************************************************/
/* Statistics */
/*********************************************************************/
/**
* statistics(K, V):
* The predicate succeeds for the value V of the flag K. See
* documentation for the available flags.
*/
% statistics(-Atom, -Term)
statistics(K, V) :- var(K), !,
sys_stat_get(K, V).
statistics(K, V) :-
sys_check_atom(K),
sys_stat_get(K, W), !,
V = W.
statistics(K, _) :-
throw(error(domain_error(prolog_flag,K),_)).
% statistics(-Atom, -Term)
sys_stat_get(gctime, W) :- dg_gc_time(W).
sys_stat_get(calls, W) :- dg_call_count(W).
sys_stat_get(time, W) :- dg_real_time(W).
sys_stat_get(wall, W) :- dg_date_now(W).
/**
* statistics:
* The predicate displays the current statistics key value pairs.
*/
% statistics
statistics :-
statistics(K, V),
current_output(O),
sys_convert_stat(K, V, W),
sys_print_message(statistics(K,W), O), nl,
fail.
statistics.
% sys_convert_stat(+Atom, +Value, -Value)
sys_convert_stat(wall, Time, Atom) :- !,
get_string('format.datetime', Format),
sys_time_atom(Format, Time, Atom).
sys_convert_stat(_, X, X).
/*********************************************************************/
/* Time */
/*********************************************************************/
/**
* time(A):
* The predicate succeeds whenever the goal A succeeds. As a
* side effect, timing of the call or redo is shown.
*/
% time(+Goal)
time(G) :-
Holder = v(_,_,_),
try_call_finally(
sys_time_set(Holder),
G,
sys_time_show(Holder)).
% sys_time_set(+Compound)
sys_time_set(Holder) :-
statistics(time, Time),
statistics(gctime, Gctime),
statistics(calls, Calls),
change_arg(1, Holder, Time),
change_arg(2, Holder, Gctime),
change_arg(3, Holder, Calls).
% sys_time_show(+Compound)
sys_time_show(Holder) :-
arg(1, Holder, Time1),
arg(2, Holder, Gctime1),
arg(3, Holder, Calls1),
statistics(time, Time),
statistics(gctime, Gctime),
statistics(calls, Calls),
Time2 is Time-Time1,
Gctime2 is Gctime-Gctime1,
Calls2 is Calls-Calls1,
(Time2 =\= 0 -> Lips is truncate(Calls2 * 1000 / Time2); Lips = 0),
statistics(wall, Wall),
current_output(S),
member(K-V, [time-Time2,
gctime-Gctime2,
lips-Lips,
wall-Wall]),
sys_convert_stat(K, V, W),
sys_print_message(time(K,W), S),
fail.
sys_time_show(_) :-
nl.
/**
* try_call_finally(S, G, C):
* The predicate succeeds whenever G succeeds. The goal S is
* called for the call and redo port. The goal C is called for
* the exit, fail and error port.
*/
% try_call_finally(+Goal, +Goal, +Goal)
try_call_finally(S, G, C) :-
(S; C, fail),
'$MARK'(X),
sys_trap(G, E, (C, sys_raise(E))),
'$MARK'(Y),
(X == Y -> !, C; (C; S, fail)).
/***************************************************************/
/* Sub Atom */
/***************************************************************/
/**
* sub_atom(X, Y, Z, T, U): [ISO 8.16.3]
* The predicate succeeds whenever the atom U is the sub atom of
* the atom X starting at position Y with length Z and ending T
* characters before.
*/
% sub_atom(+Atom, +-Integer, +-Integer, +-Integer, -+Atom)
sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Len), var(Off2), var(Sub), !,
atom_length(Str, Count),
between(0, Count, Off),
Count2 is Count-Off,
between(0, Count2, Len),
sys_atom_part(Str, Off, Len, Sub),
Off2 is Count2-Len.
sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Off2), var(Sub), !,
atom_length(Str, Count),
sys_atom_part(Str, Off, Len, Sub),
Off2 is Count-Off-Len.
sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Off2), !,
atom_length(Sub, Len),
atom_length(Str, Count),
sys_atom_match(Str, Sub, Off),
Off2 is Count-Off-Len.
sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Len), var(Sub), !,
atom_length(Str, Count),
0 =< Off2, Off2 =< Count,
Count2 is Count-Off2,
between(0, Count2, Off),
Len is Count2-Off,
sys_atom_part(Str, Off, Len, Sub).
sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Sub), !,
atom_length(Str, Count),
Off is Count-Off2-Len,
sys_atom_part(Str, Off, Len, Sub).
sub_atom(Str, Off, Len, Off2, Sub) :- var(Len), var(Off2), var(Sub), !,
atom_length(Str, Count),
0 =< Off, Off =< Count,
Count2 is Count-Off,
between(0, Count2, Len),
sys_atom_part(Str, Off, Len, Sub),
Off2 is Count2-Len.
sub_atom(Str, Off, Len, Off2, Sub) :- var(Off2), var(Sub), !,
atom_length(Str, Count),
Off2 is Count-Off-Len,
sys_atom_part(Str, Off, Len, Sub).
sub_atom(Str, Off, Len, Off2, Sub) :- var(Sub), !,
atom_length(Str, Count),
Len is Count-Off2-Off,
sys_atom_part(Str, Off, Len, Sub).
sub_atom(Str, Off, Len, Off2, Sub) :- var(Off2), !,
atom_length(Sub, Len),
atom_length(Str, Count),
Off2 is Count-Off-Len,
sys_atom_match(Str, Sub, Off).
sub_atom(Str, Off, Len, Off2, Sub) :-
atom_length(Sub, Len),
atom_length(Str, Count),
Off is Count-Off2-Len,
sys_atom_match(Str, Sub, Off).
/**
* last_sub_atom(X, Y, Z, T, U):
* The predicate succeeds whenever the atom U is the sub atom of
* the atom X starting at position Y with length Z and ending T
* characters before.
*/
% last_sub_atom(+Atom, +-Integer, +-Integer, +-Integer, -+Atom)
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Len), var(Off2), var(Sub), !,
atom_length(Str, Count),
between(0, Count, Help), Off is Count-Help,
Count2 is Count-Off,
between(0, Count2, Help2), Len is Count2-Help2,
sys_last_atom_part(Str, Off, Len, Sub),
Off2 is Count2-Len.
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Off2), var(Sub), !,
atom_length(Str, Count),
sys_last_atom_part(Str, Off, Len, Sub),
Off2 is Count-Off-Len.
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Off2), !,
atom_length(Sub, Len),
atom_length(Str, Count),
sys_last_atom_match(Str, Sub, Off),
Off2 is Count-Off-Len.
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Len), var(Sub), !,
atom_length(Str, Count),
0 =< Off2, Off2 =< Count,
Count2 is Count-Off2,
between(0, Count2, Help), Off is Count2-Help,
Len is Count2-Off,
sys_last_atom_part(Str, Off, Len, Sub).
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Off), var(Sub), !,
atom_length(Str, Count),
Off is Count-Off2-Len,
sys_last_atom_part(Str, Off, Len, Sub).
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Len), var(Off2), var(Sub), !,
atom_length(Str, Count),
0 =< Off, Off =< Count,
Count2 is Count-Off,
between(0, Count2, Help2), Len is Count2-Help2,
sys_last_atom_part(Str, Off, Len, Sub),
Off2 is Count2-Len.
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Off2), var(Sub), !,
atom_length(Str, Count),
Off2 is Count-Off-Len,
sys_last_atom_part(Str, Off, Len, Sub).
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Sub), !,
atom_length(Str, Count),
Len is Count-Off2-Off,
sys_last_atom_part(Str, Off, Len, Sub).
last_sub_atom(Str, Off, Len, Off2, Sub) :- var(Off2), !,
atom_length(Sub, Len),
atom_length(Str, Count),
Off2 is Count-Off-Len,
sys_last_atom_match(Str, Sub, Off).
last_sub_atom(Str, Off, Len, Off2, Sub) :-
atom_length(Sub, Len),
atom_length(Str, Count),
Off is Count-Off2-Len,
sys_last_atom_match(Str, Sub, Off).
/***************************************************************/
/* 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.
sys_op(':-', fx, 1200, 12, system).
sys_op(':-', xfx, 1200, 12, system).
sys_op('?-', fx, 1200, 12, system).
sys_op('-->', xfx, 1200, 12, system).
sys_op('dynamic', fx, 1150, 12, system).
sys_op('discontiguous', fx, 1150, 12, system).
sys_op('multifile', fx, 1150, 12, system).
sys_op('initialization', fx, 1150, 12, system).
sys_op(';', xfy, 1100, 10, system).
sys_op('->', xfy, 1050, 8, system).
sys_op(',', xfy, 1000, 6, system).
sys_op('\\+', fy, 900, 0, system).
sys_op('is', xfx, 700, 0, system).
sys_op('=', xfx, 700, 0, system).
sys_op('\\=', xfx, 700, 0, system).
sys_op('=..', xfx, 700, 0, system).
sys_op('<', xfx, 700, 0, system).
sys_op('=<', xfx, 700, 0, system).
sys_op('=\\=', xfx, 700, 0, system).
sys_op('>=', xfx, 700, 0, system).
sys_op('>', xfx, 700, 0, system).
sys_op('=:=', xfx, 700, 0, system).
sys_op('@<', xfx, 700, 0, system).
sys_op('@=<', xfx, 700, 0, system).
sys_op('\\==', xfx, 700, 0, system).
sys_op('@>=', xfx, 700, 0, system).
sys_op('@>', xfx, 700, 0, system).
sys_op('==', xfx, 700, 0, system).
sys_op(':', xfy, 600, 3, system).
sys_op('+', yfx, 500, 3, system).
sys_op('-', yfx, 500, 3, system).
sys_op('/\\', yfx, 500, 3, system).
sys_op('\\/', yfx, 500, 3, system).
sys_op('*', yfx, 400, 3, system).
sys_op('/', yfx, 400, 3, system).
sys_op('//', yfx, 400, 3, system).
sys_op('rem', yfx, 400, 3, system).
sys_op('div', yfx, 400, 3, system).
sys_op('mod', yfx, 400, 3, system).
sys_op('xor', yfx, 400, 3, system).
sys_op('>>', yfx, 400, 3, system).
sys_op('<<', yfx, 400, 3, system).
sys_op('-', fy, 200, 1, system).
sys_op('\\', fy, 200, 1, system).
sys_op('**', xfx, 200, 3, system).
sys_op('^', xfy, 200, 3, system).
/**
* 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) :-
sys_check_integer(L),
sys_check_priority(L),
sys_check_atom(M),
sys_check_atom(O),
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_space(M, L, F),
sys_op_format(M, L, G),
H is F \/ G,
dg_get_partition(S),
assertz(sys_op(O, M, L, H, S)).
% 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).
/***************************************************************/
/* DCG Transform */
/***************************************************************/
/**
* term_conversion(C, D):
* This predicate can be used to define custom term conversion rules.
*/
% term_conversion(+Clause, -Clause)
:- multifile term_conversion/2.
term_conversion(X, _) :- var(X), !, fail.
term_conversion((X --> _), _) :- var(X), !, fail.
term_conversion((X, Y --> Z), (A :- C, B)) :- !,
sys_phrase_expansion(X, I, O, A),
sys_phrase_expansion(Z, I, H, C),
sys_phrase_expansion(Y, O, H, B).
term_conversion((X --> Y), (A :- B)) :- !,
sys_phrase_expansion(X, I, O, A),
sys_phrase_expansion(Y, I, O, B).
% sys_phrase_expansion(+DCG, +Term, +Term, -Goal)
sys_phrase_expansion(X, _, _, _) :- var(X), !, fail.
sys_phrase_expansion((X, Y), I, O, (A, B)) :- !,
sys_phrase_expansion(X, I, H, A),
sys_phrase_expansion(Y, H, O, B).
sys_phrase_expansion((X; Y), I, O, (A; B)) :- !,
sys_phrase_expansion(X, I, O, A),
sys_phrase_expansion(Y, I, O, B).
sys_phrase_expansion((X -> Y), I, O, (A -> B)) :- !,
sys_phrase_expansion(X, I, H, A),
sys_phrase_expansion(Y, H, O, B).
sys_phrase_expansion([], I, O, I=O) :- !.
sys_phrase_expansion([X|L], I, O, I=[X|R]) :- !,
sys_list_expansion(L, O, R).
sys_phrase_expansion(!, I, O, (!, I=O)) :- !.
sys_phrase_expansion({A}, I, O, (A, I=O)) :- !.
sys_phrase_expansion((\+ X), I, O, (\+ A, I=O)) :- !,
sys_phrase_expansion(X, I, _, A).
sys_phrase_expansion(X, I, O, A) :- callable(X),
X =.. [F|L],
append(L, [I, O], R),
A =.. [F|R].
% sys_list_expansion(+List, +Term, -List)
sys_list_expansion(X, _, _) :- var(X), !, fail.
sys_list_expansion([], Y, Y).
sys_list_expansion([X|L], Y, [X|R]) :-
sys_list_expansion(L, Y, R).
/***************************************************************/
/* Path Utilities */
/***************************************************************/
/**
* absolute_file_name(F, G):
* 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.
*/
% absolute_file_name(+Atom, +Atom)
absolute_file_name(Path, Path2) :-
current_prolog_flag(base_url, Base),
sys_file_combine(Base, Path, Path2).
% sys_file_combine(+Atom, +Atom, -Atom)
sys_file_combine(_, Path, Path2) :-
is_absolute_file_name(Path), !,
Path = Path2.
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).
/**
* 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).
/****************************************************************/
/* Other Texts */
/****************************************************************/
:- multifile strings/3.
strings('exception_unknown', de, 'Unbekannte Ausnahme: ').
strings('exception_error', de, 'Fehler: ').
strings('exception_warning', de, 'Warnung: ').
strings('exception_context', de, '\tUnbekannter Kontext: ').
strings('exception_template', de, 'Unbekannte Vorlage: ').
strings('file_line', de, '\t~ auf ~').
strings('format.date', de, '%d.%m.%Y').
strings('format.datetime', de, '%d.%m.%Y %H:%M').
strings('time.time', de, '% Zeit ~ ms').
strings('time.gctime', de, ', GC ~ ms').
strings('time.lips', de, ', Lips ~').
strings('time.wall', de, ', Uhr ~~').
strings('statistics.gctime', de, 'GC Zeit\t\t~ ms').
strings('statistics.calls', de, 'Aufrufe\t\t~').
strings('statistics.time', de, 'Betriebszeit\t~ ms').
strings('statistics.wall', de, 'Uhrzeit\t\t~~').
strings('exception_unknown', '', 'Unknown exception: ').
strings('exception_error', '', 'Error: ').
strings('exception_warning', '', 'Warning: ').
strings('exception_context', '', '\tUnknown context: ').
strings('exception_template', '', 'Unknown template: ').
strings('file_line', '', '\t~ at ~').
strings('format.date', '', '%d/%m/%Y').
strings('format.datetime', '', '%d/%m/%Y %H:%M').
strings('time.time', '', '% Time ~ ms').
strings('time.gctime', '', ', GC ~ ms').
strings('time.lips', '', ', Lips ~').
strings('time.wall', '', ', Wall ~~').
strings('statistics.gctime', '', 'GC time\t\t~ ms').
strings('statistics.calls', '', 'Calls\t\t~').
strings('statistics.time', '', 'Realtime\t~ ms').
strings('statistics.wall', '', 'Walltime\t~~').
/****************************************************************/
/* Error Texts */
/****************************************************************/
strings(instantiation_error, de, 'Argument sollte keine Variable sein.').
strings('syntax_error.directive_failed', de, 'Direktive fehlgeschlagen.').
strings('existence_error.body', de, 'Prädikat ~ fehlt Implementation.').
strings('existence_error.procedure', de, 'Prädikat ~ undefiniert oder unerreichbar.').
strings('permission_error.modify.static_procedure', de, 'Kann Prädikat ~ nicht aktualisieren.').
strings('permission_error.coerce.procedure', de, 'Kann Prädikat ~ nicht zu anderen Delegiertentyp zwingen.').
strings('permission_error.access.private_procedure', de, 'Kann auf Prädikat ~ nicht zugreifen.').
strings('permission_error.redefine.procedure', de, 'Kann Prädikat ~ nicht umdefinieren, nicht als Mehrdateien markiert.').
strings('permission_error.promote.multifile', de, 'Kann Funktion ~ nicht zu Mehrdateien heben.').
strings('permission_error.create.operator', de, 'Kann Operator ~ nicht erstellen.').
strings('resource_error.illegal_method', de, 'Methode nicht zugelassen.').
strings('system_error.timelimit_exceeded', de, 'Ausführung abgebrochen da Zeitfrist abgelaufen.').
strings('system_error.user_abort', de, 'Ausführung auf Benutzerwunsch abgebrochen.').
strings('system_error.stack_overflow', de, 'Ausführung wegen Stapelüberlauf abgebrochen.').
strings(instantiation_error, '', 'Argument should not be a variable.').
strings('syntax_error.directive_failed', '', 'Directive failed.').
strings('existence_error.body', '', 'Predicate ~ implementation missing.').
strings('existence_error.procedure', '', 'Undefined or inaccesible predicate ~.').
strings('permission_error.modify.static_procedure', '', 'Can\'t modify predicate ~.').
strings('permission_error.coerce.procedure', '', 'Can\'t coerce predicate ~ into other delegate type.').
strings('permission_error.access.private_procedure', '', 'Can\'t access predicate ~.').
strings('permission_error.redefine.procedure', '', 'Can\'t redefine predicate ~, not marked multfile.').
strings('permission_error.promote.multifile', '', 'Can\'t promote predicate ~ to multi-file.').
strings('permission_error.create.operator', '', 'Can\'t create the operator ~.').
strings('resource_error.illegal_method', '', 'Method not allowed.').
strings('system_error.timelimit_exceeded', '', 'Execution aborted since time limit exceeded.').
strings('system_error.user_abort', '', 'Execution aborted on user request.').
strings('system_error.stack_overflow', '', 'Execution aborted because of stack overflow.').