Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 XLOG Technologies AG
/**
* 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) :-
code_category(C, T),
sys_type_class(T, D).
% sys_type_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([C], anon) :- code_category(C, 23), !.
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_decimal(L).
sys_get_special(0'd, decimal([0'0, 0'd|L])) --> !,
sys_next_code, sys_get_decimal(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_decimal(-List, +Pair, -Pair)
sys_get_decimal([C|L]) --> sys_current_code(C), {code_category(C, 9)}, !,
sys_next_code, sys_get_decimal(L).
sys_get_decimal([0'.|L]) --> sys_current_code(0'.), sys_at_code(C),
{code_category(C, 9)}, !,
sys_next_code, sys_get_fraction(L).
sys_get_decimal([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_decimal([]) --> [].
% sys_get_fraction(-List, +Pair, -Pair)
sys_get_fraction([C|L]) --> sys_current_code(C), {code_category(C, 9)}, !,
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), {code_category(C, 9)}, !,
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(C) :- sys_is_sign(C).
sys_is_sign_digit(C) :- code_category(C, 9).
% 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_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, +Integer)
sys_safe_atom(S, A, V) :-
sub_atom(A, 0, 1, _, H),
char_code(H, D), !,
ir_object_current(S, 'last', C),
sys_code_class(C, T),
sys_safe_space(T, S, C, D, V),
put_atom(S, A).
sys_safe_atom(_, _, _).
% sys_safe_space(+Atom, +Stream, +Code, +Code, +Integer)
sys_safe_space(T, S, C, D, _) :- sys_name_class(T), !,
sys_safe_name(S, C, D).
sys_safe_space(is_graphic, S, C, D, V) :- !,
sys_safe_symbol(S, C, D, V).
sys_safe_space(is_solo, 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_atom(S, ' ').
sys_safe_name(S, 0'0, 0'\') :- !,
put_atom(S, ' ').
sys_safe_name(_, _, _).
% sys_safe_symbol(+Stream, +Code, +Code, +Integer)
sys_safe_symbol(S, _, D, _) :- sys_code_class(D, is_graphic), !,
put_atom(S, ' ').
sys_safe_symbol(S, 0'-, D, V) :- V /\ 4 =\= 0, code_category(D, 9), !,
put_atom(S, ' ').
sys_safe_symbol(_, _, _, _).
% sys_safe_quote(+Stream, +Code)
sys_safe_quote(S, 0'\') :- !,
put_atom(S, ' ').
sys_safe_quote(S, 0'\`) :- !,
put_atom(S, ' ').
sys_safe_quote(S, 0'\") :- !,
put_atom(S, ' ').
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 Stream Options */
/***************************************************************/
% sys_stream_opts(+List, +Map)
sys_stream_opts(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_stream_opts([X|L], Map) :- !,
sys_stream_opt(X, Map),
sys_stream_opts(L, Map).
sys_stream_opts([], _) :- !.
sys_stream_opts(L, _) :-
throw(error(type_error(list,L),_)).
% sys_stream_opt(+Term, +Map)
sys_stream_opt(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_stream_opt(type(T), Map) :- !,
sys_check_type(T, E),
ir_object_set(Map, encoding, E).
sys_stream_opt(O, _) :-
throw(error(domain_error(open_option,O),_)).
% sys_check_type(+Atom, -Integer)
sys_check_type(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_check_type(text, 'utf8') :- !.
sys_check_type(binary, 'latin1') :- !.
sys_check_type(B, _) :-
throw(error(type_error(type,B),_)).
/***************************************************************/
/* Decode Open Options */
/***************************************************************/
% sys_open_opts(+List, +Map)
sys_open_opts(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_open_opts([X|L], Map) :- !,
sys_open_opt(X, Map),
sys_open_opts(L, Map).
sys_open_opts([], _) :- !.
sys_open_opts(L, _) :-
throw(error(type_error(list,L),_)).
% sys_open_opt(+Term, +Map)
sys_open_opt(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_open_opt(method(M), Map) :- !,
sys_check_atom(M),
ir_object_set(Map, method, M).
sys_open_opt(headers(H), Map) :- !,
ir_object_new(Map2),
sys_header_opts(H, Map2),
ir_object_set(Map, headers, Map2).
sys_open_opt(body(B), Map) :- !,
sys_check_atom(B),
ir_object_new(Map2),
ir_object_set(Map2, text, B),
ir_object_set(Map, body, Map2).
sys_open_opt(body(B, O), Map) :- !,
sys_check_atom(B),
ir_object_new(Map2),
ir_object_set(Map2, text, B),
sys_stream_opts(O, Map2),
ir_object_set(Map, body, Map2).
sys_open_opt(type(T), Map) :- !,
sys_check_type(T, E),
ir_object_set(Map, encoding, E).
sys_open_opt(uri(_), _) :- !.
sys_open_opt(status(_), _) :- !.
sys_open_opt(fields(_), _) :- !.
sys_open_opt(O, _) :-
throw(error(domain_error(open_option,O),_)).
/***************************************************************/
/* Decode Header Options */
/***************************************************************/
% sys_header_opts(+List, +Map)
sys_header_opts(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_header_opts([X|L], Map) :- !,
sys_header_opt(X, Map),
sys_header_opts(L, Map).
sys_header_opts([], _) :- !.
sys_header_opts(L, _) :-
throw(error(type_error(list,L),_)).
% sys_header_opt(+Term, +Map)
sys_header_opt(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_header_opt(K-V, Map) :- !,
sys_check_atom(K),
sys_check_atom(V),
ir_object_set(Map, K, V).
sys_header_opt(O, _) :-
throw(error(type_error(pair,O),_)).
/***************************************************************/
/* Decode Open Results */
/***************************************************************/
% sys_open_results(+List, +Map)
sys_open_results([X|L], Map) :-
sys_open_result(X, Map),
sys_open_results(L, Map).
sys_open_results([], _).
% sys_open_result(+Term, +Map)
sys_open_result(method(_), _).
sys_open_result(headers(_), _).
sys_open_result(body(_), _) :- !.
sys_open_result(body(_, _), _).
sys_open_result(type(_), _).
sys_open_result(uri(U), Map) :-
ir_object_current(Map, uri, U).
sys_open_result(status(S), Map) :-
ir_object_current(Map, status, S).
sys_open_result(fields(F), Map) :-
ir_object_current(Map, fields, Map2),
sys_header_results(Map2, F).
/***************************************************************/
/* Decode Header Results */
/***************************************************************/
% sys_header_results(+Map, -List)
sys_header_results(Map, R) :-
ir_object_keys(Map, L),
sys_header_results(L, Map, R).
% sys_header_results(+List, +Map, -List)
sys_header_results([], _, []).
sys_header_results([K|L], Map, [K-V|R]) :-
ir_object_current(Map, K, V),
sys_header_results(L, Map, R).
/***************************************************************/
/* 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(priority(L), v(N,F,_), v(N,F,L)) :- !,
sys_check_integer(L).
sys_write_opt(O, _, _) :-
throw(error(domain_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 Options */
/***************************************************************/
% 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(end_of_term(F), z(L,_), z(L,G)) :- !,
sys_check_end_of_term(F, G).
sys_read_opt(O, _, _) :-
throw(error(domain_error(read_option,O),_)).
% sys_check_end_of_term(+Atom, -Integer)
sys_check_end_of_term(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_check_end_of_term(dot, 0) :- !.
sys_check_end_of_term(eof, 1) :- !.
sys_check_end_of_term(O, _) :-
throw(error(domain_error(end_of_term,O),_)).
/***************************************************************/
/* Decode Read Results */
/***************************************************************/
% sys_read_results(+List, +Pair)
sys_read_results([X|L], M) :-
sys_read_result(X, M),
sys_read_results(L, M).
sys_read_results([], _).
% sys_read_result(+Elem, +Pair)
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(end_of_term(_), _).
/***************************************************************/
/* 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([]) --> [].
/***************************************************************/
/* String Polate */
/***************************************************************/
% sys_polate(+Stream, +Atom, +List)
sys_polate(Stream, Template, Args) :-
atom_codes(Template, Codes),
sys_polate_format(Args, Stream, Codes, []).
% sys_polate_format(+List, +Stream, +List, -List)
sys_polate_format(H, S) --> "$$", !,
{H = [X|L], write(S, X)},
sys_polate_format(L, S).
sys_polate_format(H, S) --> "$", !,
{H = [X|L], writeq(S, X)},
sys_polate_format(L, S).
sys_polate_format(L, S) --> [X], !,
sys_polate_text(F),
{atom_codes(A, [X|F]), put_atom(S, A)},
sys_polate_format(L, S).
sys_polate_format([], _) --> [].
% sys_polate_text(-List, +List, -List)
sys_polate_text([X|F]) --> [X], {X \== 0'$}, !,
sys_polate_text(F).
sys_polate_text([]) --> [].
/***************************************************************/
/* Pretty Helper */
/***************************************************************/
% sys_listing_name(+Integer, -Atom)
sys_listing_name(K, N) :- K < 26, !,
J is K+0'A,
char_code(N, J).
sys_listing_name(K, N) :-
J is (K rem 26)+0'A,
char_code(C, J),
H is K//26+1,
atom_integer(A, 10, H),
atom_concat(C, A, 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_date', de, 'Kein Datum.').
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) $.').
strings('syntax_error.multiton_var', de, 'Mehrfache markierte Variable(n) $.').
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('syntax_error.illegal_number', '', 'Not a number.').
strings('syntax_error.illegal_reference', '', 'Not a reference.').
strings('syntax_error.illegal_date', '', 'Not a date.').
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) $.').
strings('syntax_error.multiton_var', '', 'Multiton marked 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.').