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.
*/
/***************************************************************/
/* Include Command */
/***************************************************************/
/**
* include(P): [ISO 7.4.2.7]
* The predicate succeeds. As a side effect, the path P is included.
*/
include(Path) :-
sys_file_relative(Path, AbsPath),
file_property(AbsPath, real_path(RealPath)),
sys_include_file(RealPath).
% sys_include_file(+Atom)
sys_include_file(user) :- !,
current_input(Stream),
sys_include_stream(user, Stream).
sys_include_file(Path) :-
current_prolog_flag(foreign_ext, Ext),
sub_atom(Path, _, _, 0, Ext), !,
sys_include_native(Path, Map),
ir_object_current(Map, 'module', Module),
os_invoke_main(Module).
sys_include_file(Path) :-
setup_once_cleanup(
open(Path, read, Stream),
sys_include_stream(Path, Stream),
close(Stream)).
% sys_include_native(+Atom, -Map)
sys_include_native(Path, Map) :-
current_prolog_flag(import_async, on), !,
os_import_promise(Path, Map, Prom),
'$YIELD'(Prom).
sys_include_native(Path, Map) :-
os_import_sync(Path, Map).
/***************************************************************/
/* Ensure Commands */
/***************************************************************/
/**
* [P1, .., Pn]:
* The predicate succeeds. As a side effect, the paths P1, .., Pn
* are ensure loaded.
*/
% [+Path|+Paths]
[H|T] :-
member(Path, [H|T]),
ensure_loaded(Path),
fail.
[_|_].
/**
* ensure_loaded(P): [ISO 7.4.2.8]
* The predicate succeeds. As a side effect, the path P is ensure loaded.
*/
% ensure_loaded(+Atom)
ensure_loaded(V) :- var(V),
throw(error(instantiation_error,_)).
ensure_loaded(user) :- !,
sys_include_file(user).
ensure_loaded(Path) :-
sys_file_relative(Path, AbsPath),
dg_get_partition(Parent),
(sys_srcprop(Parent, sys_link(AbsPath)) -> true;
assertz(sys_srcprop(Parent, sys_link(AbsPath)))),
sys_ensure_file(AbsPath).
% sys_ensure_file(+Atom)
sys_ensure_file(AbsPath) :-
sys_prop_map(AbsPath, Map),
ir_object_current(Map, real_path, RealPath),
ir_object_current(Map, last_modified, LastModified),
sys_check_file(RealPath, LastModified).
/***************************************************************/
/* Make Command */
/***************************************************************/
/**
* make:
* The predicate ensures that all used sources are loaded.
*/
% make
make :-
sys_make_unmark,
sys_replay_file(user),
sys_make_reclaim.
% sys_make_unmark
sys_make_unmark :-
retract(sys_source(RealPath, LastModified, 1)),
assertz(sys_source(RealPath, LastModified, 0)),
fail.
sys_make_unmark.
% sys_make_reclaim :-
sys_make_reclaim :-
retract(sys_source(RealPath, _, 0)),
sys_clear_file(RealPath),
fail.
sys_make_reclaim.
/***************************************************************/
/* Lastmodified Check */
/***************************************************************/
% sys_check_file(+Atom, +Integer)
sys_check_file(RealPath, LastModified) :-
shield(sys_check_file2(RealPath, LastModified, LastModified2, Visited)), !,
sys_check_file3(RealPath, LastModified, LastModified2, Visited).
sys_check_file(RealPath, _) :-
sys_load_file(RealPath).
% sys_check_file2(+Atom, +Integer, -Integer, -Integer)
sys_check_file2(RealPath, _, LastModified2, Visited) :-
sys_source(RealPath, LastModified2, Visited), !.
sys_check_file2(RealPath, LastModified, _, _) :-
assertz(sys_source(RealPath, LastModified, 1)), fail.
% sys_check_file3(+Atom, +Integer, +Integer, +Integer)
sys_check_file3(_, _, _, 1) :- !.
sys_check_file3(RealPath, LastModified, LastModified, _) :- !,
shield((retractall(sys_source(RealPath, _, _)),
assertz(sys_source(RealPath, LastModified, 1)))),
sys_replay_file(RealPath).
sys_check_file3(RealPath, LastModified, _, _) :-
shield((retractall(sys_source(RealPath, _, _)),
assertz(sys_source(RealPath, LastModified, 1)))),
sys_clear_file(RealPath),
sys_load_file(RealPath).
/***************************************************************/
/* Loading Parenthesis */
/***************************************************************/
% sys_load_file(+Atom)
sys_load_file(RealPath) :-
setup_once_cleanup(
sys_loading_begin(RealPath, Parent),
sys_include_file(RealPath),
sys_loading_end(Parent)).
% sys_loading_begin(+Atom, -Atom)
sys_loading_begin(S, T) :-
dg_get_partition(T),
dg_set_partition(S).
% sys_loading_end(+Atom)
sys_loading_end(T) :-
dg_get_partition(S),
dg_set_partition(T),
os_task_current(Task),
retractall(sys_lastpred(Task, _, _)),
retractall(sys_predprop(_, _, sys_discontiguous(S))).
/***************************************************************/
/* Reconsult Utilities */
/***************************************************************/
% sys_clear_file(+Atom)
sys_clear_file(RealPath) :-
retractall(sys_op(_, _, _, _, RealPath)),
retractall(sys_srcprop(RealPath, _)),
sys_predprop(F, N, sys_usage(RealPath)),
(sys_predprop(F, N, sys_usage(Other)),
RealPath \== Other ->
sys_clear_file3(F, N, RealPath);
sys_clear_file2(F, N)),
fail.
sys_clear_file(_).
% sys_clear_file2(+Atom, +Integer)
sys_clear_file2(F, N) :-
retractall(sys_predprop(F, N, _)),
kb_pred_destroy(F, N).
% sys_clear_file3(+Atom, +Integer, +Atom)
sys_clear_file3(F, N, S) :-
retractall(sys_predprop(F, N, sys_usage(S))),
retractall(sys_predprop(F, N, sys_multifile(S))),
functor(H, F, N),
kb_clause_ref(H, 4, C),
kb_clause_shard(C, S),
kb_clause_remove(F, N, 1, C),
fail.
sys_clear_file3(_, _, _).
% sys_replay_file(+Atom)
sys_replay_file(Parent) :-
sys_srcprop(Parent, sys_link(AbsPath)),
sys_replay_file2(AbsPath),
fail.
sys_replay_file(_).
% sys_replay_file2(+Atom)
sys_replay_file2(AbsPath) :-
sys_trap(sys_ensure_file(AbsPath), Error,
(sys_chain_head(Error, error(system_error(_),_)), sys_raise(Error);
sys_print_error(Error))).
/*************************************************************/
/* Consult Loop */
/*************************************************************/
% sys_including(-Atom, +Task, -Stream)
:- dynamic sys_including/3.
% sys_include_stream(+Atom, +Stream)
sys_include_stream(Path, Stream) :-
os_task_current(Task),
setup_once_cleanup(
asserta(sys_including(Path, Task, Stream)),
sys_include_lines(Stream),
once(retract(sys_including(Path, Task, Stream)))).
% sys_include_lines(+Stream)
sys_include_lines(Stream) :-
repeat,
sys_trap(sys_next_term(Stream), Error,
(sys_chain_head(Error, error(system_error(_),_)), sys_raise(Error);
sys_print_error(Error), fail)), !.
% sys_next_term(+Stream)
sys_next_term(Stream) :-
read_term(Stream, Clause, [variable_names(Map), singletons(Map2)]),
(Clause == end_of_file -> true;
sys_expand_include(Clause, Map, Map2, Clause2),
sys_style_static(Clause2),
sys_handle_static(Clause2),
fail).
% sys_handle_static(+Clause)
sys_handle_static(Clause) :-
sys_trans_horn(Clause, Help),
sys_assertz_static(Help).
% sys_assertz_static(+Clause)
sys_assertz_static(V) :- var(V),
throw(error(instantiation_error,_)).
sys_assertz_static(Help) :- Help = tr_clause(_,Head,_), !,
functor(Head, F, N),
sys_pred_type(F, N, O),
sys_encode_horn(Help, Encode, O),
sys_host_make(Encode, Native),
ir_clause_add(F, N, Native, 1).
sys_assertz_static(Help) :- Help = tr_goal(_), !,
sys_encode_horn(Help, Encode, 1),
sys_host_make(Encode, Native),
ir_goal_run(Native).
sys_assertz_static(T) :-
throw(error(type_error(tr_clause_or_goal, T),_)).
% sys_pred_type(+Atom, +Integer, -Integer)
sys_pred_type(F, N, 0) :-
kb_pred_link(F, N, Q),
kb_link_flags(Q, O),
O /\ 1 =\= 0, !.
sys_pred_type(_, _, 1).
/*************************************************************/
/* Relative Utility */
/*************************************************************/
% sys_file_relative(+Term, -Atom)
sys_file_relative(V, _) :- var(V),
throw(error(instantiation_error, _)).
sys_file_relative(library(Path), Path2) :- !,
sys_file_liblet(Path, '.p', Path2).
sys_file_relative(foreign(Path), Path2) :- !,
current_prolog_flag(foreign_ext, Ext),
sys_file_liblet(Path, Ext, Path2).
sys_file_relative(Path, Path2) :-
sys_file_including(Base), !,
sys_file_combine(Base, Path, Path2).
sys_file_relative(Path, Path2) :-
absolute_file_name(Path, Path2).
% sys_file_liblet(+Path, +Atom, -Atom)
sys_file_liblet(Path, Ext, Path2) :-
sys_file_struct(Path, Path4),
atom_split(Path3, '', ['liblet/', Path4, Ext]),
current_prolog_flag(system_url, Base),
sys_file_combine(Base, Path3, Path2).
% sys_file_including(-Atom)
sys_file_including(Base) :-
os_task_current(Task),
sys_including(Base, Task, _), !, Base \== user.
% sys_file_struct(+Term, -Atom)
sys_file_struct(V, _) :- var(V),
throw(error(instantiation_error, _)).
sys_file_struct(Path/Path2, Path3) :- !,
sys_file_struct(Path, Path4),
atom_split(Path3, '', [Path4, '/', Path2]).
sys_file_struct(Path, Path2) :- atom(Path), !,
Path = Path2.
sys_file_struct(Path, _) :-
throw(error(type_error(atom, Path),_)).
/*************************************************************/
/* Unattended Queries */
/*************************************************************/
% sys_expand_include(+Clause, +Map, +Map, -Clause)
sys_expand_include(V, _, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_expand_include(?-(Query), Map, _, Clause2) :- !,
Clause2 = (:- sys_query_unattended(Query, Map)).
sys_expand_include(Clause, _, Map, Clause2) :-
sys_singleton_check(Map),
expand_term(Clause, Clause2).
/**
* expand_term(C, D):
* The predicate succeeds in D with the expansion of the term C.
*/
% expand_term(+Clause, -Clause)
expand_term(Clause, Clause2) :- term_conversion(Clause, Clause2), !.
expand_term(Clause, Clause).
% sys_query_unattended(+Goal, +Map)
sys_query_unattended(Query, Map) :-
'$MARK'(X), Query, '$MARK'(Y),
sys_answer_show(Map),
(X == Y -> !, sys_listing_period;
put_atom(';'), nl, fail).
sys_query_unattended(_, _) :-
put_atom('fail'), sys_listing_period.
% sys_singleton_check(+Map)
sys_singleton_check([Pair|Map]) :-
sys_assoc_keys([Pair|Map], Keys),
Error = warning(syntax_error(singleton_var,Keys), _),
sys_fill_stack(Error),
sys_print_error(Error).
sys_singleton_check([]).
% sys_assoc_keys(+Map, -List)
sys_assoc_keys([N=_|L], [N|R]) :-
sys_assoc_keys(L, R).
sys_assoc_keys([], []).
/****************************************************************/
/* Error Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile strings/3.
strings('syntax_error.discontiguous_pred', de, 'Unterbrochenes Prädikat ~, entsprechend deklarieren.').
strings('syntax_error.discontiguous_pred', '', 'Discontiguous predicate ~, declare accordingly.').