Prolog "indexer"

Admin User, erstellt 13. Jan. 2024
         
/**
* 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
* Dogelog is a deposited trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(aggregate)).
:- ensure_loaded(library(sequence)).
:- ensure_loaded(library(misc/markup)).
% index_pred(+Atom, +Integer, +Atom)
:- dynamic index_pred/3.
/*******************************************************************/
/* Build Index */
/*******************************************************************/
/**
* build_file(A, T):
* The predicate succeeds in building a predicate index for
* the Prolog text A with tag T.
*/
% build_file(+Atom, +Atom)
build_file(InName, Tag) :-
setup_once_cleanup(
open(InName, read, InStream),
sys_build_stream(InStream, Tag),
close(InStream)).
% sys_build_stream(+Stream, +Atom)
sys_build_stream(InStream, Tag) :-
repeat,
read(InStream, Term),
(Term = end_of_file -> !;
expand_term(Term, Term2),
sys_build_static(Term2, Tag),
fail).
% sys_build_static(+Term, +Atom)
sys_build_static(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_build_static((:- Goal), Tag) :- !,
sys_build_directive(Goal, Tag).
sys_build_static((Head :- _), Tag) :- !,
sys_build_head(Head, Tag).
sys_build_static(Head, Tag) :-
sys_build_head(Head, Tag).
% sys_build_directive(+Term, +Atom)
sys_build_directive(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_build_directive(dynamic(I), Tag) :- !,
sys_build_indicator(I, Tag).
sys_build_directive(multifile(I), Tag) :- !,
sys_build_indicator(I, Tag).
sys_build_directive(Goal, _) :- callable(Goal), !.
sys_build_directive(Goal, _) :-
throw(error(type_error(callable,Goal),_)).
% sys_build_head(+Term, +Atom)
sys_build_head(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_build_head(Head, Tag) :- callable(Head), !,
functor(Head, F, N),
sys_build_functor(F, N, Tag).
sys_build_head(Head, _) :-
throw(error(type_error(callable,Head),_)).
% sys_build_indicator(+Term, +Atom)
sys_build_indicator(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_build_indicator(F/N, Tag) :- !,
sys_build_functor(F, N, Tag).
sys_build_indicator(I, _) :-
throw(error(type_error(predicate_indicator,I),_)).
% sys_build_functor(+Atom, +Integer, +Atom)
sys_build_functor(F, _, _) :-
sys_build_stop(S),
sub_atom(F, 0, _, _, S), !.
sys_build_functor(F, N, Tag) :-
index_pred(F, N, Tag), !.
sys_build_functor(F, N, Tag) :-
assertz(index_pred(F, N, Tag)).
% sys_build_stop(-Atom)
sys_build_stop('sys_').
sys_build_stop('ir_').
sys_build_stop('os_').
sys_build_stop('kb_').
sys_build_stop('dg_').
/*******************************************************************/
/* Output TSV */
/*******************************************************************/
/**
* output_tsv(A):
* The predicate succeeds in writing the index to the
* tab separated values file A. An already existing file A
* is silently overwritten.
*/
% output_tsv(+Atom)
output_tsv(OutName) :-
setup_once_cleanup(
open(OutName, write, OutStream),
sys_output_tsv(OutStream),
close(OutStream)).
% sys_output_tsv(+Stream)
sys_output_tsv(S) :-
put_atom(S, 'Indicator'),
put_code(S, 0'\t),
put_atom(S, 'Location'),
nl(S),
setof(Tag, index_pred(F, N, Tag), List),
write(S, F/N),
put_code(S, 0'\t),
sys_output_list(List, S),
nl(S),
fail.
sys_output_tsv(_).
/*******************************************************************/
/* Output HTML */
/*******************************************************************/
/**
* output_html(A):
* The predicate succeeds in writing the index to the
* HTML file A. An already existing file A
* is silently overwritten.
*/
% output_html(+Atom)
output_html(OutName) :-
statistics(wall, Time),
setup_once_cleanup(
(open(OutName, write, OutStream), dom_output_new(OutStream, DomWriter)),
sys_output_html(DomWriter, Time),
close(DomWriter)).
% sys_output_html(+Stream, +Integer)
sys_output_html(S, Time) :-
sys_html_header(S, v(Time,'Predicates','Predicates Index')),
tag(S, '<table class="rowtable">'),
tag(S, '<tr class="headrow">'),
tag(S, '<th style="width: 12em">'), put_atom(S, 'Indicator'), tag(S, '</th>'),
tag(S, '<th style="width: 24em">'), put_atom(S, 'Location'), tag(S, '</th>'),
tag(S, '</tr>'),
call_nth(setof(Tag, index_pred(F, N, Tag), List), Row),
(Row mod 2 =:= 1 -> tag(S, '<tr class="oddrow">'); tag(S, '<tr class="normrow">')),
tag(S, '<td>'), write(S, F/N), tag(S, '</td>'),
tag(S, '<td>'), sys_output_list(List, S), tag(S, '</td>'),
tag(S, '</tr>'),
fail.
sys_output_html(S) :-
tag(S, '</table>'),
sys_html_footer(S).
/*******************************************************************/
/* Output Helper */
/*******************************************************************/
% sys_output_list(+List, +Stream)
sys_output_list([Head|Tail], S) :-
write(S, Head),
sys_output_rest(Tail, S).
% sys_output_rest(+List, +Stream)
sys_output_rest([Head|Tail], S) :-
put_atom(S, ', '),
write(S, Head),
sys_output_rest(Tail, S).
sys_output_rest([], _).