Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2024 XLOG Technologies AG
/**
* 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.
*/
/***************************************************************/
/* Unparse Prolog */
/***************************************************************/
% sys_is_infix(-Atom, -Integer, -Imteger)
sys_is_infix(xfx, 1, 1).
sys_is_infix(yfx, 0, 1).
sys_is_infix(xfy, 1, 0).
% sys_is_prefix(-Atom, -Integer)
sys_is_prefix(fx, 1).
sys_is_prefix(fy, 0).
% sys_is_postfix(-Atom, -Integer)
sys_is_postfix(xf, 1).
sys_is_postfix(yf, 0).
% sys_write_term(+Stream, +Term, +List)
sys_write_term(S, T, O) :-
sys_write_opts(O, v([],0,1200), v(N,F,L)),
set_lastcode(S, -1),
sys_write_priority(T, w(1,L,0), v(S,F,N)).
/**
* The second argument is a context flag and level pair.
* The context flags are used to allow correct writing:
* 1: (-) - - versus - - - .
* 2: - (a,b,c) versus -(a,b,c).
* 4: - 1 versus -1.
* 8: (a***b)*c versus a***b*c, for op(400,xfy,***).
*/
% sys_write_priority(+Term, +Triple, +Triple)
sys_write_priority(X, _, P) :- var(X), !,
sys_write_var(X, P).
sys_write_priority(X, Q, P) :- number(X), !,
sys_write_number(X, Q, P).
sys_write_priority(X, Q, P) :- atom(X), !,
sys_write_atom(X, Q, P).
sys_write_priority(X, _, P) :- reference(X), !,
sys_put_symbol(X, P).
sys_write_priority('$RDX'(X,B), w(V,_,_), P) :- sys_current_flags(P, G),
G /\ 16 =\= 0, integer(X), integer(B), !,
sys_atom_radix(H, B, X),
sys_current_stream(P, S),
sys_put_nspace(S, V),
sys_safe_atom(S, H).
sys_write_priority('$STR'(X), _, P) :- sys_current_flags(P, G),
G /\ 16 =\= 0, atom(X), !,
sys_atom_string(H, X),
sys_current_stream(P, S),
sys_safe_atom(S, H).
sys_write_priority('$CHR'(X), w(V,_,_), P) :- sys_current_flags(P, G),
G /\ 16 =\= 0, integer(X), !,
sys_atom_char(H, X),
sys_current_stream(P, S),
sys_put_nspace(S, V),
sys_safe_atom(S, H).
sys_write_priority(X, Q, P) :- sys_current_flags(P, G), G /\ 2 =\= 0,
compound(X), !,
sys_write_compound(X, Q, P).
sys_write_priority([X|L], w(_,_,I), P) :- !,
sys_current_stream(P, S),
put_code(S, 0'[),
sys_write_priority(X, w(1,999,I), P), sys_write_list(L, I, P),
put_code(S, 0']).
sys_write_priority({X}, w(_,_,I), P) :- !,
sys_current_stream(P, S),
put_code(S, 0'{),
sys_write_priority(X, w(1,1200,I), P),
put_code(S, 0'}).
sys_write_priority(X, Q, P) :- functor(X, F, 1),
sys_op(F, M, R, K, _), sys_is_prefix(M, E), !,
sys_write_prefix(X, Q, P, R, K, E).
sys_write_priority(X, Q, P) :- functor(X, F, 1),
sys_op(F, M, R, K, _), sys_is_postfix(M, D), !,
sys_write_postfix(X, Q, P, R, K, D).
sys_write_priority(X, Q, P) :- functor(X, F, 2),
sys_op(F, M, R, K, _), sys_is_infix(M, D, E), !,
sys_write_infix(X, Q, P, R, K, D, E).
sys_write_priority(X, Q, P) :-
sys_write_compound(X, Q, P).
% sys_write_number(+Number, +Triple, +Triple)
sys_write_number(X, w(V,_,_), P) :- number(X), !,
atom_number(H, X),
sys_current_stream(P, S),
sys_put_nspace(S, V),
sys_safe_atom(S, H).
% sys_write_atom(+Atom, +Triple, +Triple)
sys_write_atom(X, w(V,_,_), P) :- V /\ 1 =:= 0,
sys_op(X, M, _, _, _), sys_is_prefix(M, _), !,
sys_current_stream(P, S),
sys_put_lparen(S, 1, 0, 1200, V, _),
sys_put_symbol(X, P),
put_code(S, 0')).
sys_write_atom(X, _, P) :-
sys_put_symbol(X, P).
% sys_write_prefix(+Term, +Triple, +Triple, +Integer, +Integer, +Integer)
sys_write_prefix(X, w(U,L,I), P, R, K, E) :-
X =.. [F,Z],
sys_current_stream(P, S),
sys_current_flags(P, N),
sys_put_lparen(S, E, L, R, U, V),
sys_put_adjust(I, N, K, J),
sys_oper_minus(F, V, W),
sys_put_symbol(F, P), sys_put_rspace(S, K, W, G),
T is R-E, H is G /\ \ 8, sys_write_priority(Z, w(H,T,J), P),
sys_put_rparen(S, E, L, R, U).
% sys_write_postfix(+Term, +Triple, +Triple, +Integer, +Integer, +Integer)
sys_write_postfix(X, w(U,L,I), P, R, K, D) :-
X =.. [F,Y],
sys_current_stream(P, S),
sys_put_lparen(S, 1, L, R, U, V),
sys_oper_escape(F, V, W),
sys_oper_side(D, W, G),
Q is R-D, sys_write_priority(Y, w(G,Q,I), P),
sys_put_lspace(S, K), sys_put_oper(F, P, _),
sys_put_rparen(S, 1, L, R, U).
% sys_write_infix(+Term, +Triple, +Triple, +Integer, +Integer, +Integer, +Integer)
sys_write_infix(X, w(U,L,I), P, R, K, D, E) :-
X =.. [F,Y,Z],
sys_current_stream(P, S),
sys_current_flags(P, N),
sys_put_lparen(S, E, L, R, U, V),
sys_put_indent(S, I, N, K, E, L, R, U, J),
sys_oper_escape(F, V, W),
sys_oper_side(D, W, G),
Q is R-D, sys_write_priority(Y, w(G,Q,J), P),
sys_put_lformat(S, J, N, K), sys_put_oper(F, P, O),
sys_put_rformat(S, J, N, K, O, V),
T is R-E, H is V /\ \ 14,
sys_write_priority(Z, w(H,T,J), P),
sys_put_rparen(S, E, L, R, U).
% sys_write_list(+List, +Integer, +Triple)
sys_write_list(X, I, P) :- var(X), !,
sys_current_stream(P, S),
put_code(S, 0'|),
sys_write_priority(X, w(1,999,I), P).
sys_write_list([X|L], I, P) :- !,
sys_current_stream(P, S),
put_atom(S, ', '),
sys_write_priority(X, w(1,999,I), P), sys_write_list(L, I, P).
sys_write_list([], _, _) :- !.
sys_write_list(X, I, P) :-
sys_current_stream(P, S),
put_code(S, 0'|),
sys_write_priority(X, w(1,999,I), P).
/***************************************************************/
/* Write Compoud */
/***************************************************************/
% sys_write_compound(+Term, +Triple, +Triple)
sys_write_compound(X, w(_,_,I), P) :-
X =.. [F,H|L],
sys_current_stream(P, S),
sys_put_symbol(F, P), put_code(S, 0'(),
sys_write_priority(H, w(1,999,I), P), sys_write_args(L, I, P),
put_code(S, 0')).
% sys_write_args(+List,, +Integer +Triple)
sys_write_args([X|L], I, P) :-
sys_current_stream(P, S),
put_atom(S, ', '),
sys_write_priority(X, w(1,999,I), P), sys_write_args(L, I, P).
sys_write_args([], _, _).
% sys_atom_radix(-Atom, +Integer, +Integer)
sys_atom_radix(H, 16, X) :- !,
sys_atom_radix2(H, 16, '0x', X).
sys_atom_radix(H, 8, X) :- !,
sys_atom_radix2(H, 8, '0o', X).
sys_atom_radix(H, 2, X) :- !,
sys_atom_radix2(H, 2, '0b', X).
sys_atom_radix(H, _, X) :-
atom_integer(H, 10, X).
% sys_atom_radix2(-Atom, +Integer, +Atom, +Integer)
sys_atom_radix2(H, B, P, X) :- 0 =< X, !,
atom_integer(J, B, X),
atom_split(H, '', [P,J]).
sys_atom_radix2(H, B, P, X) :- !,
Y is -X,
atom_integer(J, B, Y),
atom_split(H, '', ['-',P,J]).
% sys_atom_string(-Atom, +Atom)
sys_atom_string(H, X) :-
atom_codes(X, L),
sys_escape_codes(L, R, [0'\"]),
atom_codes(H, [0'\"|R]).
% sys_atom_char(-Atom, +Integer)
sys_atom_char(H, X) :- 0 =< X, X =< 0x10FFFF, !,
sys_escape_code(X, L, []),
atom_codes(H, [0'0, 0'\'|L]).
sys_atom_char(H, X) :- -0x10FFFF =< X, X =< -1, !,
Y is -X,
sys_escape_code(Y, L, []),
atom_codes(H, [0'-, 0'0, 0'\'|L]).
sys_atom_char(H, X) :-
atom_integer(H, 10, X).
/***************************************************************/
/* Write Variable */
/***************************************************************/
% sys_write_var(+Var, +Triple)
sys_write_var(V, P) :- sys_current_vars(P, L), sys_find_var(V, L, N), !,
sys_current_flags(P, G),
sys_var_quoted(N, G, M),
sys_current_stream(P, S),
sys_safe_atom(S, M).
sys_write_var(V, P) :-
sys_current_stream(P, S),
sys_safe_code(S, 0'_),
dg_var_serno(V, K),
atom_integer(R, 10, K),
put_atom(S, R).
% sys_find_var(+Var, +Map, -Atom)
sys_find_var(V, L, N) :-
member(N = W, L), V == W, !.
% sys_var_quoted(+Atom, +Integer, -Atom)
sys_var_quoted(X, G, X) :- G /\ 1 =:= 0, !.
sys_var_quoted(X, _, Y) :-
atom_codes(X, L), \+ sys_proper_var(L), !,
sys_escape_codes(L, R, [0'\`]),
atom_codes(Y, [0'\`|R]).
sys_var_quoted(X, _, X).
% sys_proper_var(+List)
sys_proper_var([X|L]) :- sys_code_class(X, C), sys_proper_var(C, [X|L]).
% sys_proper_var(+Atom, +List)
sys_proper_var(is_upper, [_|L]) :- sys_proper_atom_name(L).
sys_proper_var(is_score, [_|L]) :- sys_proper_atom_name(L).
/***************************************************************/
/* Format Parenthesis */
/***************************************************************/
% sys_put_adjust(+Integer, +Integer, +Integer, -Integer)
sys_put_adjust(I, N, _, I) :- N /\ 4 =:= 0, !.
sys_put_adjust(I, _, K, J) :- K /\ 12 =:= 12, !, J is I+3.
sys_put_adjust(I, _, _, I).
% sys_put_indent(+Stream, +Integer, +Integer, +Integer, +Integer, +Integer, +Integer, +Integer. -Integer)
sys_put_indent(_, I, N, _, _, _, _, _, I) :- N /\ 4 =:= 0, !.
sys_put_indent(_, I, _, K, _, _, _, _, I) :- K /\ 12 =:= 0, !.
sys_put_indent(_, I, _, K, _, _, _, _, J) :- K /\ 12 =:= 12, !, J is I+3.
sys_put_indent(S, I, _, _, E, L, R, F, J) :- sys_needs_paren(E, L, R, F), !,
sys_put_spaces(S, 2), J is I+3.
sys_put_indent(_, I, _, _, _, _, _, _, I).
% sys_put_lparen(+Stream, +Integer, +Integer, +Integer, +Integer, -Integer)
sys_put_lparen(S, E, L, R, F, G) :- sys_needs_paren(E, L, R, F), !,
sys_put_lparen2(S, F, G).
sys_put_lparen(_, _, _, _, F, F).
% sys_put_lparen2(+Stream, +Integer, -Integer)
sys_put_lparen2(S, F, G) :- F /\ 2 =\= 0, !,
put_code(S, 0' ),
put_code(S, 0'(),
G is (F /\ \ 6) \/ 1.
sys_put_lparen2(S, F, G) :-
put_code(S, 0'(),
G is F \/ 1.
% sys_put_rparen(+Stream, +Integer, +Integer, +Integer, +Integer)
sys_put_rparen(S, E, L, R, F) :- sys_needs_paren(E, L, R, F), !,
put_code(S, 0')).
sys_put_rparen(_, _, _, _, _).
% sys_needs_paren(+Integer, +Integer, +Integer, +Integer)
sys_needs_paren(_, L, R, _) :- L < R, !.
sys_needs_paren(0, L, L, F) :- F /\ 8 =\= 0.
/***************************************************************/
/* Format Operator */
/***************************************************************/
% sys_put_lformat(+Stream, +Integer, +Integer, +Integer)
sys_put_lformat(S, _, N, K) :- N /\ 4 =:= 0, !, sys_put_lspace(S, K).
sys_put_lformat(S, _, _, K) :- K /\ 12 =\= 8, !, sys_put_lspace(S, K).
sys_put_lformat(S, I, _, _) :- J is I-3, nl(S), sys_put_spaces(S, J).
% sys_put_rformat(+Stream, +Integer, +Integer, +Integer, +Atom, +Integer)
sys_put_rformat(S, _, N, K, _, V) :- N /\ 4 =:= 0, !, sys_put_rspace(S, K, V, _).
sys_put_rformat(S, _, _, K, _, V) :- K /\ 12 =:= 0, !, sys_put_rspace(S, K, V, _).
sys_put_rformat(S, I, _, K, _, _) :- K /\ 12 =\= 8, !, nl(S), sys_put_spaces(S, I).
sys_put_rformat(S, _, _, _, O, _) :- atom_length(O, L), I is 3-L, sys_put_spaces(S, I).
% sys_put_spaces(+Stream, +Integer)
sys_put_spaces(S, I) :- I > 0, !,
put_code(S, 0' ),
J is I-1,
sys_put_spaces(S, J).
sys_put_spaces(_, _).
% sys_put_lspace(+Stream, +Integer)
sys_put_lspace(S, K) :- K /\ 2 =:= 0, !,
put_code(S, 0' ).
sys_put_lspace(_, _).
% sys_put_rspace(+Stream, +Integer, +Integer, -Integer)
sys_put_rspace(S, K, F, G) :- K /\ 1 =:= 0, !,
put_code(S, 0' ),
G is F /\ \ 6.
sys_put_rspace(_, _, F, G) :-
G is F \/ 2.
/***************************************************************/
/* Write Operator */
/***************************************************************/
% sys_oper_side(+Integer, +Integer, -Integer)
sys_oper_side(0, F, G) :- !, G is F \/ 8.
sys_oper_side(_, F, G) :- G is F /\ \ 8.
% sys_oper_minus(+Atom, +Integer, -Integer)
sys_oper_minus('-', F, G) :- !, G is F \/ 4.
sys_oper_minus(_, F, G) :- G is F /\ \ 4.
% sys_put_nspace(+Stream, +Integer)
sys_put_nspace(S, F) :- F /\ 4 =\= 0, !,
put_code(S, 0' ).
sys_put_nspace(_, _).
% sys_oper_escape(+Atom, +Integer, -Integer)
sys_oper_escape(',', F, G) :- !, G is F \/ 1.
sys_oper_escape('|', F, G) :- !, G is F \/ 1.
sys_oper_escape(_, F, G) :- G is F /\ \ 1.
% sys_current_stream(+Triple, -Stream)
sys_current_stream(v(S,_,_), S).
% sys_current_flags(+Triple, -Integer)
sys_current_flags(v(_,F,_), F).
% sys_current_vars(+Triple, -Integer)
sys_current_vars(v(_,_,N), N).
/***************************************************************/
/* Atom Escape */
/***************************************************************/
% sys_put_oper(+Atom, +Triple, -Atom)
sys_put_oper(',', P, ',') :- !,
sys_current_stream(P, S),
put_code(S, 0',).
sys_put_oper('|', P, '|') :- !,
sys_current_stream(P, S),
put_code(S, 0'|).
sys_put_oper(X, P, Y) :-
sys_current_flags(P, G),
sys_symbol_quoted(X, G, Y),
sys_current_stream(P, S),
sys_safe_atom(S, Y).
% sys_put_symbol(+Symbol, +Pair)
sys_put_symbol(X, P) :-
sys_current_flags(P, G),
sys_symbol_quoted(X, G, Y),
sys_current_stream(P, S),
sys_safe_atom(S, Y).
% sys_symbol_quoted(+Symbol, +Integer, -Atom)
sys_symbol_quoted(X, G, H) :- reference(X), !,
sys_reference_quoted(X, G, H).
sys_symbol_quoted(X, G, X) :- G /\ 1 =:= 0, !.
sys_symbol_quoted(X, _, Y) :-
atom_codes(X, L),
\+ sys_proper_atom(L), !,
sys_escape_codes(L, R, [0'\']),
atom_codes(Y, [0'\'|R]).
sys_symbol_quoted(X, _, X).
% sys_reference_quoted(+Reference, +Integer, -Atom)
sys_reference_quoted(X, G, H) :- G /\ 1 =:= 0, !,
atom_reference(H, X).
sys_reference_quoted(X, _, H) :-
atom_reference(J, X),
atom_concat('0r', J, H).
/***************************************************************/
/* Parse Prolog */
/***************************************************************/
% sys_read_term(+Integer, +Stream, +List, -Term)
sys_read_term(C, S, O, X) :-
sys_read_opts(O, z(1200,0), z(L,F)),
sys_next_token(t(-,F,r(S,C),s([],[])), W),
sys_read_optional(Y, L, W, t(_,_,_,M)),
sys_read_results(O, M),
X = Y.
% sys_read_optional(-Term, +Integer, +Quad, -Quad)
sys_read_optional(end_of_file, _) --> sys_current_token(end_of_file), !.
sys_read_optional(X, L) --> sys_read_priority(X, L), sys_read_end('.').
% sys_read_priority(-Term, +Integer, +Quad, -Quad)
sys_read_priority(X, L) --> sys_current_token(T), sys_read_factor(T, Y, L, K),
sys_current_token(S), sys_read_secondary(S, Y, X, L, K).
% sys_read_secondary(+Term, +Term, -Term, +Integer, +Integer, +Quad, -Quad)
sys_read_secondary(atom(A), H, X, L, K) --> !,
sys_read_infix(A, H, X, L, K).
sys_read_secondary(A, H, X, L, K) --> {A = ','}, !,
sys_read_infix(A, H, X, L, K).
sys_read_secondary(A, H, X, L, K) --> {A = '|'}, !,
sys_read_infix(A, H, X, L, K).
sys_read_secondary(_, H, H, _, _) --> [].
% sys_read_infix(+Atom, +Term, -Term, +Integer, +Integer, +Quad, -Quad)
sys_read_infix(A, H, X, L, K) -->
{sys_op(A, M, R, _, _), sys_is_infix(M, D, E), L >= R}, !, sys_next_token,
({R-D < K} -> sys_sync_throw(error(syntax_error(operator_clash),_)); {true}),
{T is R-E}, sys_read_priority(Z, T),
{J =.. [A,H,Z]},
sys_current_token(S), sys_read_secondary(S, J, X, L, R).
sys_read_infix(A, H, X, L, K) -->
{sys_op(A, M, R, _, _), sys_is_postfix(M, D), L >= R}, !, sys_next_token,
({R-D < K} -> sys_sync_throw(error(syntax_error(operator_clash),_)); {true}),
{J =.. [A,H]},
sys_current_token(S), sys_read_secondary(S, J, X, L, R).
sys_read_infix(_, H, H, _, _) --> [].
% sys_lookup_var(+Atom, -Var)
sys_lookup_var(N, V) --> sys_sys_current_vars(L), {member(N=V, L)}, !,
sys_remove_anon(N).
sys_lookup_var(N, V) --> sys_sys_current_vars(L),
sys_set_vars([N=V|L]),
sys_current_anon(R),
sys_set_anon([N=V|R]).
% sys_remove_anon(+Atom)
sys_remove_anon(N) --> sys_current_anon(L), {select(N=_,L,R)}, !,
sys_set_anon(R).
sys_remove_anon(_) --> [].
% sys_current_token(-Token, +Quad, -Quad)
sys_current_token(T, t(T,F,D,M), t(T,F,D,M)).
% sys_current_options(-Integer, +Quad, -Quad)
sys_current_options(F, t(T,F,D,M), t(T,F,D,M)).
% sys_reach_code(-Code, +Quad, -Quad)
sys_reach_code(C, t(T,F,r(S,C),M), t(T,F,r(S,C),M)).
% sys_sys_current_vars(-Assoc, +Quad, -Quad)
sys_sys_current_vars(N, t(T,F,D,s(N,A)), t(T,F,D,s(N,A))).
% sys_set_vars(+Assoc, +Quad, -Quad)
sys_set_vars(M, t(T,F,D,s(_,A)), t(T,F,D,s(M,A))).
% sys_current_anon(-Assoc, +Quad, -Quad)
sys_current_anon(A, t(T,F,D,s(N,A)), t(T,F,D,s(N,A))).
% sys_set_anon(+Assoc, +Quad, -Quad)
sys_set_anon(B, t(T,F,D,s(N,_)), t(T,F,D,s(N,B))).
/***************************************************************/
/* Prefix Handling */
/***************************************************************/
% sys_read_factor(+Term, -Term, +Integer, -Integer, +Quad, -Quad)
sys_read_factor(atom(A), H, L, K) --> !,
sys_reach_code(C), sys_next_token, sys_read_atom(C, A, H, L, K).
sys_read_factor(anon, _, _, 0) --> !,
sys_next_token.
sys_read_factor(var(N), V, _, 0) --> !,
sys_lookup_var(N, V), sys_next_token.
sys_read_factor('[', X, L, K) --> !,
sys_next_token, sys_current_token(T), sys_read_list(T, X, L, K).
sys_read_factor('{', X, L, K) --> !,
sys_next_token, sys_current_token(T), sys_read_set(T, X, L, K).
sys_read_factor('(', T, _, 0) --> !,
sys_next_token, sys_read_priority(T, 1200), sys_read_end(')'), sys_next_token.
sys_read_factor(number(X), X, _, 0) --> !,
sys_next_token.
sys_read_factor(radix(X, _), X, _, 0) --> sys_current_options(G), {G /\ 16 =:= 0}, !,
sys_next_token.
sys_read_factor(radix(X,B), '$RDX'(X,B), _, 0) --> !,
sys_next_token.
sys_read_factor(reference(X), X, _, 0) --> !,
sys_next_token.
sys_read_factor(codes(X), X, _, 0) --> sys_current_options(G), {G /\ 16 =:= 0}, !,
sys_next_token.
sys_read_factor(codes(X), '$STR'(H), _, 0) --> !,
{atom_codes(H, X)}, sys_next_token.
sys_read_factor(code(X), X, _, 0) --> sys_current_options(G), {G /\ 16 =:= 0}, !,
sys_next_token.
sys_read_factor(code(X), '$CHR'(X), _, 0) --> !,
sys_next_token.
sys_read_factor(_, _, _, _) -->
sys_sync_throw(error(syntax_error(cannot_start_term),_)).
% sys_read_atom(+Integer, +Atom, -Term, +Integer, -Integer, +Quad, -Quad)
sys_read_atom(0'(, A, H, _, 0) --> !,
sys_next_token, sys_read_priority(X, 999),
sys_current_token(T), sys_read_args(T, L),
sys_read_end(')'), {H =.. [A,X|L]}, sys_next_token.
sys_read_atom(C, '-', H, L, K) --> {sys_code_class(C, is_digit)}, !,
sys_current_token(T), sys_read_factor(T, N, L, K), {sys_make_negative(N, H)}.
sys_read_atom(_, A, H, L, K) --> {sys_op(A, M, R, _, _), sys_is_prefix(M, E)}, !,
sys_current_token(T), sys_read_prefix(T, H, A, L, R, E, K).
sys_read_atom(_, X, X, _, 0) --> [].
% sys_read_prefix(+Term, -Term, +Term, +Integer, +Integer, +Integer, -Integer, +Quad, -Quad)
sys_read_prefix(',', A, A, _, _, _, 0) --> !.
sys_read_prefix('|', A, A, _, _, _, 0) --> !.
sys_read_prefix(')', A, A, _, _, _, 0) --> !.
sys_read_prefix(']', A, A, _, _, _, 0) --> !.
sys_read_prefix('}', A, A, _, _, _, 0) --> !.
sys_read_prefix('.', A, A, _, _, _, 0) --> !.
sys_read_prefix(_, H, A, L, R, E, R) -->
({L < R} -> sys_sync_throw(error(syntax_error(operator_clash),_)); {true}),
{T is R-E}, sys_read_priority(Z, T), {H =.. [A,Z]}.
/***************************************************************/
/* Special Forms */
/***************************************************************/
% sys_read_args(+Term, -List, +Quad, -Quad)
sys_read_args(',', [X|L]) --> !,
sys_next_token, sys_read_priority(X, 999),
sys_current_token(T), sys_read_args(T, L).
sys_read_args(_, []) --> [].
% sys_read_list(+Term, -List, +Integer, -Integer, +Quad, -Quad)
sys_read_list(']', H, L, K) --> !,
sys_reach_code(C), sys_next_token, sys_read_atom(C, [], H, L, K).
sys_read_list(_, [X|L], _, 0) --> sys_read_priority(X, 999),
sys_current_token(T), sys_read_rest(T, L),
sys_read_end(']'), sys_next_token.
% sys_read_rest(+Term, -List, +Quad, -Quad)
sys_read_rest(',', [X|L]) --> !,
sys_next_token, sys_read_priority(X, 999),
sys_current_token(T), sys_read_rest(T, L).
sys_read_rest('|', X) --> !,
sys_next_token, sys_read_priority(X, 999).
sys_read_rest(_, []) --> [].
% sys_read_set(+Term, -Compound, +Integer, -Integer, +Quad, -Quad)
sys_read_set('}', H, L, K) --> !,
sys_reach_code(C), sys_next_token, sys_read_atom(C, {}, H, L, K).
sys_read_set(_, {X}, _, 0) --> sys_read_priority(X, 1200),
sys_read_end('}'), sys_next_token.
% sys_read_end(+Atom, +Quad, -Quad)
sys_read_end(A) --> sys_current_token(A), !.
sys_read_end('.') --> !, sys_sync_throw(error(syntax_error(end_of_clause_expected),_)).
sys_read_end(')') --> !, sys_sync_throw(error(syntax_error(parenthesis_balance),_)).
sys_read_end('}') --> !, sys_sync_throw(error(syntax_error(brace_balance),_)).
sys_read_end(']') --> sys_sync_throw(error(syntax_error(bracket_balance),_)).