Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 XLOG Technologies AG
/**
* 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.
*/
:- dynamic sys_init_goal/1.
/********************************************************************/
/* abort/0 and exit/0 */
/********************************************************************/
% abort
abort :- throw(error(system_error(user_abort), _)).
% exit
exit :- throw(error(system_error(user_exit), _)).
% sys_call_print(+Goal)
sys_call_print(Goal) :-
sys_trap(Goal, Error, sys_ended_handler(Error)).
% sys_ended_handler(+Error)
sys_ended_handler(Error) :-
sys_chain_head(Error, error(system_error(user_exit),_)),
sys_raise(Error).
sys_ended_handler(Error) :-
sys_print_error(Error),
fail.
/********************************************************************/
/* initialization/1 */
/********************************************************************/
/**
* initialization(G):
* The goal G is scheduled for later execution.
*/
% initialization(+Goal)
initialization(G) :- assertz(sys_init_goal(G)).
% sys_init_goals
sys_init_goals :-
retract(sys_init_goal(G)),
sys_call_print(sys_must(G)),
fail.
sys_init_goals.
% sys_must(+Goal)
sys_must(X) :- X, !.
sys_must(_) :- throw(error(syntax_error(directive_failed),_)).
/********************************************************/
/* Prolog Baseline */
/********************************************************/
/**
* sys_baseline:
* The predicate processes the option arguments.
* Runtime Library incarnation.
*/
% sys_baseline
sys_baseline :-
current_prolog_flag(argv, L),
sys_baseline(L).
% sys_baseline(+List)
sys_baseline(['-h'|T]) :- !,
current_output(S),
sys_print_message(command(runtime), S), nl,
set_prolog_flag(argv, ['-h'|T]).
sys_baseline([H|_]) :-
sub_atom(H, 0, _, _, '-'), !,
throw(error(system_error(option_command), _)).
sys_baseline(L) :-
set_prolog_flag(argv, L).
/*************************************************************/
/* Prolog Launch */
/*************************************************************/
/**
* sys_launch(R):
* The predicate launches the remainder arguments.
*/
% sys_launch
sys_launch :-
current_prolog_flag(argv, L),
sys_launch(L).
% sys_launch(+List)
sys_launch(['-h'|_]) :- !.
sys_launch([]) :-
sys_banner,
sys_toplevel.
sys_launch([H|T]) :-
set_prolog_flag(argv, T),
ensure_loaded(H),
sys_init_goals.
% sys_banner
sys_banner :-
current_prolog_flag(version_data, Version),
Version =.. [_, Major, Minor, Patch, [date(Time)|_]|_],
get_string('format.date', Format),
atom_time(Atom, Format, Time),
current_output(S),
sys_print_message(banner(runtime, Major, Minor, Patch, Atom), S), nl,
sys_print_message(banner(copyright), S), nl.
/*************************************************************/
/* Top-Level */
/*************************************************************/
/**
* sys_toplevel:
* The predicate succeeds. As a side effect, a REPL is run.
*/
% sys_toplevel
sys_toplevel :-
current_input(Stream),
os_task_current(Task),
setup_once_cleanup(
asserta(sys_including(user, Task, Stream)),
sys_toplevel_prompt(Stream),
once(retract(sys_including(user, Task, Stream)))).
% sys_toplevel_prompt(+Stream)
sys_toplevel_prompt(Stream) :-
repeat,
sys_init_goals,
put_atom('?- '),
flush_output,
sys_call_print(read_term(Stream, Goal, [variable_names(Map)])),
(Goal == end_of_file -> true;
sys_call_print(sys_query_attended(Goal, Map)),
fail), !.
/*************************************************************/
/* Toplevel Queries */
/*************************************************************/
% sys_query_attended(+Goal, +Map)
sys_query_attended(Query, Map) :-
'$MARK'(X),
Query,
'$MARK'(Y),
sys_answer_show(Map),
(X == Y -> !, sys_answer_period;
sys_ask_abort -> !; fail).
sys_query_attended(_, _) :-
put_atom('fail'), sys_answer_period.
% sys_ask_abort
sys_ask_abort :-
flush_output,
get_atom(Atom, []),
Atom \== ';\n'.
/****************************************************************/
/* Filter & Show Variables */
/****************************************************************/
% sys_answer_show(+Map)
sys_answer_show(Map) :-
sys_triage_names(Map, Incl, Excl),
append(Excl, Incl, Map2),
reverse(Map2, Map3),
sys_filter_names(Incl, Map3, Incl2),
sys_answer_map(Incl2, Map3).
% sys_triage_names(+Map, -Map, -Map)
sys_triage_names([P|L], Q, [P|R]) :- P=(N=_),
sys_marked_at(N, 0, [23]),
sys_marked_at(N, 1, [1,3,23]), !,
sys_triage_names(L, Q, R).
sys_triage_names([P|L], [P|Q], R) :-
sys_triage_names(L, Q, R).
sys_triage_names([], [], []).
% sys_filter_names(+Map, +Map, -Map)
sys_filter_names([N=V|L], Q, R) :- var(V), sys_find_var(V, Q, M), M = N, !,
sys_filter_names(L, Q, R).
sys_filter_names([P|L], Q, [P|R]) :-
sys_filter_names(L, Q, R).
sys_filter_names([], _, []).
% sys_answer_map(+Map, +Map)
sys_answer_map([P,Q|L], Map) :- !,
sys_answer_eq(P, Map),
put_atom(', '),
sys_answer_map([Q|L], Map).
sys_answer_map([P], Map) :-
sys_answer_eq(P, Map).
sys_answer_map([], _) :-
put_atom('true').
% sys_answer_eq(+Pair, +Map)
sys_answer_eq(N=V, Map) :-
sys_var_quoted(N, 1, M),
put_atom(M),
put_atom(' = '),
sys_answer_term(V, Map).
% sys_answer_term(+Term, +Map)
sys_answer_term(V, Map) :- acyclic_term(V), !,
write_term(V, [priority(699), variable_names(Map),
numbervars(true), quoted(true)]).
sys_answer_term(_, _) :-
get_string('answer.cyclic', V),
put_atom(V).
/****************************************************************/
/* Other Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile strings/3.
strings('answer.cyclic', de, '<zyklischer Ausdruck>').
strings('command.runtime', de, 'Benutzung: opt_1 .. opt_m [text arg_1 .. arg_n]\n\
Falls kein text spezifiziert ist, wird Banner gezeigt und dann\n\
Top-Level ausgeführt, andernfalls wird text ausgeführt.\n\
-h Diesen Hilfetext anzeigen und Vorgang beenden').
strings('system_error.option_command', de, 'Ungültige Befehlzeilenoption, -h für weitere Informationen.').
strings('answer.cyclic', '', '<cyclic term>').
strings('command.runtime', '', 'Usage: opt_1 ... opt_m [text arg_1 ... arg_n]\n\
If no text is specified, banner is shown and then top-level\n\
is executed, otherwise text is executed.\n\
-h Display this help and exit.').
strings('system_error.option_command', '', 'Invalid command line option, -h for more information.').
/****************************************************************/
/* Error Texts */
/****************************************************************/
strings('syntax_error.directive_failed', de, 'Direktive fehlgeschlagen.').
strings('system_error.user_abort', de, 'Ausführung auf Benutzerwunsch abgebrochen.').
strings('system_error.user_exit', de, 'System auf Benutzerwunsch beendet.').
strings('syntax_error.directive_failed', '', 'Directive failed.').
strings('system_error.user_abort', '', 'Execution aborted on user request.').
strings('system_error.user_exit', '', 'System ended on user request.').