Prolog "scanner"

Admin User, created Feb 21. 2024
         
/**
* Terms can be written to text streams or read from text streams.
*
* 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.
*/
/***************************************************************/
/* Code Classes */
/***************************************************************/
/**
* sys_code_class(C, D):
* The predicate succeeds in D with the class of the character code C.
*/
% sys_code_class(+Integer, -Atom)
sys_code_class(0',, D) :- !, D = is_punct.
sys_code_class(0'(, D) :- !, D = is_punct.
sys_code_class(0'), D) :- !, D = is_punct.
sys_code_class(0'|, D) :- !, D = is_punct.
sys_code_class(0'[, D) :- !, D = is_punct.
sys_code_class(0'], D) :- !, D = is_punct.
sys_code_class(0'{, D) :- !, D = is_punct.
sys_code_class(0'}, D) :- !, D = is_punct.
sys_code_class(0';, D) :- !, D = is_solo.
sys_code_class(0'!, D) :- !, D = is_solo.
sys_code_class(0'\', D) :- !, D = is_solo.
sys_code_class(0'\`, D) :- !, D = is_solo.
sys_code_class(0'\", D) :- !, D = is_solo.
sys_code_class(0'%, D) :- !, D = is_solo.
sys_code_class(C, D) :-
/* General Category with Java Character numbering */
code_type(C, T),
sys_type_class(T, D).
% sys_code_class(+Integer, -Atom)
/* UNASSIGNED */
sys_type_class(0, is_invalid).
/* UPPERCASE_LETTER */
sys_type_class(1, is_upper).
/* LOWERCASE_LETTER */
sys_type_class(2, is_ident).
/* TITLECASE_LETTER */
sys_type_class(3, is_upper).
/* MODIFIER_LETTER */
sys_type_class(4, is_ident).
/* OTHER_LETTER */
sys_type_class(5, is_ident).
/* NON_SPACING_MARK */
sys_type_class(6, is_ident).
/* ENCLOSING_MARK */
sys_type_class(7, is_ident).
/* COMBINING_SPACING_MARK */
sys_type_class(8, is_ident).
/* DECIMAL_DIGIT_NUMBER */
sys_type_class(9, is_digit).
/* LETTER_NUMBER */
sys_type_class(10, is_ident).
/* OTHER_NUMBER */
sys_type_class(11, is_ident).
/* SPACE_SEPARATOR */
sys_type_class(12, is_blank).
/* LINE_SEPARATOR */
sys_type_class(13, is_blank).
/* PARAGRAPH_SEPARATOR */
sys_type_class(14, is_blank).
/* CONTROL */
sys_type_class(15, is_cntrl).
/* FORMAT */
sys_type_class(16, is_cntrl).
/* PRIVATE_USE */
sys_type_class(18, is_invalid).
/* SURROGATE */
sys_type_class(19, is_invalid).
/* DASH_PUNCTUATION */
sys_type_class(20, is_graphic).
/* START_PUNCTUATION */
sys_type_class(21, is_solo).
/* END_PUNCTUATION */
sys_type_class(22, is_solo).
/* CONNECTOR_PUNCTUATION */
sys_type_class(23, is_score).
/* OTHER_PUNCTUATION */
sys_type_class(24, is_graphic).
/* MATH_SYMBOL */
sys_type_class(25, is_graphic).
/* CURRENCY_SYMBOL */
sys_type_class(26, is_graphic).
/* MODIFIER_SYMBOL */
sys_type_class(27, is_graphic).
/* OTHER_SYMBOL */
sys_type_class(28, is_graphic).
/* INITIAL_QUOTE_PUNCTUATION */
sys_type_class(29, is_solo).
/* FINAL_QUOTE_PUNCTUATION */
sys_type_class(30, is_solo).
% sys_name_class(+Atom)
sys_name_class(is_ident).
sys_name_class(is_upper).
sys_name_class(is_score).
sys_name_class(is_digit).
% sys_white_class(+Atom)
sys_white_class(is_blank).
sys_white_class(is_cntrl).
/***************************************************************/
/* Tokenizer Prolog */
/***************************************************************/
/**
* sys_get_token(T, C, D):
* The predicate succeeds in T with the next token. The parameters C
* and D are used to pass along the stream and the current character.
* The token is not yet converted.
*/
% sys_get_token(-Token, +Pair, -Pair)
sys_get_token(T) --> sys_current_code(C),
{sys_code_class(C, D)}, sys_get_class(D, C, T).
% sys_get_class(+Atom, +Integer, -Token, +Pair, -Pair)
sys_get_class(is_ident, C, atom(A)) -->
sys_next_code, sys_get_name(L), {atom_codes(A, [C|L])}.
sys_get_class(is_upper, C, T) -->
sys_next_code, sys_get_name(L), {sys_make_variable([C|L], T)}.
sys_get_class(is_score, C, T) -->
sys_next_code, sys_get_name(L), {sys_make_variable([C|L], T)}.
sys_get_class(is_digit, C, T) -->
sys_get_number(C, T).
sys_get_class(is_punct, C, A) -->
sys_next_code, {char_code(A, C)}.
sys_get_class(is_graphic, C, T) -->
sys_next_code, sys_get_block_or_symbol(C, T).
sys_get_class(is_solo, C, T) -->
sys_get_line_or_solo(C, T).
sys_get_class(is_invalid, C, T) -->
sys_get_eof_or_error(C, T).
sys_get_class(is_blank, _, T) -->
sys_next_code, sys_get_token(T).
sys_get_class(is_cntrl, _, T) -->
sys_next_code, sys_get_token(T).
% sys_get_eof_or_error(+Integer, -Token, +Pair, -Pair)
sys_get_eof_or_error(-1, end_of_file) --> !.
sys_get_eof_or_error(_, _) -->
{throw(error(syntax_error(illegal_unicode),_))}.
% sys_get_name(-List, +Pair, -Pair)
sys_get_name([C|L]) --> sys_current_code(C), {sys_code_class(C, E), sys_name_class(E)}, !,
sys_next_code, sys_get_name(L).
sys_get_name([]) --> [].
% sys_make_variable(+List, -Term)
sys_make_variable([X], anon) :- sys_code_class(X, is_score), !.
sys_make_variable(L, var(N)) :- atom_codes(N, L).
/***************************************************************/
/* Number Tokens */
/***************************************************************/
% sys_get_number(+Integer, -Term, +Pair, -Pair)
sys_get_number(0'0, T) --> !,
sys_next_code, sys_current_code(C), sys_get_special(C, T).
sys_get_number(C, decimal([C|L])) -->
sys_next_code, sys_get_decimal(L).
% sys_get_special(+Integer, -Term, +Pair, -Pair)
sys_get_special(0'x, radix(L, 16)) --> !,
sys_next_code, sys_get_radix(L, [], 16).
sys_get_special(0'o, radix(L, 8)) --> !,
sys_next_code, sys_get_radix(L, [], 8).
sys_get_special(0'b, radix(L, 2)) --> !,
sys_next_code, sys_get_radix(L, [], 2).
sys_get_special(0'r, reference(L)) --> !,
sys_next_code, sys_get_name(L).
sys_get_special(0'f, decimal([0'0, 0'f|L])) --> !,
sys_next_code, sys_get_tolerant(L).
sys_get_special(0'd, decimal([0'0, 0'd|L])) --> !,
sys_next_code, sys_get_tolerant(L).
sys_get_special(0'\', T) --> !,
sys_next_code, sys_current_code(C), sys_get_code(C, T).
sys_get_special(_, decimal([0'0|L])) -->
sys_get_decimal(L).
% sys_get_code(+Integer, -Code, +Pair, -Pair)
sys_get_code(0'\', code([0'\'|R])) --> !,
sys_next_code, sys_get_double(R).
sys_get_code(0'\\, code([0'\\|R])) --> !,
sys_next_code, sys_current_code(C), sys_get_escape(C, R, []).
sys_get_code(C, code([C])) --> sys_get_char(C).
% sys_get_double(+Pair, -Pair)
sys_get_double([0'\']) --> sys_current_code(0'\'), !,
sys_next_code.
sys_get_double([]) --> [].
% sys_get_tolerant(-List, +Pair, -Pair)
sys_get_tolerant([C|L]) --> sys_current_code(C), {sys_code_class(C, is_digit)}, !,
sys_next_code, sys_get_tolerant(L).
sys_get_tolerant([0'.|L]) --> sys_current_code(0'.), sys_at_code(C),
{sys_code_class(C, is_digit)}, !,
sys_next_code, sys_get_fraction(L).
sys_get_tolerant([C|L]) --> sys_current_code(C), {sys_is_expo(C)},
sys_at_code(D), {sys_is_sign_digit(D)}, !,
sys_next_code, sys_get_exponent(L).
sys_get_tolerant([]) --> [].
% sys_get_decimal(-List, +Pair, -Pair)
sys_get_decimal([C|L]) --> sys_current_code(C), {sys_code_class(C, is_digit)}, !,
sys_next_code, sys_get_decimal(L).
sys_get_decimal([0'.|L]) --> sys_current_code(0'.), sys_at_code(C),
{sys_code_class(C, is_digit)}, !,
sys_next_code, sys_get_fraction(L).
sys_get_decimal([]) --> [].
% sys_get_fraction(-List, +Pair, -Pair)
sys_get_fraction([C|L]) --> sys_current_code(C), {sys_code_class(C, is_digit)}, !,
sys_next_code, sys_get_fraction(L).
sys_get_fraction([C|L]) --> sys_current_code(C), {sys_is_expo(C)},
sys_at_code(D), {sys_is_sign_digit(D)}, !,
sys_next_code, sys_get_exponent(L).
sys_get_fraction([]) --> [].
% sys_get_exponent(-List, +Pair, -Pair)
sys_get_exponent([C|L]) --> sys_current_code(C), {sys_is_sign(C)}, !,
sys_next_code, sys_get_rest(L).
sys_get_exponent(L) -->
sys_get_rest(L).
% sys_get_rest(-List, +Pair, -Pair)
sys_get_rest([C|L]) --> sys_current_code(C), {sys_code_class(C, is_digit)}, !,
sys_next_code, sys_get_rest(L).
sys_get_rest([]) --> [].
% sys_is_expo(+Code)
sys_is_expo(0'E).
sys_is_expo(0'e).
% sys_is_sign_digit(+Code)
sys_is_sign_digit(X) :- sys_is_sign(X).
sys_is_sign_digit(X) :- sys_code_class(X, is_digit).
% sys_is_sign(+Code)
sys_is_sign(0'-).
sys_is_sign(0'+).
/***************************************************************/
/* Comment Tokens */
/***************************************************************/
% sys_get_block_or_symbol(+Integer, -Token, +Pair, -Pair)
sys_get_block_or_symbol(0'/, T) --> sys_current_code(0'*), !,
sys_next_code, sys_skip_block, sys_get_token(T).
sys_get_block_or_symbol(C, T) -->
sys_get_symbol(L), sys_current_code(D), {sys_make_period(D, [C|L], T)}.
% sys_get_symbol(-List, +Pair, -Pair)
sys_get_symbol([C|L]) --> sys_current_code(C), {sys_code_class(C, is_graphic)}, !,
sys_next_code, sys_get_symbol(L).
sys_get_symbol([]) --> [].
% sys_skip_block(+Pair, -Pair)
sys_skip_block --> sys_current_code(0'*), !,
sys_next_code, sys_skip_end.
sys_skip_block --> sys_current_code(-1),
{throw(error(syntax_error(end_of_file_in_block_comment),_))}.
sys_skip_block -->
sys_next_code, sys_skip_block.
% sys_skip_end(+Pair, -Pair)
sys_skip_end --> sys_current_code(0'/), !,
sys_next_code.
sys_skip_end -->
sys_skip_block.
% sys_make_period(+Integer, +List, -Token)
sys_make_period(0'%, [0'.], '.') :- !.
sys_make_period(-1, [0'.], '.') :- !.
sys_make_period(C, [0'.], '.') :- sys_code_class(C, D), sys_white_class(D), !.
sys_make_period(_, L, atom(T)) :- atom_codes(T, L).
/***************************************************************/
/* String Tokens Prolog */
/***************************************************************/
% sys_get_line_or_solo(+Integer, -Token, +Pair, -Pair)
sys_get_line_or_solo(0'\', single(R)) --> !,
sys_next_code, sys_get_quote(R, 0'\').
sys_get_line_or_solo(0'\`, back(R)) --> !,
sys_next_code, sys_get_quote(R, 0'\`).
sys_get_line_or_solo(0'\", codes(R)) --> !,
sys_next_code, sys_get_quote(R, 0'\").
sys_get_line_or_solo(0'%, T) --> !,
sys_next_code, sys_current_code(C), sys_skip_line(C), sys_get_token(T).
sys_get_line_or_solo(C, atom(A)) -->
sys_next_code, {char_code(A, C)}.
% sys_skip_line(+Integer, +Pair, -Pair)
sys_skip_line(0'\n) --> !.
sys_skip_line(0'\r) --> !.
sys_skip_line(-1) --> !.
sys_skip_line(_) -->
sys_next_code, sys_current_code(C), sys_skip_line(C).
% sys_get_quote(-List, +Code, +Pair, -Pair)
sys_get_quote(L, Q) --> sys_current_code(Q), !,
sys_next_code, sys_get_more(L, Q).
sys_get_quote(L, Q) --> sys_current_code(0'\\), !,
sys_next_code, sys_get_cont(L, Q).
sys_get_quote([C|L], Q) -->
sys_current_code(C), sys_get_char(C), sys_get_quote(L, Q).
% sys_get_more(-List, +Code, +Pair, -Pair)
sys_get_more([Q|L], Q) --> sys_current_code(Q), !,
sys_next_code, sys_get_quote(L, Q).
sys_get_more([], _) --> [].
% sys_get_char(+Integer, +Pair, -Pair)
sys_get_char(0'\n) -->
{throw(error(syntax_error(end_of_line_as_character),_))}.
sys_get_char(0'\r) -->
{throw(error(syntax_error(end_of_line_as_character),_))}.
sys_get_char(-1) -->
{throw(error(syntax_error(unbalanced_quoted),_))}.
sys_get_char(_) -->
sys_next_code.
/***************************************************************/
/* Char Escape */
/***************************************************************/
% sys_get_cont(+Code, -List, +Code, +Pair, -Pair)
sys_get_cont([0'\\|L], Q) -->
sys_current_code(C), sys_get_escape(C, L, R), sys_get_quote(R, Q).
% sys_get_escape(+Integer, -List, +List, +Pair, -Pair)
sys_get_escape(0'\r, [0'\r|L], R) --> !,
sys_next_code, sys_get_skip(L, R).
sys_get_escape(-1, _, _) -->
{throw(error(syntax_error(illegal_escape),_))}.
sys_get_escape(0'x, [0'x|L], R) --> !,
sys_next_code, sys_get_radix(L, H, 16), sys_get_backslash(H, R).
sys_get_escape(C, [C|L], R) --> {sys_is_radix(C, 8)}, !,
sys_next_code, sys_get_radix(L, H, 8), sys_get_backslash(H, R).
sys_get_escape(C, [C|L], L) -->
sys_next_code.
% sys_get_skip(-List, +List, +Pair, -Pair)
sys_get_skip([0'\n|L], L) --> sys_current_code(0'\n), !,
sys_next_code.
sys_get_skip(L, L) --> [].
% sys_get_backslash(-List, +List, +Pair, -Pair)
sys_get_backslash([0'\\|L], L) --> sys_current_code(0'\\), !,
sys_next_code.
sys_get_backslash(L, L) --> [].
% sys_get_radix(-List, +List, +Integer, +Pair, -Pair)
sys_get_radix([C|L], R, B) --> sys_current_code(C), {sys_is_radix(C, B)}, !,
sys_next_code, sys_get_radix(L, R, B).
sys_get_radix(L, L, _) --> [].
% sys_is_radix(+Code, +Integer)
sys_is_radix(C, B) :- code_numeric(C, N), 0 =< N, N < B.
% sys_is_meta(+Code)
sys_is_meta(0'\').
sys_is_meta(0'\`).
sys_is_meta(0'\").
sys_is_meta(0'\\).
% sys_is_escape(+Code, -Code)
sys_is_escape(0'n, 0'\n).
sys_is_escape(0't, 0'\t).
sys_is_escape(0'b, 0'\b).
sys_is_escape(0'f, 0'\f).
sys_is_escape(0'r, 0'\r).
sys_is_escape(0'a, 0'\a).
sys_is_escape(0'v, 0'\v).
% sys_current_code(-Code, +Pair, -Pair)
sys_current_code(C, S-C, S-C).
% sys_next_code(+Pair, -Pair)
sys_next_code(S-_, S-C) :- get_code(S, C).
% sys_at_code(-Code, +Pair, -Pair)
sys_at_code(D, S-C, S-C) :- peek_code(S, D).
/***************************************************************/
/* Sync Tokens */
/***************************************************************/
% sys_sync_throw(+Error, +Quad, -Quad)
sys_sync_throw(E) -->
{sys_fill_stack(E)}, sys_sync_tokens, {sys_raise(E)}.
% sys_sync_raise(+Error, +Quad, -Quad)
sys_sync_raise(E) -->
sys_sync_tokens, {sys_raise(E)}.
% sys_sync_tokens(+Quad, -Quad)
sys_sync_tokens --> sys_current_token('.'), !.
sys_sync_tokens --> sys_current_token(end_of_file), !.
sys_sync_tokens --> sys_sync_token, sys_sync_tokens.
% sys_sync_token(+Quad, -Quad)
sys_sync_token(t(_,F,r(S,C),M), t(T,F,r(S,E),M)) :- sys_get_token(T, S-C, _-E).
/***************************************************************/
/* Safe Write */
/***************************************************************/
/**
* sys_safe_code(S, C): internal only
* The predicate succeeds. As a side effect, the code C is
* safely written to the stream S.
*/
% sys_safe_code(+Stream, +Integer)
sys_safe_code(S, D) :-
current_lastcode(S, C),
sys_safe_space(S, C, D),
put_code(S, D).
/**
* sys_safe_atom(S, A): internal only
* The predicate succeeds. As a side effect, the atom A is
* safely written to the stream S.
*/
% sys_safe_atom(+Stream, +Atom)
sys_safe_atom(S, A) :-
atom_arg(0, A, D), !,
current_lastcode(S, C),
sys_safe_space(S, C, D),
put_atom(S, A).
sys_safe_atom(_, _).
% sys_safe_space(+Stream, +Code, +Code)
sys_safe_space(S, C, D) :- sys_code_class(C, E), sys_name_class(E), !,
sys_safe_name(S, C, D).
sys_safe_space(S, C, D) :- sys_code_class(C, is_graphic), !,
sys_safe_symbol(S, D).
sys_safe_space(S, C, D) :- C =:= D, !,
sys_safe_quote(S, D).
sys_safe_space(_, _, _).
% sys_safe_name(+Stream, +Code, +Code)
sys_safe_name(S, _, D) :- sys_code_class(D, E), sys_name_class(E), !,
put_code(S, 0' ).
sys_safe_name(S, 0'0, 0'\') :- !,
put_code(S, 0' ).
sys_safe_name(_, _, _).
% sys_safe_symbol(+Stream, +Code)
sys_safe_symbol(S, D) :- sys_code_class(D, is_graphic), !,
put_code(S, 0' ).
sys_safe_symbol(_, _).
% sys_safe_quote(+Stream, +Code)
sys_safe_quote(S, 0'\') :- !,
put_code(S, 0' ).
sys_safe_quote(S, 0'\`) :- !,
put_code(S, 0' ).
sys_safe_quote(S, 0'\") :- !,
put_code(S, 0' ).
sys_safe_quote(_, _).
/***************************************************************/
/* Convert Token */
/***************************************************************/
% sys_next_token(+Quad, -Quad)
sys_next_token(t(_,F,r(S,C),M), t(T,F,r(S,E),M)) :-
sys_get_token(H, S-C, _-E),
sys_trap(sys_convert_token(H,T), G, sys_sync_raise(G, t(H,F,r(S,E),M), _)).
% sys_convert_token(+Token, -Token)
sys_convert_token(single(R), atom(A)) :- !,
sys_convert_quote(L, R, []),
atom_codes(A, L).
sys_convert_token(back(R), T) :- !,
sys_convert_quote(L, R, []), sys_make_variable(L, T).
sys_convert_token(decimal(L), number(N)) :- !,
atom_codes(J, L), atom_number(J, N).
sys_convert_token(radix(L, B), radix(N, B)) :- !,
atom_codes(J, L), atom_integer(J, B, N).
sys_convert_token(reference(L), reference(N)) :- !,
atom_codes(J, L), atom_reference(J, N).
sys_convert_token(codes(R), codes(L)) :- !,
sys_convert_quote(L, R, []).
sys_convert_token(code(R), code(C)) :- !,
sys_convert_code(C, R, []).
sys_convert_token(T, T).
% sys_convert_quote(-List, +List, -List)
sys_convert_quote(L) --> [0'\\], sys_convert_sep, !,
sys_convert_quote(L).
sys_convert_quote([C|L]) --> sys_convert_char(C), !,
sys_convert_quote(L).
sys_convert_quote([]) --> [].
% sys_convert_sep(+List, -List)
sys_convert_sep --> [0'\r, 0'\n].
sys_convert_sep --> [0'\n].
sys_convert_sep --> [0'\r].
% sys_convert_char(-Code, +List, -List)
sys_convert_char(C) --> [0'\\], !,
sys_convert_escape(C).
sys_convert_char(_) --> [C], {sys_code_class(C, is_cntrl),
throw(error(syntax_error(illegal_layout),_))}.
sys_convert_char(_) --> [C], {sys_code_class(C, is_invalid),
throw(error(syntax_error(illegal_unicode),_))}.
sys_convert_char(C) --> [C].
% sys_convert_code(-Code, +List, -List)
sys_convert_code(0'\') --> [0'\'], !,
sys_convert_double.
sys_convert_code(C) -->
sys_convert_char(C).
% sys_convert_code(+List, -List)
sys_convert_double --> [0'\'], !.
sys_convert_double -->
{throw(error(syntax_error(doubling_missing),_))}.
% sys_convert_escape(-Code, +List, -List)
sys_convert_escape(D) --> [C], {sys_is_escape(C, D)}, !.
sys_convert_escape(N) --> [C], {sys_is_radix(C, 8)}, !,
sys_convert_radix(H, 8),
{atom_codes(J, [C|H]), atom_integer(J, 8, N)},
sys_convert_backslash.
sys_convert_escape(N) --> [0'x], !,
sys_convert_radix(H, 16),
{atom_codes(J, H), atom_integer(J, 16, N)},
sys_convert_backslash.
sys_convert_escape(C) --> [C], {sys_is_meta(C)}, !.
sys_convert_escape(_) -->
{throw(error(syntax_error(illegal_escape),_))}.
% sys_convert_backslash(+List, -List)
sys_convert_backslash --> [0'\\], !.
sys_convert_backslash -->
{throw(error(syntax_error(unbalanced_escape),_))}.
% sys_convert_radix(-List, +Integer, +List, -List)
sys_convert_radix([C|L], B) --> [C], {sys_is_radix(C, B)}, !,
sys_convert_radix(L, B).
sys_convert_radix([], _) --> [].
/***************************************************************/
/* Decode Write Options */
/***************************************************************/
% sys_write_opts(+List, +Triple, -Triple)
sys_write_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_write_opts([X|L], I, O) :- !,
sys_write_opt(X, I, H),
sys_write_opts(L, H, O).
sys_write_opts([], H, H) :- !.
sys_write_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% sys_write_opt(+Option, +Triple, -Triple)
sys_write_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_write_opt(variable_names(N), v(_,F,L), v(N,F,L)) :- !,
sys_write_variable_names(N).
sys_write_opt(quoted(B), v(N,F,L), v(N,G,L)) :- !,
sys_opt_boolean(B, 1, F, G).
sys_write_opt(ignore_ops(B), v(N,F,L), v(N,G,L)) :- !,
sys_opt_boolean(B, 2, F, G).
sys_write_opt(format(B), v(N,F,L), v(N,G,L)) :- !, % internal only
sys_opt_boolean(B, 4, F, G).
sys_write_opt(numbervars(B), v(N,F,L), v(N,G,L)) :- !,
sys_opt_boolean(B, 8, F, G).
sys_write_opt(annotation(B), v(N,F,L), v(N,G,L)) :- !,
sys_opt_boolean(B, 16, F, G).
sys_write_opt(priority(L), v(N,F,_), v(N,F,L)) :- !,
sys_check_integer(L).
sys_write_opt(O, _, _) :-
throw(error(type_error(write_option,O),_)).
% sys_write_variable_names(+List)
sys_write_variable_names(V) :- var(V),
throw(error(instantiation_error,_)).
sys_write_variable_names([X|L]) :- !,
sys_write_variable_name(X),
sys_write_variable_names(L).
sys_write_variable_names([]) :- !.
sys_write_variable_names(L) :-
throw(error(type_error(list,L),_)).
% sys_write_variable_name(+Pair)
sys_write_variable_name(V) :- var(V),
throw(error(instantiation_error,_)).
sys_write_variable_name(N=_) :- !,
sys_check_atom(N).
sys_write_variable_name(P) :-
throw(error(type_error(variable_name,P),_)).
/***************************************************************/
/* Decode Read Results */
/***************************************************************/
% sys_read_opts(+List, +Pair, -Pair)
sys_read_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_read_opts([X|L], I, O) :- !,
sys_read_opt(X, I, H),
sys_read_opts(L, H, O).
sys_read_opts([], H, H) :- !.
sys_read_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% sys_read_opt(+Option, +Pair, -Pair)
sys_read_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_read_opt(variable_names(_), L, L) :- !.
sys_read_opt(singletons(_), L, L) :- !.
sys_read_opt(priority(L), z(_,F), z(L,F)) :- !, sys_check_integer(L).
sys_read_opt(annotation(B), z(L,F), z(L,G)) :- !,
sys_opt_boolean(B, 16, F, G).
sys_read_opt(O, _, _) :-
throw(error(type_error(read_option,O),_)).
% sys_read_results(+List, +Pair)
sys_read_results(V, _) :- var(V),
throw(error(instantiation_error, _)).
sys_read_results([X|L], M) :- !,
sys_read_result(X, M),
sys_read_results(L, M).
sys_read_results([], _) :- !.
sys_read_results(L, _) :-
throw(error(type_error(list,L),_)).
% sys_read_result(+Elem, +Pair)
sys_read_result(V, _) :- var(V),
throw(error(instantiation_error, _)).
sys_read_result(variable_names(M), s(N,_)) :- !,
reverse(N, M).
sys_read_result(singletons(B), s(_,A)) :- !,
reverse(A, B).
sys_read_result(priority(_), _) :- !.
sys_read_result(annotation(_), _) :- !.
sys_read_result(O, _) :-
throw(error(type_error(read_option,O),_)).
/***************************************************************/
/* Option Helper */
/***************************************************************/
% sys_opt_boolean(+Boolean, +Integer, +Integer, -Integer)
sys_opt_boolean(V, _, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_opt_boolean(true, M, F, G) :- !,
G is F \/ M.
sys_opt_boolean(false, M, F, G) :- !,
G is F /\ \ M.
sys_opt_boolean(B, _, _, _) :-
throw(error(type_error(boolean,B),_)).
/***************************************************************/
/* Escape Helper */
/***************************************************************/
% sys_proper_atom(+List)
sys_proper_atom([X|L]) :- sys_code_class(X, C), sys_proper_atom(C, [X|L]).
% sys_proper_atom(+Atom +List)
sys_proper_atom(is_ident, [_|L]) :- sys_proper_atom_name(L).
sys_proper_atom(is_graphic, [0'.]) :- !, fail.
sys_proper_atom(is_graphic, [0'/,0'*|_]) :- !, fail.
sys_proper_atom(is_graphic, [_|L]) :- sys_proper_atom_graphic(L).
sys_proper_atom(is_solo, [0'\']) :- !, fail.
sys_proper_atom(is_solo, [0'\`]) :- !, fail.
sys_proper_atom(is_solo, [0'\"]) :- !, fail.
sys_proper_atom(is_solo, [0'%]) :- !, fail.
sys_proper_atom(is_solo, [_]).
sys_proper_atom(is_punct, [0'[, 0']]) :- !.
sys_proper_atom(is_punct, [0'{, 0'}]).
% sys_proper_atom_name(+List)
sys_proper_atom_name([X|L]) :- sys_code_class(X, C), sys_name_class(C), !,
sys_proper_atom_name(L).
sys_proper_atom_name([]).
% sys_proper_atom_graphic(+List)
sys_proper_atom_graphic([X|L]) :- sys_code_class(X, is_graphic), !,
sys_proper_atom_graphic(L).
sys_proper_atom_graphic([]).
% sys_escape_codes(+List, -List, +List)
sys_escape_codes([X|L]) -->
sys_escape_code(X),
sys_escape_codes(L).
sys_escape_codes([]) --> [].
% sys_escape_code(+Integer, -List, +List)
sys_escape_code(X) --> {sys_is_escape(Y, X)}, !, [0'\\, Y].
sys_escape_code(X) --> {sys_is_meta(X)}, !, [0'\\, X].
sys_escape_code(X) --> {sys_code_class(X, is_cntrl)}, !, sys_escape_code2(X).
sys_escape_code(X) --> {sys_code_class(X, is_invalid)}, !, sys_escape_code2(X).
sys_escape_code(X) --> [X].
% sys_escape_code2(+Integer, -List, +List)
sys_escape_code2(X) --> {X =< 0x1FF}, !,
{atom_integer(J, 8, X), atom_codes(J, H)},
[0'\\], sys_escape_codes2(H), [0'\\].
sys_escape_code2(X) -->
{atom_integer(J, 16, X), atom_codes(J, H)},
[0'\\, 0'x], sys_escape_codes2(H), [0'\\].
% sys_escape_codes2(+Integer, -List, +List)
sys_escape_codes2([H|T]) --> !, [H], sys_escape_codes2(T).
sys_escape_codes2([]) --> [].
/***************************************************************/
/* Pretty Helper */
/***************************************************************/
% sys_make_negative(+Term, -Term)
sys_make_negative('$RDX'(N,B), '$RDX'(H,B)) :- !, H is -N.
sys_make_negative('$CHR'(N), '$CHR'(H)) :- !, H is -N.
sys_make_negative(N, H) :- H is -N.
/****************************************************************/
/* Error Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile strings/3.
strings('syntax_error.illegal_number', de, 'Keine Nummer.').
strings('syntax_error.illegal_reference', de, 'Keine Referenz.').
strings('syntax_error.illegal_layout', de, 'Unerlaubtes Druckbildzeichen in Zeichenkette.').
strings('syntax_error.illegal_unicode', de, 'Unerlaubtes Unicodezeichen im Text.').
strings('syntax_error.doubling_missing', de, 'Anführungszeichen nicht zweifach.').
strings('syntax_error.illegal_escape', de, 'Unerlaubte Steuersequenz in Zeichenkette.').
strings('syntax_error.unbalanced_escape', de, 'Steuersequenz nicht abgeschlossen.').
strings('syntax_error.end_of_file_in_block_comment', de, 'Blockkommentar nicht geschlossen.').
strings('syntax_error.end_of_line_as_character', de, 'Unerlaubtes Zeilenende als Zeichen.').
strings('syntax_error.singleton_var', de, 'Alleinstehende Variable(n) ~, anonyme Variable(n) (_) benutzen.').
strings('syntax_error.bracket_balance', de, 'Rechte eckige Klammer (\"]\") fehlt.').
strings('syntax_error.brace_balance', de, 'Rechte geschweifte Klammer (\"}\") fehlt.').
strings('syntax_error.parenthesis_balance', de, 'Rechte runde Klammer (\")\") fehlt.').
strings('syntax_error.end_of_clause_expected', de, 'Überflüssiges Token.').
strings('syntax_error.operator_clash', de, 'Runde Klammer (\"(\") vor Operator fehlt.').
strings('syntax_error.cannot_start_term', de, 'Term fehlt.').
strings('existence_error.source_sink', de, 'Datei ~ nicht gefunden.').
strings('permission_error.open.source_sink', de, 'Kann Datei ~ nicht öffnen.').
strings('resource_error.io_exception', de, 'Datei nicht erstellt oder nicht zugreifbar.').
strings('resource_error.remote_error', de, 'Fehler von Entfernt erhalten.').
strings('resource_error.socket_timeout', de, 'Ein-/Ausgabeauszeit.').
strings('syntax_error.illegal_number', '', 'Not a number.').
strings('syntax_error.illegal_reference', '', 'Not a reference.').
strings('syntax_error.illegal_layout', '', 'Illegal layout character in string.').
strings('syntax_error.illegal_unicode', '', 'Illegal Unicode character in text.').
strings('syntax_error.doubling_missing', '', 'Quote not doubled.').
strings('syntax_error.illegal_escape', '', 'Illegal escape sequence in string.').
strings('syntax_error.unbalanced_escape', '', 'Escape sequence not closed.').
strings('syntax_error.end_of_file_in_block_comment', '', 'Block comment not closed.').
strings('syntax_error.end_of_line_as_character', '', 'Illegal end of line as character.').
strings('syntax_error.singleton_var', '', 'Singleton variable(s) ~, use anonymous variable(s) (_).').
strings('syntax_error.bracket_balance', '', 'Right bracket (\"]\") missing.').
strings('syntax_error.brace_balance', '', 'Right brace (\"}\") missing.').
strings('syntax_error.parenthesis_balance', '', 'Right parenthesis (\")\") missing.').
strings('syntax_error.end_of_clause_expected', '', 'Superfluous token.').
strings('syntax_error.operator_clash', '', 'Parenthesis (\"(\") before operator missing.').
strings('syntax_error.cannot_start_term', '', 'Term missing.').
strings('existence_error.source_sink', '', 'File ~ not found.').
strings('permission_error.open.source_sink', '', 'Cannot open file ~.').
strings('resource_error.io_exception', '', 'File not created or not accessible.').
strings('resource_error.remote_error', '', 'Got error from remote.').
strings('resource_error.socket_timeout', '', 'Input/output timeout.').