Prolog "fancy"
/**
* 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, '<span~w>', [A])),
put_atom(S, X),
(D = [] -> true;
tag(S, '</span>')).
% sys_fancy_line(+Stream, +List)
sys_fancy_line(S, C) :-
sys_fancy_style(C, D),
(D = [] -> put_atom(S, '\n');
tag(S, '</div>'),
atom_join(D, A),
tag_format(S, '<div~w>', [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, '<div class="error">'),
write(Stream, '🚨 '),
put_message(Stream, exception(error)),
put_message(Stream, Message),
tag(Stream, '</div>'), flush_output(Stream),
sys_fancy_trace(Trace, Stream, 'error').
sys_fancy_problem(warning(Message, Trace), Stream) :- !,
tag(Stream, '<div class="warning">'),
write(Stream, '⚠️ '),
put_message(Stream, exception(warning)),
put_message(Stream, Message),
tag(Stream, '</div>'), 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, '<div class="~a">', [Class]),
put_message(Stream, exception(context, Trace)),
tag(Stream, '</div>'), flush_output(Stream).
sys_fancy_trace([Frame|Trace], Stream, Class) :- !,
tag_format(Stream, '<div class="~a">', [Class]),
sys_print_frame(Frame, Stream),
tag(Stream, '</div>'), flush_output(Stream),
sys_fancy_trace(Trace, Stream, Class).
sys_fancy_trace([], _, _) :- !.
sys_fancy_trace(Trace, Stream, Class) :-
tag_format(Stream, '<div class="~a">', [Class]),
put_message(Stream, exception(context, Trace)),
tag(Stream, '</div>'), 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.').