Heimseite
Seitenübersicht
An/abmeldung
Anschlagbrett
Herunterladen(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.
*/
/*************************************************************/
/* Canonical Utility */
/*************************************************************/
/**
* canonical_add(A, B):
* The predicate succeeds. As side effect it canonifies the Prolog
* text A into the file B. An already existing file B is silently
* extended.
*/
% canonical_add(+Atom, +Atom)
canonical_add(InName, OutName) :-
setup_once_cleanup(
open(OutName, append, OutStream),
cross_canonical_dest(InName, OutStream),
close(OutStream)).
% cross_canonical_dest(+Atom, +Stream)
cross_canonical_dest(InName, OutStream) :-
setup_once_cleanup(
open(InName, read, InStream),
cross_canonical_stream(InStream, OutStream),
close(InStream)).
% cross_canonical_stream(+Stream, +Stream)
cross_canonical_stream(InStream, OutStream) :-
repeat,
read_term(InStream, Term, [variable_names(Names), annotation(true)]),
(Term == end_of_file -> !;
term_singletons(Term, List),
cross_canonical_names(List, Annon),
append(Names, Annon, Names2),
write_term(OutStream, Term, [quoted(true), ignore_ops(true),
variable_names(Names2), annotation(true)]),
put_code(OutStream, 0'.),
nl(OutStream),
fail).
% cross_canonical_names(+List, -Map)
cross_canonical_names([], []).
cross_canonical_names([V|L], ['_'=V|N]) :-
cross_canonical_names(L, N).
/****************************************************************/
/* 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), 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), !,
put_atom(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) :- !,
put_atom(Stream, 'Error: '),
cross_print_message(Message, Stream), nl(Stream),
cross_print_trace(Trace, Stream).
cross_print_error(warning(Message, Trace), Stream) :- !,
put_atom(Stream, 'Warning: '),
cross_print_message(Message, Stream), nl(Stream),
cross_print_trace(Trace, Stream).
cross_print_error(Error, Stream) :-
put_atom(Stream, 'Unknown exception: '),
writeq(Stream, Error),
nl(Stream).
% cross_print_trace(+List, +Stream)
cross_print_trace(Trace, Stream) :- var(Trace), !,
put_atom(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) :-
put_atom(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),
stream_property(Include, line_no(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).
/****************************************************************/
/* Skipped Directives */
/****************************************************************/
% skipped_directive(+Term)
skipped_directive(V) :- var(V), !, fail.
skipped_directive((:- V)) :- var(V), !, fail.
skipped_directive((:- ensure_loaded(_))).
% skipped_warning
skipped_warning :-
Error = warning(syntax_error(not_supported), _),
cross_fill_stack(Error),
cross_print_error(Error).