Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 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.
*/
:- ensure_loaded(library(util/files)).
/**
* copy_path(A, B):
* The predicate succeeds in copying the Prolog text file A
* into the Prolog text file B. The last modified date is also
* copied from file A to file B. The predicate silently
* overwrites an already existing file B.
*/
% copy_path(+Atom, +Atom)
copy_path(InName, OutName) :-
copy_text(InName, OutName),
copy_time(InName, OutName).
% copy_pathdirs(+Atom, +Atom)
copy_pathdirs(InDir, OutDir) :-
ensure_directory(OutDir),
directory_member(InDir, Name),
sub_atom(Name, _, _, 0, '.p'),
atom_concat(InDir, Name, InName),
atom_concat(OutDir, Name, OutName),
copy_path(InName, OutName),
fail.
copy_pathdirs(InDir, OutDir) :-
directory_member(InDir, Name),
\+ sub_atom(Name, _, _, _, '.'),
atom_concat(Name, '/', Name2),
atom_concat(InDir, Name2, InName),
atom_concat(OutDir, Name2, OutName),
copy_pathdirs(InName, OutName),
fail.
copy_pathdirs(_, _).
/**
* clean_path(A, B):
* The predicate succeeds in removing the Prolog text file B
* if no Prolog text file A exists. Otherwise the Prolog text
* file B is not removed.
*/
% clean_path(+Atom, +Atom)
clean_path(InName, _) :-
file_exists(InName), !.
clean_path(_, OutName) :-
delete_file(OutName).
% clean_pathdirs(+Atom, +Atom, +Atom)
clean_pathdirs(InDir, OutDir, Ext) :-
directory_member(OutDir, Name),
\+ sub_atom(Name, _, _, _, '.'),
atom_concat(Name, '/', Name2),
atom_concat(InDir, Name2, InName),
atom_concat(OutDir, Name2, OutName),
clean_pathdirs(InName, OutName, Ext),
fail.
clean_pathdirs(InDir, OutDir, Ext) :-
directory_member(OutDir, Name),
sub_atom(Name, _, _, 0, Ext),
atom_concat(InDir, Name, InName),
atom_concat(OutDir, Name, OutName),
clean_path(InName, OutName),
fail.
clean_pathdirs(_, _, _).
/***************************************************************/
/* DCG Transform */
/***************************************************************/
/**
* cross_expand_term(C, D):
* The predicate succeeds in D with the expansion of the term C.
*/
% cross_expand_term(+Clause, -Clause)
cross_expand_term(Clause, Clause2) :- cross_term_expansion(Clause, Clause2), !.
cross_expand_term(Clause, Clause).
/**
* cross_term_expansion(C, D):
* This predicate can be used to define custom term conversion rules.
*/
% cross_term_expansion(+Clause, -Clause)
:- multifile cross_term_expansion/2.
cross_term_expansion(X, _) :- var(X), !, fail.
cross_term_expansion((X --> _), _) :- var(X),
cross_throw(error(instantiation_error,_)).
cross_term_expansion((X, Y --> Z), (A :- C, B)) :- !,
cross_phrase_expansion(X, 0, 0, I, O, A),
cross_phrase_expansion(Z, 1, 0, I, H, C),
cross_phrase_expansion(Y, 0, 0, O, H, B).
cross_term_expansion((X --> Y), (A :- B)) :- !,
cross_phrase_expansion(X, 0, 0, I, O, A),
cross_phrase_expansion(Y, 1, 0, I, O, B).
% cross_phrase_expansion(+DCG, +Integer, +Integer, +Term, +Term, -Goal)
cross_phrase_expansion(X, _, _, _, _, _) :- var(X),
cross_throw(error(instantiation_error,_)).
cross_phrase_expansion((X, Y), F, G, I, O, (A, B)) :- !,
cross_phrase_expansion(X, F, 1, I, H, A),
cross_phrase_expansion(Y, 0, G, H, O, B).
cross_phrase_expansion((X; Y), _, _, I, O, (A; B)) :- !,
cross_phrase_expansion(X, 0, 0, I, O, A),
cross_phrase_expansion(Y, 0, 0, I, O, B).
cross_phrase_expansion((X -> Y), F, G, I, O, (A -> B)) :- !,
cross_phrase_expansion(X, F, 1, I, H, A),
cross_phrase_expansion(Y, 0, G, H, O, B).
cross_phrase_expansion([], 0, _, I, O, I = O) :- !.
cross_phrase_expansion([], 1, _, I, O, true) :- !, I = O.
cross_phrase_expansion([X|L], 0, _, I, O, I = [X|R]) :- !,
cross_list_expansion(L, O, R).
cross_phrase_expansion([X|L], 1, _, I, O, true) :- !, I = [X|R],
cross_list_expansion(L, O, R).
cross_phrase_expansion(!, _, 0, I, O, (!, I = O)) :- !.
cross_phrase_expansion(!, _, 1, I, O, !) :- !, I = O.
cross_phrase_expansion({A}, _, 0, I, O, (A, I = O)) :- !.
cross_phrase_expansion({A}, _, 1, I, O, A) :- !, I = O.
cross_phrase_expansion((\+ X), _, 0, I, O, (\+ A, I = O)) :- !,
cross_phrase_expansion(X, 0, 0, I, _, A).
cross_phrase_expansion((\+ X), _, 1, I, O, (\+ A)) :- !, I = O,
cross_phrase_expansion(X, 0, 0, I, _, A).
cross_phrase_expansion(X, _, _, I, O, A) :- callable(X), !,
X =.. [F|L],
append(L, [I, O], R),
A =.. [F|R].
cross_phrase_expansion(X, _, _, _, _, _) :-
cross_throw(error(type_error(callable,X),_)).
% cross_list_expansion(+List, +Term, -List)
cross_list_expansion(X, _, _) :- var(X),
cross_throw(error(instantiation_error,_)).
cross_list_expansion([], Y, Y) :- !.
cross_list_expansion([X|L], Y, [X|R]) :- !,
cross_list_expansion(L, Y, R).
cross_list_expansion(X, _, _) :-
cross_throw(error(type_error(list,X),_)).
/****************************************************************/
/* Fill Stack */
/****************************************************************/
% cross_throw(+Error)
cross_throw(B) :-
cross_fill_stack(B),
sys_raise(B).
% cross_fill_stack(+Term)
cross_fill_stack(Error) :-
var(Error), cross_throw(error(instantiation_error, _)).
cross_fill_stack(error(_,Trace)) :- var(Trace), !,
cross_fetch_stack(Trace).
cross_fill_stack(warning(_,Trace)) :- var(Trace), !,
cross_fetch_stack(Trace).
cross_fill_stack(_).
% cross_fetch_stack(-List)
cross_fetch_stack(Trace) :-
findall(cross_including(F, S), cross_including(F, S), Trace).
/****************************************************************/
/* Error Printing */
/****************************************************************/
% cross_print_error(+Error)
cross_print_error(Error) :-
current_error(Stream),
cross_print_error(Error, Stream).
% cross_print_error(+Error, +Stream)
cross_print_error(Error, Stream) :- var(Error), !,
write(Stream, 'Unknown exception: '),
writeq(Stream, Error),
nl(Stream).
cross_print_error(cause(Primary, Secondary), Stream) :- !,
cross_print_error(Primary, Stream),
cross_print_error(Secondary, Stream).
cross_print_error(error(Message, Trace), Stream) :- !,
write(Stream, 'Error: '),
cross_print_message(Message, Stream), nl(Stream),
cross_print_trace(Trace, Stream).
cross_print_error(warning(Message, Trace), Stream) :- !,
write(Stream, 'Warning: '),
cross_print_message(Message, Stream), nl(Stream),
cross_print_trace(Trace, Stream).
cross_print_error(Error, Stream) :-
write(Stream, 'Unknown exception: '),
writeq(Stream, Error),
nl(Stream).
% cross_print_trace(+List, +Stream)
cross_print_trace(Trace, Stream) :- var(Trace), !,
write(Stream, '\tUnknown context: '),
writeq(Stream, Trace),
nl(Stream).
cross_print_trace([Frame|Trace], Stream) :- !,
cross_print_frame(Frame, Stream),
cross_print_trace(Trace, Stream).
cross_print_trace([], _) :- !.
cross_print_trace(Trace, Stream) :-
write(Stream, '\tUnknown context: '),
writeq(Stream, Trace),
nl(Stream).
% cross_print_frame(+Term, +Stream)
cross_print_frame(cross_including(File, Include), Stream) :- atom(File), !,
cross_file_name(File, Name),
ir_object_current(Include, 'lineno', Line),
write(Stream, '\t'), writeq(Stream, Name),
write(Stream, ' at '), write(Stream, Line), nl(Stream).
cross_print_frame(Frame, Stream) :-
cross_print_message(Frame, Stream), nl(Stream).
% cross_print_message(+Term, +Stream)
cross_print_message(Message, Stream) :-
writeq(Stream, Message).
/***************************************************************/
/* Path Utility */
/***************************************************************/
% cross_file_name(+Atom, -Atom)
cross_file_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).