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

         
/****************************************************************/
         
/* Including State                                              */
         
/****************************************************************/
         

         
% cross_including(-Atom, -Stream)
         
:- multifile cross_including/2.
         
:- dynamic cross_including/2.
         

         
% cross_clear
         
cross_clear:-
         
   retractall(cross_predprop(_,_,_)),
         
   retractall(cross_currpred(_,_,_)).
         

         
/****************************************************************/
         
/* Predicate Tracking                                           */
         
/****************************************************************/
         

         
% 1 = static
         
% 0 = dynamic
         

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

         
% cross_pred_type(+Atom, +Integer, -Integer)
         
cross_pred_type(F, N, O) :-
         
   cross_currpred(F, N, O), !.
         
cross_pred_type(_, _, 1).
         

         
% cross_touch_pred(+Atom, +Integer, +Integer)
         
cross_touch_pred(F, N, 1) :-
         
   cross_currpred(F, N, _), !.
         
cross_touch_pred(F, N, 0) :-
         
   cross_currpred(F, N, O), !,
         
   cross_touch_ok(F, N, O).
         
cross_touch_pred(F, N, O) :-
         
   assertz(cross_currpred(F, N, O)).
         

         
% cross_touch_ok(+Atom, +Integer, +Integer)
         
cross_touch_ok(_, _, 0) :- !.
         
cross_touch_ok(F, N, 1) :-
         
   Error = error(permission_error(modify,static_procedure,F/N), _),
         
   cross_fill_stack(Error),
         
   cross_print_error(Error).
         

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

         
% cross_loading(-Atom)
         
:- dynamic cross_loading/1.
         

         
% cross_lastpred(-Atom, -Integer)
         
:- dynamic cross_lastpred/2.
         

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

         
% cross_style_static(+Clause, +Integer, -List, +List)
         
cross_style_static(V, _) --> {var(V)}, !.
         
cross_style_static((:- _), _) --> !.
         
cross_style_static((H :- _), Flags) --> !,
         
   cross_style_head(H, Flags).
         
cross_style_static(H, Flags) -->
         
   cross_style_head(H, Flags).
         

         
% cross_style_head(+Term, +Integer, -List, +List)
         
cross_style_head(H, Flags) --> {callable(H)}, !,
         
   {functor(H, F, N)},
         
   cross_style_indicator(F, N, Flags).
         
cross_style_head(_, _) --> [].
         

         
/****************************************************************/
         
/* Variable Checks                                              */
         
/****************************************************************/
         

         
% cross_multiton_keys(+Map, +Map, -List)
         
cross_multiton_keys([N=_|L], M, R) :- \+ cross_marked_at(N, 0, [23]), !,
         
   cross_multiton_keys(L, M, R).
         
cross_multiton_keys([N=_|L], M, R) :- \+ cross_marked_at(N, 1, [1,3,23]), !,
         
   cross_multiton_keys(L, M, R).
         
cross_multiton_keys([N=_|L], M, R) :- member(N=_, M), !,
         
   cross_multiton_keys(L, M, R).
         
cross_multiton_keys([N=_|L], M, [N|R]) :-
         
   cross_multiton_keys(L, M, R).
         
cross_multiton_keys([], _, []).
         

         
% cross_multiton_check(+List)
         
cross_multiton_check([Key|Keys]) :-
         
   Error = warning(syntax_error(multiton_var,[Key|Keys]), _),
         
   cross_fill_stack(Error),
         
   cross_print_error(Error).
         
cross_multiton_check([]).
         

         
% cross_singleton_keys(+Map, -List)
         
cross_singleton_keys([N=_|L], R) :- cross_marked_at(N, 0, [23]), !,
         
   cross_singleton_keys(L, R).
         
cross_singleton_keys([N=_|L], [N|R]) :-
         
   cross_singleton_keys(L, R).
         
cross_singleton_keys([], []).
         

         
% cross_singleton_check(+List)
         
cross_singleton_check([Key|Keys]) :-
         
   Error = warning(syntax_error(singleton_var,[Key|Keys]), _),
         
   cross_fill_stack(Error),
         
   cross_print_error(Error).
         
cross_singleton_check([]).
         

         
% cross_marked_at(+Atom, +Integer, +List)
         
cross_marked_at(N, J, L) :-
         
   sub_atom(N, J, 1, _, H),
         
   char_code(H, C),
         
   code_category(C, T),
         
   member(T, L), !.
         

         
/****************************************************************/
         
/* Directive Simulation                                         */
         
/****************************************************************/
         

         
% cross_replace_term(+Term, +Integer, -List, +List)
         
cross_replace_term(V, _) --> {var(V)}, !, [V].
         
cross_replace_term((:- T), Flags) --> !,
         
   cross_replace_directive(T, Flags).
         
cross_replace_term(T, _) --> [T].
         

         
% cross_replace_directive(+Term, +Integer, -List, +List)
         
cross_replace_directive(V, _) --> {var(V)}, !, [(:- V)].
         
cross_replace_directive(dynamic(I), Flags) --> !,
         
   cross_dynamic(I, Flags), {I = F/N},
         
   [(:- kb_pred_touch(F, N, 1))].
         
cross_replace_directive(discontiguous(I), Flags) --> !,
         
   {cross_discontiguous(I), I = F/N},
         
   ({Flags /\ 2 =:= 0} ->
         
       [(:- dg_get_partition(T), assertz(set_predprop(F, N, sys_discontiguous(T))))];
         
       []).
         
cross_replace_directive(multifile(I), Flags) --> !,
         
   {cross_multifile(I), I = F/N},
         
   ({Flags /\ 2 =:= 0} ->
         
      [(:- sys_multifile_safe(F, N))];
         
      []).
         
cross_replace_directive(T, _) --> [(:- T)].
         

         
% cross_defered(-Term, +Integer)
         
cross_defered(_, Flags) :- Flags /\ 2 =:= 0, !, fail.
         
cross_defered(R, _) :-
         
   cross_predprop(F, N, cross_multifile(_)),
         
   R = (:- sys_multifile_safe(F, N)).
         
cross_defered(R, _) :-
         
   cross_predprop(F, N, cross_usage(_)),
         
   R = (:- sys_usage_predicate(F, N)).
         

         
/****************************************************************/
         
/* Dynamic Simulation                                           */
         
/****************************************************************/
         

         
% cross_dynamic(+Indicator, +Integer, -List, +List)
         
cross_dynamic(V, _) --> {var(V),
         
   cross_throw(error(instantiation_error,_))}.
         
cross_dynamic(F/N, Flags) --> !,
         
   {cross_check_atom(F),
         
   cross_check_integer(N)},
         
   cross_style_indicator(F, N, Flags),
         
   {cross_touch_pred(F, N, 0)}.
         
cross_dynamic(I, _) -->
         
   {cross_throw(error(type_error(predicate_indicator,I),_))}.
         

         
% cross_style_indicator(+Atom, +Integer, +Integer, -List, +List)
         
cross_style_indicator(F, N, _) --> {cross_lastpred(F, N)}, !.
         
cross_style_indicator(F, N, _) -->
         
   {once(cross_loading(S)),
         
   cross_predprop(F, N, cross_usage(S))}, !,
         
   {(cross_predprop(F, N, cross_discontiguous(S)) -> true;
         
      Error = warning(syntax_error(discontiguous_pred,F/N), _),
         
      cross_fill_stack(Error),
         
      cross_print_error(Error)),
         
   cross_update_last(F, N)}.
         
cross_style_indicator(F, N, Flags) -->
         
   cross_usage_predicate(F, N, Flags),
         
   {cross_update_last(F, N)}.
         

         
% cross_usage_predicate(+Atom, +Integer, +Integer, -List, +List)
         
cross_usage_predicate(F, N, Flags) -->
         
   {once(cross_loading(S)),
         
    (\+ cross_predprop(F, N, cross_multifile(S)),
         
     cross_predprop(F, N, cross_usage(D)),
         
     S \== D ->
         
         cross_throw(error(permission_error(redefine, procedure, F/N), _));
         
         true),
         
    assertz(cross_predprop(F, N, cross_usage(S)))},
         
   ({Flags /\ 2 =:= 0} ->
         
       [(:- sys_usage_predicate(F, N))];
         
       []).
         

         
/****************************************************************/
         
/* Discontiguous Simulation                                     */
         
/****************************************************************/
         

         
% cross_discontiguous(+Indicator)
         
cross_discontiguous(V) :- var(V),
         
   cross_throw(error(instantiation_error,_)).
         
cross_discontiguous(F/N) :- !,
         
   cross_check_atom(F),
         
   cross_check_integer(N),
         
   once(cross_loading(S)),
         
   assertz(cross_predprop(F, N, cross_discontiguous(S))).
         
cross_discontiguous(I) :-
         
   cross_throw(error(type_error(predicate_indicator,I),_)).
         

         
/****************************************************************/
         
/* Multifile Simulation                                         */
         
/****************************************************************/
         

         
% cross_multifile(+Indicator)
         
cross_multifile(V) :- var(V),
         
   cross_throw(error(instantiation_error,_)).
         
cross_multifile(F/N) :- !,
         
   cross_check_atom(F),
         
   cross_check_integer(N),
         
   cross_multifile_safe(F, N).
         
cross_multifile(I) :-
         
   cross_throw(error(type_error(predicate_indicator,I),_)).
         

         
% cross_multifile_safe(+Atom, +Integer)
         
cross_multifile_safe(F, N) :-
         
   once(cross_loading(S)),
         
   (cross_predprop(F, N, cross_usage(D)),
         
    S \== D,
         
    \+ cross_predprop(F, N, cross_multifile(D)) ->
         
        cross_throw(error(permission_error(promote, multifile, F/N), _));
         
        true),
         
   assertz(cross_predprop(F, N, cross_multifile(S))).
         

         
/****************************************************************/
         
/* Property Helpers                                             */
         
/****************************************************************/
         

         
% cross_update_last(+Atom, +Integer)
         
cross_update_last(F, N) :-
         
   retractall(cross_lastpred(_, _)),
         
   assertz(cross_lastpred(F, N)).
         

         
% cross_loading_begin(+Atom)
         
cross_loading_begin(S) :-
         
   asserta(cross_loading(S)).
         

         
% cross_loading_end :-
         
cross_loading_end :-
         
   once(retract(cross_loading(S))),
         
   retractall(cross_lastpred(_, _)),
         
   retractall(cross_predprop(_, _, cross_discontiguous(S))).
         

         
/****************************************************************/
         
/* Some Checks                                                  */
         
/****************************************************************/
         

         
% cross_check_atom(+Term)
         
cross_check_atom(V) :- var(V),
         
   cross_throw(error(instantiation_error,_)).
         
cross_check_atom(A) :- atom(A), !.
         
cross_check_atom(A) :-
         
   cross_throw(error(type_error(atom,A),_)).
         

         
% cross_check_integer(+Term)
         
cross_check_integer(V) :- var(V),
         
   cross_throw(error(instantiation_error,_)).
         
cross_check_integer(I) :- integer(I), !.
         
cross_check_integer(I) :-
         
   cross_throw(error(type_error(integer,I),_)).
         

         
/****************************************************************/
         
/* Character Utility                                            */
         
/****************************************************************/
         

         
% cross_is_cntrl(+Code)
         
cross_is_cntrl(C) :- code_category(C, T), member(T, [15,16]).
         

         
% cross_is_invalid(+Code)
         
cross_is_invalid(C) :- code_category(C, T), member(T, [0,18,19]).
         

         
% cross_escape_codes2(+List, -List, +List)
         
cross_escape_codes2([H|T]) --> !, [H], cross_escape_codes2(T).
         
cross_escape_codes2([]) --> [].
         

         
% cross_escape_zeros(+Integer, -List, +List)
         
cross_escape_zeros(0) --> !.
         
cross_escape_zeros(N) --> [0'0], {M is N-1}, cross_escape_zeros(M).
         

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