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

         
/*******************************************************************/
         
/* Transpile Begin                                                 */
         
/*******************************************************************/
         

         
/**
         
 * transpile_begin(B):
         
 * transpile_begin(B, O):
         
 * The predicate succeeds in writing an empty JavaScript file B.
         
 */
         
% transpile_begin(+Atom)
         
transpile_begin(OutName) :-
         
   transpile_begin(OutName, []).
         

         
% transpile_begin(+Atom, +List)
         
transpile_begin(OutName, Opts) :-
         
   decode_transpile_opts(Opts, v(0,''), v(Flags,Doge)),
         
   copy_text('player/cross/header.mjs', OutName),
         
   setup_once_cleanup(
         
      open(OutName, append, OutStream),
         
      transpile_init(OutStream, Flags, Doge),
         
      close(OutStream)).
         

         
% transpile_init(+Stream, +Integer, +Atom)
         
transpile_init(OutStream, Flags, Doge) :-
         
    (Flags /\ 2 =\= 0 ->
         
        cross_clear;
         
        true),
         
    (Flags /\ 1 =\= 0 ->
         
        write(OutStream, 'import {add, Clause, Goal, run, pred_link,\n'),
         
        write(OutStream, '        Cache, make_defined, Compound} from "'),
         
        write(OutStream, Doge),
         
        write(OutStream, '";\n'),
         
        write(OutStream, 'export function main() {\n')
         
    ;   write(OutStream, 'import {Clause, add, Compound, Cache,\n'),
         
        write(OutStream, '        make_defined, Place, Skeleton} from "./nova/store.mjs";\n'),
         
        write(OutStream, 'import {Goal, run} from "./nova/machine.mjs";\n'),
         
        write(OutStream, 'import "./nova/special.mjs";\n'),
         
        write(OutStream, 'import "./nova/runtime.mjs";\n'),
         
        write(OutStream, 'import "./nova/eval.mjs";\n')).
         

         
/*******************************************************************/
         
/* Transpile Add                                                   */
         
/*******************************************************************/
         

         
/**
         
 * transpile_add(A, B):
         
 * transpile_add(A, B, O):
         
 * The predicate succeeds in cross compiling the Prolog text file A
         
 * into the JavaScript file B.
         
 */
         
% transpile_add(+Atom, +Atom)
         
transpile_add(InName, OutName) :-
         
   transpile_add(InName, OutName, []).
         

         
% transpile_add(+Atom, +Atom, +List)
         
transpile_add(InName, OutName, Opts) :-
         
   decode_transpile_opts(Opts, v(0,''), v(Flags,_)),
         
   setup_once_cleanup(
         
      open(OutName, append, OutStream),
         
      transpile_loading(InName, OutStream, Flags),
         
      close(OutStream)).
         

         
% transpile_loading(+Atom, +Stream, +Integer)
         
transpile_loading(InName, OutStream, Flags) :-
         
   setup_once_cleanup(
         
      cross_loading_begin(InName),
         
      transpile_file(InName, OutStream, Flags),
         
      cross_loading_end).
         

         
% transpile_file(+Atom, +Stream, +Integer)
         
transpile_file(InName, OutStream, Flags) :-
         
   setup_once_cleanup(
         
      open(InName, read, InStream),
         
      transpile_stream(InName, InStream, OutStream, Flags),
         
      close(InStream)).
         

         
% transpile_stream(+Atom, +Stream, +Stream, +Integer)
         
transpile_stream(InName, InStream, OutStream, Flags) :-
         
   setup_once_cleanup(
         
      asserta(cross_including(InName, InStream)),
         
      transpile_lines(InStream, OutStream, Flags),
         
      once(retract(cross_including(InName, InStream)))).
         

         
% transpile_lines(+Stream, +Stream, +Integer)
         
transpile_lines(InStream, OutStream, Flags) :-
         
   repeat,
         
   read_term(InStream, Term, [singletons(Names)]),
         
   (Term = end_of_file -> !;
         
    skipped_directive(Term) ->
         
      skipped_warning,
         
      fail;
         
      cross_singleton_check(Names),
         
      expand_term(Term, Term2),
         
      cross_style_static(Term2, Flags, List2, List),
         
      cross_replace_term(Term2, Flags, List, []),
         
      member(Term3, List2),
         
      sys_trans_horn(Term3, Help),
         
      transpile_horn(Help, OutStream, Flags),
         
      fail).
         

         
% transpile_horn(+Clause_or_goal, +Stream, +Integer)
         
transpile_horn(V, _, _) :- var(V),
         
   throw(error(instantiation_error,_)).
         
transpile_horn(Help, OutStream, Flags) :- Help = tr_clause(_,Head,_), !,
         
   functor(Head, F, N),
         
   cross_pred_type(F, N, O),
         
   sys_encode_horn(Help, Encode, O),
         
   make_print(Encode, Printable), make_print_atom(F, G),
         
   (Flags /\ 1 =\= 0 ->
         
       write(OutStream, '    ');
         
       true),
         
   write(OutStream, 'add'(G, N, Printable)),
         
   write(OutStream, ';\n'),
         
   cross_touch_pred(F, N, 1).
         
transpile_horn(Help, OutStream, Flags) :- Help = tr_goal(_), !,
         
   sys_encode_horn(Help, Encode, 1),
         
   make_print(Encode, Printable),
         
   (Flags /\ 1 =\= 0 ->
         
       write(OutStream, '    ');
         
       true),
         
   write(OutStream, 'run'(Printable)),
         
   write(OutStream, ';\n').
         
transpile_horn(T, _, _) :-
         
   throw(error(type_error(tr_clause_or_goal, T),_)).
         

         
/*******************************************************************/
         
/* Transpile End                                                   */
         
/*******************************************************************/
         

         
/**
         
 * transpile_end(B):
         
 * transpile_end(B, O):
         
 * The predicate succeeds adding an epilogue to the JavaScript file B.
         
 */
         
% transpile_end(+Atom)
         
transpile_end(OutName) :-
         
   transpile_end(OutName, []).
         

         
% transpile_end(+Atom, +List)
         
transpile_end(OutName, Opts) :-
         
   decode_transpile_opts(Opts, v(0,''), v(Flags,_)),
         
   setup_once_cleanup(
         
      open(OutName, append, OutStream),
         
      transpile_fini(OutStream, Flags),
         
      close(OutStream)).
         

         
% transpile_fini(+Stream, +Integer)
         
transpile_fini(OutStream, Flags) :-
         
   (Flags /\ 2 =\= 0 ->
         
       cross_defered(Term3, Flags),
         
       sys_trans_horn(Term3, Help),
         
       transpile_horn(Help, OutStream, Flags);
         
       true),
         
   fail.
         
transpile_fini(OutStream, Flags) :-
         
   (Flags /\ 1 =\= 0 ->
         
      write(OutStream, '}\n');
         
      true).
         

         
/*******************************************************************/
         
/* Make Printable                                                  */
         
/*******************************************************************/
         

         
% make_print(+IRClauseOrGoal, -JSObject)
         
make_print(T, _) :- var(T),
         
   throw(error(instantiation_error,_)).
         
make_print(ir_clause(A,B,W,C), 'new Clause'(I,X,Y,W,Z)) :- !,
         
   K is W+1,
         
   make_print_list(A, X, v(K,[]), v(J,R)),
         
   make_print_list(B, Y, v(J,R), v(I,_)),
         
   make_print_option(C, Z).
         
make_print(ir_goal(A), 'new Goal'(I,X)) :- !,
         
   make_print_list(A, X, v(0,[]), v(I,_)).
         
make_print(T, _) :-
         
   throw(error(type_error(ir_clause_or_goal, T),_)).
         

         
% make_print_option(+IROption, -JSObject)
         
make_print_option(T, _) :- var(T),
         
   throw(error(instantiation_error,_)).
         
make_print_option(nothing, 'undefined') :- !.
         
make_print_option(just(F), G) :- !,
         
   make_print_const(F, G).
         
make_print_option(T, _) :-
         
   throw(error(type_error(ir_option, T),_)).
         

         
% make_print_list(+IRList, -JSList, -List, +List)
         
make_print_list(V, _) --> {var(V),
         
   throw(error(instantiation_error,_))}.
         
make_print_list([X|L], [Y|R]) --> !,
         
   make_print_instr(X, Y),
         
   make_print_list(L, R).
         
make_print_list([], []) --> !.
         
make_print_list(T, _) -->
         
   {throw(error(type_error(ir_list, T),_))}.
         

         
% make_print_instr(+IRInstr, -JSInstr, -List, +List)
         
make_print_instr(V, _) --> {var(V),
         
   throw(error(instantiation_error,_))}.
         
make_print_instr(first_var(_,G), 'new Place'(-1)) --> {var(G)}, !.
         
make_print_instr(first_var(W,_), 'new Place'(V)) --> !,
         
   (make_print_current_recycle([W|R]) ->
         
       make_print_set_recycle(R);
         
       make_print_current_max(W),
         
       {H is W+1},
         
       make_print_set_max(H)),
         
   {V is (-W)-2}.
         
make_print_instr(var(W,G), 'new Place'(W)) --> !,
         
   ({var(G)} ->
         
      make_print_current_recycle(R),
         
      make_print_set_recycle([W|R]);
         
      []).
         
make_print_instr(functor(F,L), 'new Skeleton'(G, X)) --> !,
         
   {make_print_const(F, G)},
         
   make_print_list(L, X).
         
make_print_instr(const(F), G) --> !,
         
   {make_print_const(F, G)}.
         
make_print_instr(T, _) -->
         
   {throw(error(type_error(ir_instr, T),_))}.
         

         
% make_print_current_max(-Integer, -List, +List)
         
make_print_current_max(I, v(I,R), v(I,R)).
         

         
% make_print_set_max(+Integer, -List, +List)
         
make_print_set_max(I, v(_,R), v(I,R)).
         

         
% make_print_current_recycle(-List, -List, +List)
         
make_print_current_recycle(R, v(I,R), v(I,R)).
         

         
% make_print_set_recycle(+List, -List, +List)
         
make_print_set_recycle(R, v(I,_), v(I,R)).
         

         
% make_print_alternatives(+List, -JSAlternatives)
         
make_print_alternatives(T, _) :- var(T),
         
   throw(error(instantiation_error,_)).
         
make_print_alternatives([X|L], [Y|R]) :- !,
         
   make_print(X, Y),
         
   make_print_alternatives(L, R).
         
make_print_alternatives([], []) :- !.
         
make_print_alternatives(T, _) :-
         
   throw(error(type_error(ir_alter, T),_)).
         

         
/*******************************************************************/
         
/* Constants                                                       */
         
/*******************************************************************/
         

         
% make_print_const(+Const, -JSConst)
         
make_print_const(T, _) :- var(T),
         
   throw(error(instantiation_error,_)).
         
make_print_const(functor(F,L), 'new Compound'(G, R)) :- !,
         
   make_print_const(F, G),
         
   make_print_args(L, R).
         
make_print_const(site(F), 'new Cache'(G)) :- !,
         
   make_print_atom(F, G).
         
make_print_const(link(Q), 'make_defined'(R)) :- !,
         
   make_print_alternatives(Q, R).
         
make_print_const(A, B) :- number(A), !,
         
   make_print_number(A, B).
         
make_print_const(A, B) :- reference(A), !,
         
   make_print_reference(A, B).
         
make_print_const(A, B) :- atom(A), !,
         
   make_print_atom(A, B).
         
make_print_const(T, _) :-
         
   throw(error(type_error(ir_const, T),_)).
         

         
% make_print_args(+List, -JSList)
         
make_print_args([X|L], [Y|R]) :-
         
   make_print_const(X, Y),
         
   make_print_args(L, R).
         
make_print_args([], []).
         

         
/*************************************************************/
         
/* Number Utility                                            */
         
/*************************************************************/
         

         
make_print_number(A, B) :- integer(A), !, cross_escape_integer(A, B).
         
make_print_number(A, B) :- cross_escape_float(A, B).
         

         
% cross_escape_integer(+Integer, -JSInteger)
         
cross_escape_integer(A, A) :- -94906266 =< A, A =< 94906266, !.
         
cross_escape_integer(A, C) :- atom_integer(B, 10, A), atom_concat(B, 'n', C).
         

         
% cross_escape_float(+Float, -JSFloat)
         
cross_escape_float(A, A) :- -94906266.0 > A, !.
         
cross_escape_float(A, A) :- A > 94906266.0, !.
         
cross_escape_float(A, C) :- H is truncate(A), cross_escape_float(A, H, C).
         

         
% cross_escape_float(+Float, +Integer, -JSFloat)
         
cross_escape_float(A, H, A) :- A =\= H, !.
         
cross_escape_float(_, H, C) :- atom_integer(B, 10, H), atom_concat(B, 'n', C).
         

         
/*************************************************************/
         
/* Reference Utility                                         */
         
/*************************************************************/
         

         
% make_print_reference(+Reference, -JSReference)
         
make_print_reference(0rNone, null) :- !.
         
make_print_reference(0rFalse, false) :- !.
         
make_print_reference(0rTrue, true) :- !.
         
make_print_reference(A, _) :-
         
    throw(error(domain_error(printable,A),_)).
         

         
/*************************************************************/
         
/* Atom Utility                                              */
         
/*************************************************************/
         

         
% make_print_atom(+Atom, -Atom)
         
make_print_atom(X, Y) :-
         
   atom_codes(X, L),
         
   cross_escape_codes(L, R, [0'"]),
         
   atom_codes(Y, [0'"|R]).
         

         
% cross_escape_codes(+List, -List, +List)
         
cross_escape_codes([X|L]) -->
         
   cross_escape_code(X),
         
   cross_escape_codes(L).
         
cross_escape_codes([]) --> [].
         

         
% cross_escape_code(+Integer, -List, +List)
         
cross_escape_code(X) --> {cross_is_escape(Y, X)}, !, [0'\\, Y].
         
cross_escape_code(X) --> {cross_is_meta(X)}, !, [0'\\, X].
         
cross_escape_code(X) --> {cross_is_cntrl(X)}, !, cross_escape_code2(X).
         
cross_escape_code(X) --> {cross_is_invalid(X)}, !, cross_escape_code2(X).
         
cross_escape_code(X) --> [X].
         

         
% cross_escape_code(+Integer, -List, +List)
         
cross_escape_code2(X) --> {X =< 0xFF}, !,
         
   {atom_integer(J, 16, X), atom_codes(J, H), length(H, N), M is 2-N},
         
   [0'\\, 0'x], cross_escape_zeros(M), cross_escape_codes2(H).
         
cross_escape_code2(X) --> {X =< 0xFFFF}, !,
         
   {atom_integer(J, 16, X), atom_codes(J, H), length(H, N), M is 4-N},
         
   [0'\\, 0'u], cross_escape_zeros(M), cross_escape_codes2(H).
         
cross_escape_code2(X) --> {cross_high_surrogate(X, Y), cross_low_surrogate(X, Z)},
         
   cross_escape_code2(Y), cross_escape_code2(Z).
         

         
% cross_is_escape(+Code, -Code)
         
cross_is_escape(0'n, 0'\n).
         
cross_is_escape(0't, 0'\t).
         
cross_is_escape(0'b, 0'\b).
         
cross_is_escape(0'f, 0'\f).
         
cross_is_escape(0'r, 0'\r).
         
cross_is_escape(0'v, 0'\v).
         

         
% cross_is_meta(+Code)
         
cross_is_meta(0'\').
         
cross_is_meta(0'\").
         
cross_is_meta(0'\\).
         
cross_is_meta(0'/).
         

         
% cross_high_surrogate(+Integer, -Integer)
         
cross_high_surrogate(X, Y) :- Y is (X >> 10) + 0xD7C0.
         

         
% cross_low_surrogate(+Integer, -Integer)
         
cross_low_surrogate(X, Y) :- Y is (X /\ 0x3FF) + 0xDC00.
         

         
/*******************************************************************/
         
/* Decode Transpile Options                                        */
         
/*******************************************************************/
         

         
% decode_transpile_opts(+List, +Pair, -Pair)
         
decode_transpile_opts(V, _, _) :- var(V),
         
   throw(error(instantiation_error,_)).
         
decode_transpile_opts([X|L], I, O) :- !,
         
   decode_transpile_opt(X, I, H),
         
   decode_transpile_opts(L, H, O).
         
decode_transpile_opts([], H, H) :- !.
         
decode_transpile_opts(L, _, _) :-
         
   throw(error(type_error(list,L),_)).
         

         
% decode_transpile_opt(+Option, +Pair, -Pair)
         
decode_transpile_opt(V, _, _) :- var(V),
         
   throw(error(instantiation_error,_)).
         
decode_transpile_opt(main_entry(B), v(F,Y), v(G,Y)) :- !,
         
   sys_opt_boolean(B, 1, F, G).
         
decode_transpile_opt(defer_meta(B), v(F,Y), v(G,Y)) :- !,
         
   sys_opt_boolean(B, 2, F, G).
         
decode_transpile_opt(doge(A),v(X,_), v(X,A)) :- !,
         
   sys_check_atom(A).
         
decode_transpile_opt(O, _, _) :-
         
   throw(error(type_error(transpile_option,O),_)).