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.
*/
/***************************************************************/
/* Discontiguous Multifile */
/***************************************************************/
/**
* discontiguous I: [ISO 7.4.2.3]
* The predicate sets the predicate I to discontiguous.
*/
% discontiguous(+Indicator)
discontiguous(V) :- var(V),
throw(error(instantiation_error,_)).
discontiguous(F/N) :- !,
sys_check_atom(F),
sys_check_integer(N),
dg_get_partition(S),
assertz(sys_predprop(F, N, sys_discontiguous(S))).
discontiguous(I) :-
throw(error(type_error(predicate_indicator,I),_)).
/**
* multifile I: [ISO 7.4.2.2]
* The predicate sets the predicate I to multi-file.
* Dummy implementation, property not yet supported.
*/
% multifile(+Indicator)
multifile(V) :- var(V),
throw(error(instantiation_error,_)).
multifile(F/N) :- !,
sys_check_atom(F),
sys_check_integer(N),
sys_multifile_safe(F, N).
multifile(I) :-
throw(error(type_error(predicate_indicator,I),_)).
% sys_multifile_safe(+Atom, +Integer)
sys_multifile_safe(F, N) :-
dg_get_partition(S),
(sys_predprop(F, N, sys_usage(D)),
S \== D,
\+ sys_predprop(F, N, sys_multifile(D)) ->
throw(error(permission_error(promote, multifile, F/N), _));
true),
assertz(sys_predprop(F, N, sys_multifile(S))).
/***************************************************************/
/* Include Command */
/***************************************************************/
/**
* include(P): [ISO 7.4.2.7]
* The predicate succeeds. As a side effect, the path P is included.
*/
% include(+Term)
include(Spec) :-
sys_file_relative(Spec, RelPath),
file_property(RelPath, absolute_path(Path)),
sys_include_file(Path).
% 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(Spec) :-
sys_file_relative(Spec, RelPath),
dg_get_partition(Parent),
(sys_srcprop(Parent, sys_link(RelPath)) -> true;
assertz(sys_srcprop(Parent, sys_link(RelPath)))),
sys_ensure_file(RelPath).
% sys_ensure_file(+Atom)
sys_ensure_file(RelPath) :-
sys_prop_map(RelPath, Map),
ir_object_current(Map, absolute_path, Path),
ir_object_current(Map, last_modified, LastModified),
sys_check_file(Path, 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(Path, LastModified, 1)),
assertz(sys_source(Path, LastModified, 0)),
fail.
sys_make_unmark.
% sys_make_reclaim :-
sys_make_reclaim :-
retract(sys_source(Path, _, 0)),
sys_clear_file(Path),
fail.
sys_make_reclaim.
/***************************************************************/
/* Lastmodified Check */
/***************************************************************/
% sys_check_file(+Atom, +Integer)
sys_check_file(Path, LastModified) :-
shield(sys_check_file2(Path, LastModified, LastModified2, Visited)), !,
sys_check_file3(Path, LastModified, LastModified2, Visited).
sys_check_file(Path, _) :-
sys_load_file(Path).
% sys_check_file2(+Atom, +Integer, -Integer, -Integer)
sys_check_file2(Path, _, LastModified2, Visited) :-
sys_source(Path, LastModified2, Visited), !.
sys_check_file2(Path, LastModified, _, _) :-
assertz(sys_source(Path, LastModified, 1)), fail.
% sys_check_file3(+Atom, +Integer, +Integer, +Integer)
sys_check_file3(_, _, _, 1) :- !.
sys_check_file3(Path, LastModified, LastModified, _) :- !,
shield((retractall(sys_source(Path, _, _)),
assertz(sys_source(Path, LastModified, 1)))),
sys_replay_file(Path).
sys_check_file3(Path, LastModified, _, _) :-
shield((retractall(sys_source(Path, _, _)),
assertz(sys_source(Path, LastModified, 1)))),
sys_clear_file(Path),
sys_load_file(Path).
/***************************************************************/
/* Loading Parenthesis */
/***************************************************************/
% sys_load_file(+Atom)
sys_load_file(Path) :-
setup_once_cleanup(
sys_loading_begin(Path, Parent),
sys_include_file(Path),
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(Path) :-
retractall(sys_op(_, _, _, _, Path)),
retractall(sys_srcprop(Path, _)),
sys_predprop(F, N, sys_usage(Path)),
(sys_predprop(F, N, sys_usage(Other)),
Path \== Other ->
sys_clear_file3(F, N, Path);
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(RelPath)),
catch(sys_ensure_file(RelPath), Error,
(sys_print_error(Error), fail)),
fail.
sys_replay_file(_).
/****************************************************************/
/* Style Check */
/****************************************************************/
% sys_lastpred(+Task, -Atom, -Integer)
:- dynamic sys_lastpred/3.
% sys_update_last(+Atom, +Integer)
sys_update_last(F, N) :-
os_task_current(Task),
retractall(sys_lastpred(Task, _, _)),
assertz(sys_lastpred(Task, F, N)).
% sys_style_static(+Clause)
sys_style_static(V) :- var(V), !.
sys_style_static((:- _)) :- !.
sys_style_static((H :- _)) :- !,
sys_style_head(H).
sys_style_static(H) :-
sys_style_head(H).
% sys_style_head(+Term)
sys_style_head(H) :- callable(H), !,
functor(H, F, N),
sys_style_indicator(F, N).
sys_style_head(_).
% sys_style_indicator(+Atom, +Integer)
sys_style_indicator(F, N) :-
os_task_current(Task),
sys_lastpred(Task, F, N), !.
sys_style_indicator(F, N) :-
dg_get_partition(S),
sys_predprop(F, N, sys_usage(S)), !,
(sys_predprop(F, N, sys_discontiguous(S)) -> true;
Error = warning(syntax_error(discontiguous_pred,F/N), _),
sys_fill_stack(Error),
sys_print_error(Error)),
sys_update_last(F, N).
sys_style_indicator(F, N) :-
sys_usage_predicate(F, N),
sys_update_last(F, N).
% sys_usage_predicate(+Atom, +Integer)
sys_usage_predicate(F, N) :-
dg_get_partition(S),
(\+ sys_predprop(F, N, sys_multifile(S)),
sys_predprop(F, N, sys_usage(D)),
S \== D ->
throw(error(permission_error(redefine, procedure, F/N), _));
true),
assertz(sys_predprop(F, N, sys_usage(S))).
/*************************************************************/
/* Consult Loop */
/*************************************************************/
% 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,
catch(sys_next_term(Stream), 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_trans_horn(Clause2, Help),
sys_handle_static(Help),
fail).
% sys_handle_static(+Clause)
sys_handle_static(V) :- var(V),
throw(error(instantiation_error,_)).
sys_handle_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_handle_static(Help) :- Help = tr_goal(_,_), !,
sys_encode_horn(Help, Encode, 1),
sys_host_make(Encode, Native),
ir_goal_run(Native).
sys_handle_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_compound(Path, 'liblet/', '.p', Path2).
sys_file_relative(foreign(Path), Path2) :- !,
current_prolog_flag(foreign_ext, Ext),
sys_file_compound(Path, 'foreign/', 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_compound(+Path, +Atom, +Atom, -Atom)
sys_file_compound(Path, Dir, Ext, Path2) :-
sys_file_struct(Path, Path4),
atom_join([Dir, Path4, Ext], Path3),
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_join([Path4, '/', Path2], Path3).
sys_file_struct(Path, Path2) :- atom(Path), !,
Path = Path2.
sys_file_struct(Path, _) :-
throw(error(type_error(atom, Path),_)).
/****************************************************************/
/* 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.').