Prolog "json"

Admin User, erstellt 17. Feb. 2024
         
/**
* 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.
*/
:-(ensure_loaded(library(/(util, charsio)))).
:-(json_atom(Json, Atom), ','(var(Atom), ','(!, ','(open_output_atom_stream(K), ','(write_json(K, Json), ','(flush_output(K), close_output_atom_stream(K, Atom))))))).
:-(json_atom(Json, Atom), ','(open_input_atom_stream(Atom, K), ','(sys_receive_token(T, K), ','(;(->(=(T, end_of_file), throw(error(syntax_error(illegal_eof), _))), ','(sys_input_json(T, X, K), ','(sys_receive_token(S, K), ;(->(=(S, end_of_file), true), throw(error(syntax_error(missing_eof), _)))))), =(Json, X))))).
:-(json_object_current({}(C), K, V), ','(sys_json_contain(C, :(K, V)), !)).
:-(json_object_set({}, K, V, R), ','(!, =(R, {}(:(K, V))))).
:-(json_object_set({}(:(K, _)), K, V, R), ','(!, =(R, {}(:(K, V))))).
:-(json_object_set({}(C), K, V, R), ','(sys_json_delete(C, :(K, _), D), ','(!, =(R, {}(','(:(K, V), D)))))).
json_object_set({}(C), K, V, {}(','(:(K, V), C))).
:-(json_object_remove({}, _, R), ','(!, =(R, {}))).
:-(json_object_remove({}(:(K, _)), K, R), ','(!, =(R, {}))).
:-(json_object_remove({}(C), K, R), ','(sys_json_delete(C, :(K, _), D), ','(!, =(R, {}(D))))).
:-(json_object_remove(R, _, R), =(R, {}(_))).
sys_json_contain(X, X).
:-(sys_json_contain(','(A, _), X), sys_json_contain(A, X)).
:-(sys_json_contain(','(_, B), X), sys_json_contain(B, X)).
sys_json_delete(','(X, A), X, A).
sys_json_delete(','(A, X), X, A).
:-(sys_json_delete(','(A, B), X, ','(C, B)), sys_json_delete(A, X, C)).
:-(sys_json_delete(','(A, B), X, ','(A, C)), sys_json_delete(B, X, C)).
:-(write_json(T), ','(current_output(S), sys_print_json(T, S))).
:-(write_json(S, T), sys_print_json(T, S)).
:-(sys_print_json(V, _), ','(var(V), throw(error(instantiation_error, _)))).
:-(sys_print_json(X, S), ','(atom(X), ','(!, ','(sys_string_quoted(X, H), put_atom(S, H))))).
:-(sys_print_json(X, S), ','(number(X), ','(!, ','(atom_number(H, X), put_atom(S, H))))).
:-(sys_print_json(@(X), S), ','(sys_json_ident(X), ','(!, put_atom(S, X)))).
:-(sys_print_json([], S), ','(!, put_atom(S, []))).
:-(sys_print_json('.'(X, L), S), ','(!, ','(put_code(S, 0'[), ','(sys_print_json(X, S), ','(sys_print_list(L, S), put_code(S, 0'])))))).
:-(sys_print_json({}, S), ','(!, put_atom(S, {}))).
:-(sys_print_json({}(M), S), ','(!, ','(put_code(S, 0'{), ','(sys_print_map(M, S), put_code(S, 0'}))))).
:-(sys_print_json(T, _), throw(error(type_error(json, T), _))).
:-(sys_print_map(V, _), ','(var(V), throw(error(instantiation_error, _)))).
:-(sys_print_map(','(P, Q), S), ','(!, ','(sys_print_map(P, S), ','(put_atom(S, ', '), sys_print_map(Q, S))))).
:-(sys_print_map(:(K, V), S), ','(atom(K), ','(!, ','(sys_print_json(K, S), ','(put_atom(S, ': '), sys_print_json(V, S)))))).
:-(sys_print_map(T, _), throw(error(type_error(map, T), _))).
:-(sys_print_list(V, _), ','(var(V), throw(error(instantiation_error, _)))).
:-(sys_print_list([], _), !).
:-(sys_print_list('.'(X, L), S), ','(!, ','(put_atom(S, ', '), ','(sys_print_json(X, S), sys_print_list(L, S))))).
:-(sys_print_list(T, _), throw(error(type_error(list, T), _))).
:-(sys_string_quoted(X, Y), ','(atom_codes(X, L), ','(sys_escape_points(L, R, '.'(0'\", [])), atom_codes(Y, '.'(0'\", R))))).
-->(sys_escape_points('.'(X, L)), ','(sys_escape_point(X), sys_escape_points(L))).
-->(sys_escape_points([]), []).
-->(sys_escape_point(X), ','({}(sys_is_control(Y, X)), ','(!, '.'(0'\\, '.'(Y, []))))).
-->(sys_escape_point(X), ','({}(sys_is_special(X)), ','(!, '.'(0'\\, '.'(X, []))))).
-->(sys_escape_point(X), ','({}(sys_is_cntrl(X)), ','(!, sys_escape_point2(X)))).
-->(sys_escape_point(X), ','({}(sys_is_invalid(X)), ','(!, sys_escape_point2(X)))).
-->(sys_escape_point(X), '.'(X, [])).
-->(sys_escape_point2(X), ','({}(=<(X, 0xffff)), ','(!, ','({}(','(atom_integer(J, 16, X), ','(atom_codes(J, H), ','(length(H, N), is(M, -(4, N)))))), ','('.'(0'\\, '.'(0'u, [])), ','(sys_escape_zeros(M), sys_escape_points2(H))))))).
-->(sys_escape_point2(X), ','({}(','(sys_high_surrogate(X, Y), sys_low_surrogate(X, Z))), ','(sys_escape_point2(Y), sys_escape_point2(Z)))).
sys_is_special(0'\").
sys_is_special(0'\\).
sys_is_special(0'/).
sys_is_control(0'b, 0'\b).
sys_is_control(0'f, 0'\f).
sys_is_control(0'n, 0'\n).
sys_is_control(0'r, 0'\r).
sys_is_control(0't, 0'\t).
:-(sys_high_surrogate(X, Y), is(Y, +(>>(X, 10), 0xd7c0))).
:-(sys_low_surrogate(X, Y), is(Y, +(/\(X, 0x3ff), 0xdc00))).
:-(sys_is_cntrl(C), ','(code_type(C, T), member(T, '.'(15, '.'(16, []))))).
:-(sys_is_invalid(C), ','(code_type(C, T), member(T, '.'(0, '.'(18, '.'(19, [])))))).
-->(sys_escape_points2('.'(H, T)), ','(!, ','('.'(H, []), sys_escape_points2(T)))).
-->(sys_escape_points2([]), []).
-->(sys_escape_zeros(0), !).
-->(sys_escape_zeros(N), ','('.'(0'0, []), ','({}(is(M, -(N, 1))), sys_escape_zeros(M)))).
sys_json_ident(null).
sys_json_ident(false).
sys_json_ident(true).
:-(read_json(X), ','(current_input(S), read_json(S, X))).
:-(read_json(S, X), ','(sys_receive_token(T, S), ;(->(=(T, end_of_file), =(X, end_of_file)), ','(sys_input_json(T, Y, S), =(X, Y))))).
:-(sys_input_json(atom(A), A, _), !).
:-(sys_input_json(number(N), N, _), !).
:-(sys_input_json(ident(I), @(I), _), ','(sys_json_ident(I), !)).
:-(sys_input_json('[', L, S), ','(!, ','(sys_receive_token(T, S), sys_input_list(T, L, S)))).
:-(sys_input_json('{', M, S), ','(!, ','(sys_receive_token(T, S), sys_input_map(T, M, S)))).
:-(sys_input_json(_, _, _), throw(error(syntax_error(illegal_json), _))).
:-(sys_input_list(']', [], _), !).
:-(sys_input_list(T, '.'(X, L), S), ','(sys_input_json(T, X, S), ','(sys_receive_token(R, S), sys_input_rest(R, L, S)))).
:-(sys_input_rest(']', [], _), !).
:-(sys_input_rest(',', '.'(X, L), S), ','(!, ','(sys_receive_token(T, S), ','(sys_input_json(T, X, S), ','(sys_receive_token(R, S), sys_input_rest(R, L, S)))))).
:-(sys_input_rest(_, _, _), throw(error(syntax_error(illegal_array), _))).
:-(sys_input_map('}', {}, _), !).
:-(sys_input_map(T, {}(M), S), ','(sys_input_pair(T, X, S), ','(sys_receive_token(R, S), sys_input_more(R, X, M, S)))).
:-(sys_input_more('}', X, X, _), !).
:-(sys_input_more(',', X, ','(X, M), S), ','(!, ','(sys_receive_token(T, S), ','(sys_input_pair(T, Y, S), ','(sys_receive_token(R, S), sys_input_more(R, Y, M, S)))))).
:-(sys_input_more(_, _, _, _), throw(error(syntax_error(illegal_object), _))).
:-(sys_input_pair(atom(A), :(A, V), S), ','(!, ','(sys_receive_token(T, S), sys_input_value(T, V, S)))).
:-(sys_input_pair(_, _, _), throw(error(syntax_error(illegal_json), _))).
:-(sys_input_value(:, V, S), ','(!, ','(sys_receive_token(T, S), sys_input_json(T, V, S)))).
:-(sys_input_value(_, _, _), throw(error(syntax_error(illegal_json), _))).
:-(sys_receive_token(T, S), ','(get_code(S, C), sys_receive_token(C, T, S))).
:-(sys_receive_token(0'\", atom(A), S), ','(!, ','(get_code(S, H), ','(sys_receive_string(H, L, S), atom_codes(A, L))))).
:-(sys_receive_token(0'-, number(N), S), ','(!, ','(peek_code(S, H), ','(sys_receive_number(H, L, S), ','(atom_codes(A, '.'(0'-, L)), atom_number(A, N)))))).
:-(sys_receive_token(C, number(N), S), ','(sys_json_digit(C), ','(!, ','(peek_code(S, H), ','(sys_receive_number(H, L, S), ','(atom_codes(A, '.'(C, L)), atom_number(A, N))))))).
:-(sys_receive_token(C, T, _), ','(sys_json_punct(C), ','(!, char_code(T, C)))).
:-(sys_receive_token(C, T, S), ','(sys_json_white(C), ','(!, ','(get_code(S, H), sys_receive_token(H, T, S))))).
:-(sys_receive_token(C, ident(I), S), ','(sys_json_letter(C), ','(!, ','(peek_code(S, H), ','(sys_receive_name(H, L, S), atom_codes(I, '.'(C, L))))))).
:-(sys_receive_token(-1, end_of_file, _), !).
:-(sys_receive_token(_, _, _), throw(error(syntax_error(illegal_token), _))).
:-(sys_receive_number(0'., '.'(0'., L), S), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_fraction(H, L, S))))).
:-(sys_receive_number(0'e, '.'(0'e, L), S), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_exponent(H, L, S))))).
:-(sys_receive_number(0'E, '.'(0'E, L), S), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_exponent(H, L, S))))).
:-(sys_receive_number(C, '.'(C, L), S), ','(sys_json_digit(C), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_number(H, L, S)))))).
sys_receive_number(_, [], _).
:-(sys_receive_fraction(0'e, '.'(0'e, L), S), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_exponent(H, L, S))))).
:-(sys_receive_fraction(0'E, '.'(0'E, L), S), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_exponent(H, L, S))))).
:-(sys_receive_fraction(C, '.'(C, L), S), ','(sys_json_digit(C), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_fraction(H, L, S)))))).
sys_receive_fraction(_, [], _).
:-(sys_receive_exponent(0'+, '.'(0'+, L), S), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_exponent(H, L, S))))).
:-(sys_receive_exponent(0'-, '.'(0'-, L), S), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_exponent(H, L, S))))).
:-(sys_receive_exponent(C, '.'(C, L), S), ','(sys_json_digit(C), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_exponent(H, L, S)))))).
sys_receive_exponent(_, [], _).
:-(sys_receive_string(0'\", [], _), !).
:-(sys_receive_string(0'\\, L, S), ','(!, ','(get_code(S, H), sys_receive_escape(H, L, S)))).
:-(sys_receive_string(C, '.'(C, L), S), ','(get_code(S, H), sys_receive_string(H, L, S))).
:-(sys_receive_escape(0'u, '.'(C, L), S), ','(!, ','(sys_receive_hex(4, R, S), ','(atom_codes(I, R), ','(atom_integer(I, 16, C), ','(get_code(S, J), sys_receive_string(J, L, S))))))).
:-(sys_receive_escape(C, '.'(E, L), S), ','(sys_is_control(C, E), ','(!, ','(get_code(S, H), sys_receive_string(H, L, S))))).
:-(sys_receive_escape(C, '.'(C, L), S), ','(sys_is_special(C), ','(!, ','(get_code(S, H), sys_receive_string(H, L, S))))).
:-(sys_receive_escape(_, _, _), throw(error(syntax_error(illegal_escape), _))).
:-(sys_receive_hex(0, [], _), !).
:-(sys_receive_hex(K, '.'(C, L), S), ','(get_code(S, C), ','(sys_json_hex(C), ','(!, ','(is(J, -(K, 1)), sys_receive_hex(J, L, S)))))).
:-(sys_receive_hex(_, _, _), throw(error(syntax_error(illegal_escape), _))).
:-(sys_receive_name(C, '.'(C, L), S), ','(sys_json_letter(C), ','(!, ','(get_code(S, _), ','(peek_code(S, H), sys_receive_name(H, L, S)))))).
sys_receive_name(_, [], _).
:-(sys_json_digit(C), ','(=<(0'0, C), =<(C, 0'9))).
sys_json_punct(0'[).
sys_json_punct(0']).
sys_json_punct(0',).
sys_json_punct(0'{).
sys_json_punct(0'}).
sys_json_punct(0':).
sys_json_white(0' ).
sys_json_white(0'\n).
sys_json_white(0'\r).
sys_json_white(0'\t).
:-(sys_json_hex(C), ','(=<(0'0, C), ','(=<(C, 0'9), !))).
:-(sys_json_hex(C), ','(=<(0'A, C), ','(=<(C, 0'F), !))).
:-(sys_json_hex(C), ','(=<(0'a, C), =<(C, 0'f))).
:-(sys_json_letter(C), ','(=<(0'a, C), =<(C, 0'z))).