View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (C): 2020, SWI-Prolog Solutions b.v.
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(examples,
   31          [ ex_xref/3,                  % Id,Code,XRef
   32            index_examples/0,
   33            examples//2,
   34            reindex_examples/0
   35          ]).   36:- use_module(library(http/html_write)).   37:- use_module(library(filesex)).   38:- use_module(library(dcg/high_order)).   39:- use_module(library(http/html_head)).   40:- use_module(library(apply)).   41:- use_module(library(lists)).   42:- use_module(library(occurs)).   43:- use_module(library(ordsets)).   44:- use_module(library(pairs)).   45:- use_module(library(prolog_code)).   46:- use_module(library(solution_sequences)).   47:- use_module(library(git)).   48:- use_module(library(http/http_dispatch)).   49:- use_module(library(option)).   50:- use_module(library(http/http_json)).   51:- use_module(library(dcg/basics)).   52
   53:- use_module(wiki).   54:- use_module(messages).   55
   56user:file_search_path(examples, examples).
   57
   58:- html_resource(pldoc_examples,
   59		 [ ordered(true),
   60                   requires([ jquery,
   61                              js('examples.js')
   62			    ]),
   63		   virtual(true)
   64		 ]).   65:- html_resource(css('examples.css'), []).   66
   67:- multifile
   68    prolog:doc_object_footer//2.   69
   70prolog:doc_object_footer(Objs, Options) -->
   71    examples(Objs, Options).
 examples(+Objs, +Options)
Include examples for the predicate PI.
   77examples(Objs, _Options) -->
   78    { index_examples,
   79      findall(Ex-How, (member(Obj,Objs),example(Obj, Ex, How)), Refs0),
   80      Refs0 \== [],
   81      !,
   82      keysort(Refs0, Refs),
   83      group_pairs_by_key(Refs, Grouped0),
   84      map_list_to_pairs(ex_score, Grouped0, Scored),
   85      sort(1, >=, Scored, Sorted),
   86      pairs_values(Sorted, Grouped)
   87    },
   88    html_requires(pldoc_examples),
   89    html_requires(css('examples.css')),
   90    html(div(class('ex-list'),
   91             [ h4('Examples')
   92             | \ex_list(Grouped)
   93             ])).
   94examples(_,_) -->
   95    [].
   96
   97ex_list([One]) -->
   98    { One = _File-How,
   99      memberchk(file, How)
  100    },
  101    !,
  102    ex_html(['ex-current'], One).
  103ex_list(ExList) -->
  104    !,
  105    sequence(ex_html([]), ExList).
  106
  107ex_html(More, File-How) -->
  108    { best_flag(How, Flag),
  109      (   Flag == file
  110      ->  Classes = ['ex-current'|More]
  111      ;   Classes = More
  112      )
  113    },
  114    html(div(class([ex|Classes]),
  115             [ div(class('ex-header'),
  116                   [ \ex_flag(Flag),
  117                     \ex_title(File, How),
  118                     \ex_authors(File)
  119                   ]),
  120               div(class('ex-content'),
  121                   \ex_content(File))
  122             ])).
  123
  124ex_title(File, _) -->
  125    { ex_prop(File, title, Title) }, !,
  126    html(span(class(title), Title)).
  127ex_title(File, _) -->
  128    { file_title(File, Title)
  129    },
  130    !,
  131    html(span(class(title), Title)).
  132ex_title(_, _) -->
  133    [].
  134
  135ex_authors(File) -->
  136    { ex_prop(File, author, Authors) }, !,
  137    sequence(ex_author, ", ", Authors).
  138ex_authors(_) -->
  139    [].
  140
  141ex_author(Author) -->
  142    html(span(class(author), Author)).
  143
  144ex_flag(Flag) -->
  145    { label(Flag, Title) },
  146    html(span([ class(['ex-flag', Flag]),
  147                title(Title)
  148              ], '')).
  149
  150ex_content(File) -->
  151    { ex_file_dom(File, DOM) },
  152    html(DOM).
 example(+PI, -File, -RefType) is nondet
Get an example.
  158example(PI, File, How) :-
  159    example2(PI, File, How0),
  160    (   How = How0
  161    ;   PI = Name/Arity,
  162        file_base_name(File, Base),
  163        (   Name == Base
  164        ->  How = file
  165        ;   atom_concat(Name, Arity, Base)
  166        ->  How = file
  167        )
  168    ).
  169
  170example2(PI, File, query) :-
  171    ex_code(File, _, _, XRef),
  172    memberchk(PI, XRef.get(query)).
  173example2(PI, File, called) :-
  174    ex_code(File, _, _, XRef),
  175    memberchk(PI, XRef.get(called)).
  176example2(PI, File, reference) :-
  177    ex_prop(File, reference, PI).
  178example2(PI, File, titleref) :-
  179    ex_prop(File, titleref, PI).
  180
  181ex_score(_File-Flags, Score) :-
  182    maplist(rank, Flags, Scores),
  183    sum_list(Scores, Score).
  184
  185best_flag(Flags, Flag) :-
  186    map_list_to_pairs(rank, Flags, Ranked),
  187    sort(1, >, Ranked, [_Rank-Flag|_]).
  188
  189rank(file,     1000).
  190rank(titleref,  100).
  191rank(query,      30).
  192rank(called,     20).
  193rank(reference,   5).
  194
  195label(file,      'Example file for predicate').
  196label(titleref,  'Mentioned in the title').
  197label(query,     'Used in a query').
  198label(called,    'Called in example').
  199label(reference, 'Mentioned in comment').
  200
  201file_title(File, Title) :-
  202    file_base_name(File, Base),
  203    atom_codes(Base, Codes),
  204    (   phrase((string(Name),integer(Arity)), Codes)
  205    ->  documented(Name/Arity),
  206        format(string(Title), 'Examples for ~s/~d', [Name, Arity])
  207    ;   documented(Base/A1),
  208        documented(Base/A2),
  209        A1 \== A2
  210    ->  format(string(Title), 'Examples for ~s/N',  [Base])
  211    ).
  212
  213:- multifile
  214    prolog:doc_object_summary/4.  215
  216documented(PI) :-
  217    prolog:doc_object_summary(PI, _Category, _Section, _Summary).
  218
  219
  220		 /*******************************
  221		 *              DB		*
  222		 *******************************/
 ex_code(File, N, Size, XRef)
  226:- dynamic
  227    ex_code/4,
  228    ex_prop/3,
  229    ex_done/1,
  230    ex_checked/1.  231
  232
  233		 /*******************************
  234		 *            INDEX		*
  235		 *******************************/
 index_examples is det
 index_examples(+Backlog) is det
 reindex_examples is det
Update the example index.
To be done
- We only have to reprocess modified or new examples.
  245index_examples :-
  246    index_examples(60).
  247
  248index_examples(Backlog) :-
  249    index_up_to_data(Backlog), !.
  250index_examples(Backlog) :-
  251    with_mutex(index_examples, index_examples2(Backlog)).
  252
  253index_examples2(Backlog) :-
  254    index_up_to_data(Backlog), !.
  255index_examples2(_) :-
  256    transaction(reindex_examples).
  257
  258reindex_examples :-
  259    clean_examples,
  260    do_index_examples.
  261
  262do_index_examples :-
  263    forall(ex_file(File),
  264           index_example(File)),
  265    get_time(Now),
  266    assertz(ex_done(Now)),
  267    assertz(ex_checked(Now)).
  268
  269index_up_to_data(Backlog) :-
  270    ex_done(Indexed),
  271    retract(ex_checked(Last)),
  272    get_time(Now),
  273    asserta(ex_checked(Now)),
  274    Now-Last > Backlog,
  275    (   ex_directory(Dir),
  276        time_file(Dir, Modified),
  277        Modified > Indexed
  278    ->  !, fail
  279    ;   true
  280    ).
  281
  282clean_examples :-
  283    retractall(ex_done(_)),
  284    retractall(ex_code(_,_,_,_)),
  285    retractall(ex_prop(_,_,_)).
  286
  287index_example(File) :-
  288    ex_file_dom(File, DOM),
  289    index_code(File, DOM),
  290    (   dom_property(DOM, Prop, Value),
  291        assertz(ex_prop(File, Prop, Value)),
  292        fail
  293    ;   true
  294    ).
  295
  296index_code(File, DOM) :-
  297    (   call_nth(( dom_code(DOM, Code, _Attrs),
  298                   code_xref(Code, XRef)
  299                 ), N),
  300        string_length(Code, Len),
  301        assertz(ex_code(File, N, Len, XRef)),
  302        fail
  303    ;   true
  304    ).
 ex_xref(Id, Code, XRef) is nondet
  308ex_xref(File, Code, XRef) :-
  309    ex_file(File),
  310    ex_file_dom(File, DOM),
  311    dom_code(DOM, Code, _Attrs),
  312    code_xref(Code, XRef).
 ex_repo(-Dir) is nondet
True when Dir is a toplevel example directory
  318ex_repo(Dir) :-
  319    absolute_file_name(examples(.), Dir,
  320                       [ file_type(directory),
  321                         access(read),
  322                         solutions(all)
  323                       ]).
 ex_file(-File) is nondet
True when File is the name of an example file
  330ex_file(File) :-
  331    ex_repo(ExDir),
  332    directory_member(ExDir, Path,
  333                     [ recursive(true),
  334                       extensions([md]),
  335                       access(read)
  336                     ]),
  337    directory_file_path(ExDir, FileEx, Path),
  338    file_name_extension(File, md, FileEx).
  339
  340ex_directory(Path) :-
  341    ex_repo(ExDir),
  342    (   Path = ExDir
  343    ;   directory_member(ExDir, Path,
  344                         [ recursive(true),
  345                           file_type(directory)
  346                         ])
  347    ).
 ex_file_dom(+File, -DOM) is det
  352ex_file_dom(File, DOM) :-
  353    absolute_file_name(examples(File), Path,
  354                       [ access(read),
  355                         extensions([md])
  356                       ]),
  357    wiki_file_to_dom(Path, DOM).
 dom_code(+DOM, -Code, -Attrs) is nondet
  363dom_code(DOM, Code, Attrs) :-
  364    sub_term(pre(Attrs, Code), DOM).
 dom_property(+DOM, ?Prop, -ValueDOM) is nondet
  368dom_property(DOM, Attr, Val) :-
  369    (   sub_term(H, DOM),
  370        title(H, TitleDOM0)
  371    ->  clean_title(TitleDOM0, TitleDOM),
  372        (   Attr+Val = title+TitleDOM
  373        ;   dom_references(TitleDOM0, Refs),
  374            Attr = titleref,
  375            member(Val, Refs)
  376        )
  377    ).
  378dom_property(DOM, author, AuthorDOM) :-
  379    (   sub_term(\tag(author, AuthorDOM), DOM)
  380    ->  true
  381    ).
  382dom_property(DOM, reference, Ref) :-
  383    dom_references(DOM, Refs),
  384    member(Ref, Refs).
  385
  386title(h1(_, TitleDOM), TitleDOM).
  387title(h1(   TitleDOM), TitleDOM).
  388
  389clean_title(\predref(PI), \nopredref(PI)) :-
  390    !.
  391clean_title(T0, T) :-
  392    compound(T0),
  393    !,
  394    compound_name_arity(T0, Name, Arity),
  395    compound_name_arity(T, Name, Arity),
  396    clean_title(1, Arity, T0, T).
  397clean_title(T,T).
  398
  399clean_title(I, Arity, T0, T) :-
  400    I =< Arity,
  401    !,
  402    I2 is I+1,
  403    arg(I, T0, A0),
  404    arg(I, T, A),
  405    clean_title(A0, A),
  406    clean_title(I2, Arity, T0, T).
  407clean_title(_, _, _, _).
  408
  409dom_references(DOM, Refs) :-
  410    findall(Ref, dom_reference(DOM,Ref), Refs0),
  411    sort(Refs0, Refs).
  412
  413dom_reference(DOM, Ref) :-
  414    sub_term(Sub, DOM),
  415    el_reference(Sub, Ref).
  416
  417el_reference(\predref(PI), PI).
  418el_reference(\file(Text, _Path), Lib) :-
  419    Lib = library(_),
  420    catch(term_string(Lib, Text),
  421          error(_,_), fail).
 code_xref(+Code, -XRef) is det
Cross-reference a code fragment
  427code_xref(Code, XRef) :-
  428    setup_call_cleanup(
  429        open_string(Code, In),
  430        read_terms(In, Terms),
  431        close(In)),
  432    xref_terms(Terms, XRef).
  433
  434read_terms(In, Terms) :-
  435    stream_property(In, position(Pos0)),
  436    catch(read_term(In, Term, []), E, true),
  437    (   Term == end_of_file
  438    ->  Terms = []
  439    ;   var(E)
  440    ->  Terms = [Term|More],
  441        read_terms(In, More)
  442    ;   set_stream_position(In, Pos0),
  443        skip(In, 0'\n),
  444        read_terms(In, Terms)
  445    ).
  446
  447		 /*******************************
  448		 *	        XREF		*
  449		 *******************************/
 xref_terms(+Terms, -XRef:dict) is det
Cross-reference a list of terms, returning a dict that contains:

Note that XRef.required is XRef.called \ built-in \XRef.defined.

  462xref_terms(Terms, Result) :-
  463    phrase(xref_terms(Terms), Pairs),
  464    keysort(Pairs, Sorted),
  465    group_pairs_by_key(Sorted, Grouped),
  466    maplist(value_to_set, Grouped, GroupedSets),
  467    dict_pairs(Result0, xref, GroupedSets),
  468    (   exclude(built_in, Result0.get(called), Called),
  469        ord_subtract(Called, Result0.get(defined), Required),
  470        Required \== []
  471    ->  Result = Result0.put(required, Required)
  472    ;   Result = Result0
  473    ).
  474
  475value_to_set(error-List, error-Set) :- !,
  476    variant_set(List, Set).
  477value_to_set(Key-HeadList, Key-PISet) :-
  478    maplist(pi_head, PIList, HeadList),
  479    sort(PIList, PISet).
  480
  481variant_set(List, Set) :-
  482    list_to_set(List, Set1),
  483    remove_variants(Set1, Set).
  484
  485remove_variants([], []).
  486remove_variants([H|T0], [H|T]) :-
  487    skip_variants(T0, H, T1),
  488    remove_variants(T1, T).
  489
  490skip_variants([H|T0], V, T) :-
  491    H =@= V, !,
  492    skip_variants(T0, V, T).
  493skip_variants(L, _, L).
  494
  495
  496xref_terms([]) --> [].
  497xref_terms([(?- Query), Answer|T]) --> {is_answer(Answer)}, !, xref_query(Query), xref_terms(T).
  498xref_terms([H|T]) --> xref_term(H), xref_terms(T).
  499
  500xref_term(Var) -->
  501    { var(Var) }, !.
  502xref_term((Head :- Body)) --> !,
  503    xref_head(Head),
  504    xref_body(Body).
  505xref_term((Head --> Body)) --> !,
  506    xref_dcg_head(Head),
  507    xref_dcg_body(Body).
  508xref_term((:- Body)) --> !,
  509    xref_body(Body).
  510xref_term((?- Query)) --> !,
  511    xref_query(Query).
  512xref_term(Head) -->
  513    xref_head(Head).
  514
  515xref_head(Term) --> { atom(Term) }, !, [defined-Term].
  516xref_head(Term) --> { compound(Term), !, generalize(Term,Gen) }, [defined-Gen].
  517xref_head(Term) --> [ error-type_error(callable, Term) ].
  518
  519xref_query(Query) -->
  520    xref_body(Query, query).
  521
  522xref_body(Body) -->
  523    xref_body(Body, called).
  524
  525xref_body(Term, _) --> { var(Term) }, !.
  526xref_body(Term, Ctx) -->
  527    { predicate_property(user:Term, meta_predicate(Meta)), !,
  528      generalize(Term, Called),
  529      Term =.. [_|Args],
  530      Meta =.. [_|Specs]
  531    },
  532    [ Ctx-Called ],
  533    xref_meta(Specs, Args, Ctx).
  534xref_body(Term, Ctx) --> { atom(Term) }, !, [Ctx-Term].
  535xref_body(Term, Ctx) --> { compound(Term), !, generalize(Term,Gen) }, [Ctx-Gen].
  536xref_body(Term, _Ctx) --> [ error-type_error(callable, Term) ].
  537
  538xref_meta([], [], _) --> [].
  539xref_meta([S|ST], [A|AT], Ctx) -->
  540    xref_meta1(S, A, Ctx),
  541    xref_meta(ST, AT, Ctx).
  542
  543xref_meta1(0, A, Ctx) --> !,
  544    xref_body(A, Ctx).
  545xref_meta1(^, A0, Ctx) --> !,
  546    { strip_existential(A0, A) },
  547    xref_body(A, Ctx).
  548xref_meta1(N, A0, Ctx) -->
  549    { integer(N), N > 0, !,
  550      extend(A0, N, A)
  551    },
  552    xref_body(A, Ctx).
  553xref_meta1(_, _, _) --> [].
  554
  555
  556xref_dcg_head(Var) -->
  557    { var(Var) }, !,
  558    [ error-instantiation_error(Var) ].
  559xref_dcg_head((A,B)) -->
  560    { is_list(B) }, !,
  561    xref_dcg_head(A).
  562xref_dcg_head(Term) -->
  563    { atom(Term), !,
  564      functor(Head, Term, 2)
  565    },
  566    [ defined-Head ].
  567xref_dcg_head(Term) -->
  568    { compound(Term), !,
  569      compound_name_arity(Term, Name, Arity0),
  570      Arity is Arity0+2,
  571      compound_name_arity(Gen, Name, Arity)
  572    },
  573    [ defined-Gen ].
  574xref_dcg_head(Term) -->
  575    [ error-type_error(callable, Term) ].
  576
  577xref_dcg_body(Body) -->
  578    { var(Body) }, !.
  579xref_dcg_body(Body) -->
  580    { dcg_control(Body, Called) }, !,
  581    xref_dcg_body_list(Called).
  582xref_dcg_body(Terminal) -->
  583    { is_list(Terminal) ; string(Terminal) }, !.
  584xref_dcg_body(Term) -->
  585    { atom(Term), !,
  586      functor(Head, Term, 2)
  587    },
  588    [ called-Head ].
  589xref_dcg_body(Term) -->
  590    { compound(Term), !,
  591      compound_name_arity(Term, Name, Arity0),
  592      Arity is Arity0+2,
  593      compound_name_arity(Gen, Name, Arity)
  594    },
  595    [ called-Gen ].
  596xref_dcg_body(Term) -->
  597    [ error-type_error(callable, Term) ].
  598
  599dcg_control((A,B), [A,B]).
  600dcg_control((A;B), [A,B]).
  601dcg_control((A->B), [A,B]).
  602dcg_control((A*->B), [A,B]).
  603dcg_control(\+(A), [A]).
  604
  605xref_dcg_body_list([]) --> [].
  606xref_dcg_body_list([H|T]) --> xref_dcg_body(H), xref_dcg_body_list(T).
  607
  608strip_existential(T0, T) :-
  609    (   var(T0)
  610    ->  T = T0
  611    ;   T0 = _^T1
  612    ->  strip_existential(T1, T)
  613    ;   T = T0
  614    ).
  615
  616extend(T0, N, T) :-
  617    atom(T0), !,
  618    length(Args, N),
  619    T =.. [T0|Args].
  620extend(T0, N, T) :-
  621    compound(T0),
  622    compound_name_arguments(T0, Name, Args0),
  623    length(Extra, N),
  624    append(Args0, Extra, Args),
  625    compound_name_arguments(T, Name, Args).
  626
  627generalize(Compound, Gen) :-
  628    compound_name_arity(Compound, Name, Arity),
  629    compound_name_arity(Gen, Name, Arity).
  630
  631built_in(PI) :-
  632    pi_head(PI, Head),
  633    predicate_property(Head, built_in).
  634
  635is_answer(Answer) :-
  636    var(Answer),
  637    !,
  638    fail.
  639is_answer((A;B)) :-
  640    !,
  641    is_1answer(A),
  642    is_answer(B).
  643is_answer(A) :-
  644    is_1answer(A).
  645
  646is_1answer(X) :- var(X), !, fail.
  647is_1answer(true) :- !.
  648is_1answer(false) :- !.
  649is_1answer((A,B)) :-
  650    !,
  651    is_binding_or_constraint(A),
  652    is_1answer(B).
  653is_1answer(A) :-
  654    is_binding_or_constraint(A).
  655
  656is_binding_or_constraint(Var) :-
  657    var(Var), !,
  658    fail.
  659is_binding_or_constraint(Var = _) :-
  660    !,
  661    var(Var).                           % often shares with query
  662is_binding_or_constraint(:-_) :- !, fail.
  663is_binding_or_constraint(?-_) :- !, fail.
  664is_binding_or_constraint(_).            % how to find out?
  665
  666
  667		 /*******************************
  668		 *            UPDATE		*
  669		 *******************************/
 pull_examples
Do a git pull on the examples and update the index.
  675pull_examples :-
  676    (   ex_repo(ExDir),
  677        is_git_directory(ExDir),
  678        git([pull], [directory(ExDir)]),
  679        fail
  680    ;   true
  681    ),
  682    index_examples(1).
  683
  684
  685		 /*******************************
  686		 *             HTTP		*
  687		 *******************************/
  688
  689:- http_handler(root(examples/pull), pull_examples, []).  690
  691pull_examples(Request) :-
  692    (   option(method(post), Request)
  693    ->  http_read_json(Request, JSON),
  694        print_message(informational, got(JSON))
  695    ;   true
  696    ),
  697    call_showing_messages(pull_examples, [])