/**
 * 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.
 */

/***************************************************************/
/* Source Property                                             */
/***************************************************************/

% sys_source(-Atom, -Integer, -Integer)
:- dynamic(sys_source/3).

% sys_srcprop(-Atom, -Term)
:- dynamic(sys_srcprop/2).

/**
 * current_source(S):
 * The predicate succeeds in S with the current source paths.
 */
% current_source(-Atom)
current_source(RealPath) :- sys_source(RealPath, _, _).

/**
 * source_property(S, P):
 * The predicate succeeds in P with the properties of the source path S.
 */
% source_property(+Atom, -Term)
source_property(RealPath, P) :- sys_srcprop(RealPath, P).

/***************************************************************/
/* Style Checks                                                */
/***************************************************************/

/**
 * discontiguous(I): [ISO 7.4.2.3]
 * The predicate sets the predicate I to discontiguous.
 */
% discontiguous(+Indicator)
discontiguous(F/N) :- !,
   must_be(atom, F),
   must_be(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.
 */
% multifile(+Indicator)
multifile(F/N) :- !,
   must_be(atom, F),
   must_be(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, Path),
   file_property(Path, absolute_path(Path2)),
   sys_include_file(Path2).

% 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.
[_|_] :-
   true.

/**
 * 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, Path),
   dg_get_partition(Parent),
   sys_prop_map(Path, Map),
   ir_object_current(Map, absolute_path, Path2),
   (sys_srcprop(Parent, sys_link(Path2)) -> true;
      assertz(sys_srcprop(Parent, sys_link(Path2)))),
   sys_check_file(Path2, Map).

/***************************************************************/
/* Lastmodified Check                                          */
/***************************************************************/

% sys_check_file(+Atom, +Map)
sys_check_file(Path, Map) :-
   shield(sys_action_file(Path, Map, Action)), !,
   (Action = replay ->
            sys_replay_file(Path);
    Action = clear_load ->
            sys_clear_file(Path),
            sys_load_file(Path);
            true).
sys_check_file(Path, _) :-
   sys_load_file(Path).

% sys_action_file(+Atom, +Map, -Atom)
sys_action_file(Path, Map, Action) :-
   sys_source(Path, LastModified2, Visited), !,
   (Visited = 1 -> Action = none;
    (var(Map) -> sys_prop_map(Path, Map); true),
    ir_object_current(Map, last_modified, LastModified),
    (LastModified = LastModified2 -> Action = replay,
          retractall(sys_source(Path, _, _)),
          assertz(sys_source(Path, LastModified2, 1));
          Action = clear_load,
          retractall(sys_source(Path, _, _)),
          assertz(sys_source(Path, LastModified, 1)))).
sys_action_file(Path, Map, _) :-
   (var(Map) -> sys_prop_map(Path, Map); true),
   ir_object_current(Map, last_modified, LastModified),
   assertz(sys_source(Path, LastModified, 1)), fail.

/***************************************************************/
/* Loading Parenthesis                                         */
/***************************************************************/

% sys_lastpred(+Task, -Atom, -Integer)
:- dynamic(sys_lastpred/3).

% sys_load_file(+Atom)
sys_load_file(Path) :-
   setup_once_cleanup(
      sys_loading_begin(Path, Parent, LastPred),
      sys_include_file(Path),
      sys_loading_end(Parent, LastPred)).

% sys_loading_begin(+Atom, -Atom, -Either)
sys_loading_begin(S, T, just(F, N)) :-
   current_task(Task),
   retract(sys_lastpred(Task, F, N)), !,
   dg_get_partition(T),
   dg_set_partition(S).
sys_loading_begin(S, T, nothing) :-
   dg_get_partition(T),
   dg_set_partition(S).

% sys_loading_end(+Atom, -Either)
sys_loading_end(T, just(F, N)) :-
   dg_get_partition(S),
   retractall(sys_predprop(_, _, sys_discontiguous(S))),
   dg_set_partition(T),
   sys_update_last(F, N).
sys_loading_end(T, nothing) :-
   dg_get_partition(S),
   retractall(sys_predprop(_, _, sys_discontiguous(S))),
   dg_set_partition(T),
   current_task(Task),
   retractall(sys_lastpred(Task, _, _)).

% sys_update_last(+Atom, +Integer)
sys_update_last(F, N) :-
   current_task(Task),
   retractall(sys_lastpred(Task, _, _)),
   assertz(sys_lastpred(Task, F, N)).

/****************************************************************/
/* Style Check                                                  */
/****************************************************************/

% sys_style_static(+Clause)
sys_style_static(T) :- nonvar(T), T = (:- _), !.
sys_style_static(T) :- nonvar(T), T = (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) :-
   current_task(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) :-
   current_task(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, Term, [variable_names(Map), singletons(Map2)]),
   (Term == end_of_file -> true;
    nonvar(Term), Term = (?- Query) ->
       sys_expand_unattended(Query, Map, Query2),
       sys_query_unattended(Query2, Map),
       fail;
    sys_multiton_keys(Map, Map2, Keys),
    sys_multiton_check(Keys),
    sys_singleton_keys(Map2, Keys2),
    sys_singleton_check(Keys2),
    expand_term(Term, Term2),
    sys_handle_clump(Term2),
    fail).

/****************************************************************/
/* Handle Clump                                                 */
/****************************************************************/

% sys_handle_clump(+Term)
sys_handle_clump(T) :- nonvar(T), T = [Term|Rest], !,
   sys_handle_clump(Term),
   sys_handle_clump(Rest).
sys_handle_clump(T) :- nonvar(T), T = [], !.
sys_handle_clump(T) :-
   sys_style_static(T),
   sys_handle_static(T).

% sys_handle_static(+Term)
sys_handle_static(T) :- nonvar(T), T = (:- _), !,
   sys_frost_horn(T, 1, Native),
   (sys_goal_call(Native) -> true;
      throw(error(syntax_error(directive_failed),_))).
sys_handle_static(T) :- nonvar(T), T = (H :- _), !,
   functor(H, F, N),
   sys_load_type(F, N, O),
   sys_frost_horn(T, O, Native),
   sys_clause_add(Native, 2).
sys_handle_static(T) :-
   functor(T, F, N),
   sys_load_type(F, N, O),
   sys_frost_horn(T, O, Native),
   sys_clause_add(Native, 2).

% sys_load_type(+Atom, +Integer, -Integer)
sys_load_type(F, N, 0) :-
   kb_pred_link(F, N, P),
   kb_link_flags(P, D),
   D /\ 1 =\= 0, !.
sys_load_type(_, _, 1).

/****************************************************************/
/* Error Texts                                                  */
/****************************************************************/

% strings(+Atom, +Atom, -Atom)
:- multifile(strings/3).
strings('syntax_error.discontiguous_pred', de, 'Unterbrochenes Prädikat ~q, entsprechend deklarieren.').
strings('syntax_error.bad_module', de, 'Fehlerhaftes Modul.').

strings('permission_error.modify.static_procedure', de, 'Kann Prädikat ~q nicht aktualisieren.').
strings('permission_error.coerce.procedure', de, 'Kann Prädikat ~q nicht zu anderen Delegiertentyp zwingen.').
strings('permission_error.access.private_procedure', de, 'Kann auf Prädikat ~q nicht zugreifen.').
strings('permission_error.redefine.procedure', de, 'Kann Prädikat ~q nicht umdefinieren, nicht als Mehrdateien markiert.').
strings('permission_error.promote.multifile', de, 'Kann Funktion ~q nicht zu Mehrdateien heben.').
strings('permission_error.create.operator', de, 'Kann Operator ~q nicht erstellen.').
strings('permission_error.invoke.method', de, 'Kann Methode ~q nicht aufrufen.').
strings('permission_error.modify.field', de, 'Kann Feld ~q nicht aktualisieren.').
strings('permission_error.access.source_sink', de, 'Kann auf Strom ~q nicht zugreifen.').

strings('resource_error.unknown_host', de, 'Dienst nicht gefunden, Verzeichnisdienst aktivieren.').
strings('resource_error.connect_failed', de, 'Verbindung zu Dienst fehlgeschlagen, Verbindungsfähigkeit sicherstellen.').
strings('resource_error.illegal_method', de, 'Methode nicht zugelassen.').
strings('resource_error.internal_error', de, 'Interner Fehler, Administrator kontaktieren.').
strings('resource_error.service_unavailable', de, 'Dienst nicht verfügbar, später wieder versuchen.').
strings('resource_error.state_error', de, 'Übergang nicht erlaubt.').

strings('existence_error.method', de, 'Methode ~q undefiniert.').
strings('existence_error.procedure', de, 'Prädikat ~q undefiniert.').

strings('syntax_error.discontiguous_pred', '', 'Discontiguous predicate ~q, declare accordingly.').
strings('syntax_error.bad_module', '', 'Faulty module.').

strings('permission_error.modify.static_procedure', '', 'Can\'t modify predicate ~q.').
strings('permission_error.coerce.procedure', '', 'Can\'t coerce predicate ~q into other delegate type.').
strings('permission_error.access.private_procedure', '', 'Can\'t access predicate ~q.').
strings('permission_error.redefine.procedure', '', 'Can\'t redefine predicate ~q, not marked multfile.').
strings('permission_error.promote.multifile', '', 'Can\'t promote predicate ~q to multi-file.').
strings('permission_error.create.operator', '', 'Can\'t create operator ~q.').
strings('permission_error.invoke.method', '', 'Can\'t invoke method ~q.').
strings('permission_error.modify.field', '', 'Can\'t modify field ~q.').
strings('permission_error.access.source_sink', '', 'Can\'t access stream ~q.').

strings('resource_error.unknown_host', '', 'Service lookup failed, enable directory service.').
strings('resource_error.connect_failed', '', 'Service connect failed, assure connectivity.').
strings('resource_error.illegal_method', '', 'Method not allowed.').
strings('resource_error.internal_error', '', 'Internal error, contact administrator.').
strings('resource_error.service_unavailable', '', 'Service unavailable, try again later.').
strings('resource_error.state_error', '', 'Transition not permitted.').

strings('existence_error.method', '', 'Undefined method ~q.').
strings('existence_error.procedure', '', 'Undefined predicate ~q.').