/** * 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(hiord)). :- ensure_loaded(library(cyclic)). :- ensure_loaded(library(text/charsio)). :- ensure_loaded(library(text/markup)). /** * print_term(T, O): * print_term(S, T, O): * The predicate succeeds. As a side effect the term T is written with * colorize(true) and the options O. The ternary predicate allows * specifying an output stream S. The colorize(true) option is not used * if the stream has flag MASK_DST_COLR missing. */ % print_term(+Term, +List) print_term(Term, Opts) :- current_output(Stream), print_term(Stream, Term, Opts). % print_term(+Stream, +Term, +List) print_term(Stream, Term, Opts) :- ir_object_current(Stream, 'flags', Flags), Flags /\ 4 =\= 0, !, write_term(Stream, Term, [colorize(true)|Opts]). print_term(Stream, Term, Opts) :- write_term(Stream, Term, Opts). /** * display_term(X, O): * display_term(S, X, O): * The predicate succeeds. As a side effect the term X is printed as * T, E1, .., En where T is a skeleton and L = [E1, .., En] is a list * of equations, so that L applied to T gives identical X. The binary * predicate allows specifying an output stream S. The cycle breaking * is not used if the stream has flag MASK_DST_CYCL missing. */ % display_term(+Term, +List) display_term(Term, Opts) :- current_output(Stream), display_term(Stream, Term, Opts). % display_term(+Stream, +Term, +List) display_term(Stream, Term, Opts) :- ir_object_current(Stream, 'flags', Flags), Flags /\ 8 =\= 0, !, acyclic_factorized([Term], [MinTerm]), sys_display_list(MinTerm, Conj), term_singletons(Conj, A), print_term(Stream, Conj, [anonymous(A)|Opts]). display_term(Stream, Term, Opts) :- term_singletons(Term, A), print_term(Stream, Term, [anonymous(A)|Opts]). % sys_display_list(+List, -Goal) sys_display_list([], true). sys_display_list([X|L], Y) :- sys_display_rest(L, X, Y). % sys_display_rest(+List, +Goal, -Goal) sys_display_rest([], X, X). sys_display_rest([Y|L], X, (X, T)) :- sys_display_rest(L, Y, T). /*************************************************************/ /* Fancy Routine */ /*************************************************************/ /** * fancy_atom(A, B, P): * The predicate succeeds in B with the colorized A * useing the paragraph class P to color lines. */ % fancy_atom(+Atom, -Atom, +List) fancy_atom(Plain, Rich, C) :- open_input_atom_stream(Plain, InStream), open_output_atom_stream(OutStream), dom_output_new(OutStream, OutStream2), sys_fancy_stream(InStream, OutStream2, C), flush_output(OutStream2), sys_output_atom_stream_get(OutStream, Rich). % sys_fancy_stream(+Stream, +Stream, +Atom) sys_fancy_stream(InStream, OutStream, P) :- get_code(InStream, C), sys_get_any(C, H, InStream, D), sys_fancy_rest(H, D, InStream, OutStream, P). % sys_fancy_rest(+Term, +Integer, +Stream, +Stream, +Atom) sys_fancy_rest(end_of_file, _, _, _, _) :- !. sys_fancy_rest(T, C, InStream, OutStream, P) :- sys_fancy_put(T, OutStream, P), sys_get_any(C, H, InStream, D), sys_fancy_rest(H, D, InStream, OutStream, P). % sys_get_any(+Integer, -Term, +Stream, -Integer) sys_get_any(0'%, line([0'%|L]), S, D) :- !, get_code(S, C), sys_get_line(C, L, S, D). sys_get_any(0'/, block([0'*|L]), S, D) :- peek_code(S, 0'*), !, get_code(S, _), get_code(S, C), sys_get_block(C, L, S, D). sys_get_any(C, filler([C|L]), S, D) :- sys_is_white(C), !, get_code(S, H), sys_get_filler(H, L, S, D). sys_get_any(C, A, S, D) :- sys_get_token(A, S-C, _-D). /*************************************************************/ /* Comment Tokens */ /*************************************************************/ % sys_get_line(+Integer, -List, +Stream, -Integer) sys_get_line(0'\n, [], _, 0'\n) :- !. sys_get_line(0'\r, [], _, 0'\r) :- !. sys_get_line(-1, [], _, -1) :- !. sys_get_line(C, [C|L], S, D) :- get_code(S, H), sys_get_line(H, L, S, D). % sys_get_block(+Integer, -List, +Stream, -Integer) sys_get_block(0'*, [0'*], S, C) :- peek_code(S, 0'/), !, get_code(S, _), get_code(S, C). sys_get_block(-1, [-1], _, -1) :- !. sys_get_block(C, [C|L], S, D) :- get_code(S, H), sys_get_block(H, L, S, D). % sys_get_filler(+Integer, -List, +Stream, -Integer) sys_get_filler(C, [C|L], S, D) :- sys_is_white(C), !, get_code(S, H), sys_get_filler(H, L, S, D). sys_get_filler(C, [], _, C). % sys_is_white(+Code) sys_is_white(C) :- code_category(C, T), 12 =< T, T =< 16. /*************************************************************/ /* Fancy Output */ /*************************************************************/ % sys_fancy_put(+Term, +Stream, +Atom) /* comments */ sys_fancy_put(line(L), S, _) :- !, atom_codes(A, L), sys_fancy_span(A, S, [class('cm')]). sys_fancy_put(block(L), S, P) :- !, sys_fancy_quote(L, 0'/, S, [class('cm')], P). /* constants */ sys_fancy_put(single(L), S, P) :- !, sys_fancy_quote(L, 0'\', S, [class('cs')], P). sys_fancy_put(codes(L), S, P) :- !, sys_fancy_quote(L, 0'\", S, [class('cs')], P). sys_fancy_put(decimal(L), S, _) :- !, atom_codes(A, L), sys_fancy_span(A, S, [class('cs')]). sys_fancy_put(radix(L, B), S, _) :- !, (B = 2 -> atom_codes(A, [0'0, 0'b|L]); B = 8 -> atom_codes(A, [0'0, 0'o|L]); B = 16 -> atom_codes(A, [0'0, 0'x|L]); fail), sys_fancy_span(A, S, [class('cs')]). sys_fancy_put(code(L), S, _) :- !, sys_fancy_code(L, S). sys_fancy_put(exotic(L), S, _) :- !, atom_codes(A, [0'0, 0'r|L]), sys_fancy_span(A, S, [class('cs')]). /* variables */ sys_fancy_put(var(A), S, _) :- !, sys_fancy_span(A, S, [class('vr')]). sys_fancy_put(anon, S, _) :- !, sys_fancy_span('_', S, [class('vr')]). sys_fancy_put(back(L), S, P) :- !, sys_fancy_quote(L, 0'\`, S, [class('vr')], P). /* otherwise */ sys_fancy_put(filler(L), S, P) :- !, sys_fancy_codes(S, L, [], P). sys_fancy_put(atom(A), S, _) :- !, put_atom(S, A). sys_fancy_put(A, S, _) :- put_atom(S, A). /*************************************************************/ /* Fancy String Output */ /*************************************************************/ % sys_fancy_code(+List, +Stream) sys_fancy_code(L, S) :- select(-1, L, R), !, atom_codes(A, [0'0, 0'\'|R]), sys_fancy_span(A, S, [class('cs')]). sys_fancy_code(L, S) :- atom_codes(A, [0'0, 0'\'|L]), sys_fancy_span(A, S, [class('cs')]). % sys_fancy_quote(+List, +Integer, +Stream, +List, +List) sys_fancy_quote(L, Q, S, C, P) :- select(-1, L, R), !, sys_fancy_codes(S, [Q|R], C, P). sys_fancy_quote(L, Q, S, C, P) :- append(L, [Q], R), sys_fancy_codes(S, [Q|R], C, P). % sys_fancy_codes(+Stream, +List, +List, +List) sys_fancy_codes(S, L, C, P) :- sys_split_lines(H, L, []), sys_fancy_list(S, H, C, P). /*************************************************************/ /* Fancy Lines Output */ /*************************************************************/ % sys_fancy_list(+Stream, +List, +List, +List) sys_fancy_list(S, [X|R], C, P) :- sys_fancy_span(X, S, C), sys_fancy_rest(R, S, C, P). % sys_fancy_rest(+List, +Stream, +List, +List) sys_fancy_rest([X|L], S, C, P) :- sys_fancy_line(S, P), sys_fancy_span(X, S, C), sys_fancy_rest(L, S, C, P). sys_fancy_rest([], _, _, _). % sys_fancy_span(+Atom, +Stream, +List) sys_fancy_span('', _, _) :- !. sys_fancy_span(X, S, C) :- sys_fancy_style(C, D), (D = [] -> true; atom_join(D, A), tag_format(S, '', [A])), put_atom(S, X), (D = [] -> true; tag(S, '')). % sys_fancy_line(+Stream, +List) sys_fancy_line(S, C) :- sys_fancy_style(C, D), (D = [] -> put_atom(S, '\n'); tag(S, ''), atom_join(D, A), tag_format(S, '', [A])). /*************************************************************/ /* Style Lists */ /*************************************************************/ % sys_fancy_style(+List, -List) sys_fancy_style(V, _) :- var(V), throw(error(instantiation_error,_)). sys_fancy_style([X|L], [Y|R]) :- !, sys_fancy_property(X, Y), sys_fancy_style(L, R). sys_fancy_style([], []) :- !. sys_fancy_style(L, _) :- throw(error(type_error(list,L),_)). % sys_fancy_property(+Term, -Atom) sys_fancy_property(V, _) :- var(V), throw(error(instantiation_error,_)). sys_fancy_property(X, Z) :- X =.. [F,Y], !, format_atom(' ~w="~a"', [F,Y], Z). sys_fancy_property(S, _) :- throw(error(domain_error(xml_attr,S),_)). /*************************************************************/ /* Line Splitter */ /*************************************************************/ /** * sys_split_lines(L, I, O): * The predicate succeeds in L with the lines * of the input I and output O codes. */ % sys_split_lines(-List, +List, -List) sys_split_lines([A|L]) --> sys_split_line(X), {atom_codes(A,X)}, sys_split_more(L). % sys_split_more(-List, +List, -List) sys_split_more([A|L]) --> sys_convert_sep, !, sys_split_line(X), {atom_codes(A,X)}, sys_split_more(L). sys_split_more([]) --> []. % sys_split_line(-List, +List, -List) sys_split_line([X|L]) --> \+ sys_convert_sep, [X], !, sys_split_line(L). sys_split_line([]) --> []. /*************************************************************/ /* Fancy Error */ /*************************************************************/ % sys_fancy_problem(+Error, +Stream) sys_fancy_problem(Error, Stream) :- var(Error), !, put_message(Stream, exception(unknown, Error)), nl(Stream). sys_fancy_problem(cause(Primary, Secondary), Stream) :- !, sys_fancy_problem(Primary, Stream), sys_fancy_problem(Secondary, Stream). sys_fancy_problem(error(Message, Trace), Stream) :- !, tag(Stream, '
'), write(Stream, '🚨 '), put_message(Stream, exception(error)), put_message(Stream, Message), tag(Stream, '
'), flush_output(Stream), sys_fancy_trace(Trace, Stream, 'error'). sys_fancy_problem(warning(Message, Trace), Stream) :- !, tag(Stream, '
'), write(Stream, '⚠️ '), put_message(Stream, exception(warning)), put_message(Stream, Message), tag(Stream, '
'), flush_output(Stream), sys_fancy_trace(Trace, Stream, 'warning'). sys_fancy_problem(Error, Stream) :- put_message(Stream, exception(unknown, Error)), nl(Stream). % sys_fancy_trace(+List, +Stream, +Atom) sys_fancy_trace(Trace, Stream, Class) :- var(Trace), !, tag_format(Stream, '
', [Class]), put_message(Stream, exception(context, Trace)), tag(Stream, '
'), flush_output(Stream). sys_fancy_trace([Frame|Trace], Stream, Class) :- !, tag_format(Stream, '
', [Class]), sys_print_frame(Frame, Stream), tag(Stream, '
'), flush_output(Stream), sys_fancy_trace(Trace, Stream, Class). sys_fancy_trace([], _, _) :- !. sys_fancy_trace(Trace, Stream, Class) :- tag_format(Stream, '
', [Class]), put_message(Stream, exception(context, Trace)), tag(Stream, '
'), flush_output(Stream). /****************************************************************/ /* Error Texts */ /****************************************************************/ % strings(+Atom, +Atom, -Atom) :- multifile(strings/3). strings('domain_error.xml_attr', de, 'XML-Attribut erwartet, gefunden ~q.'). strings('domain_error.xml_attr', '', 'XML-Attribute expected, found ~q.').