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-2023, 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(Objs, Options) --> 71 examples(Objs, Options).
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 (File) --> 136 { ex_prop(File, author, Authors) }, !, 137 sequence(ex_author, ", ", Authors). 138ex_authors(_) --> 139 []. 140 (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).
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 *******************************/
226:- dynamic 227 ex_code/4, 228 ex_prop/3, 229 ex_done/1, 230 ex_checked/1. 231 232 233 /******************************* 234 * INDEX * 235 *******************************/
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 ).
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).
318ex_repo(Dir) :-
319 absolute_file_name(examples(.), Dir,
320 [ file_type(directory),
321 access(read),
322 solutions(all)
323 ]).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 ).
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).
363dom_code(DOM, Code, Attrs) :-
364 sub_term(pre(Attrs, Code), DOM).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).
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 *******************************/
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), !, most_general_goal(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 525:- multifile 526 prolog:meta_goal/2. 527:- dynamic 528 prolog:meta_goal/2. 529 530xref_body(Term, _) --> { var(Term) }, !. 531xref_body(Term, Ctx) --> 532 { prolog:meta_goal(Term, Explicit), 533 !, 534 most_general_goal(Term, Called) 535 }, 536 [ Ctx-Called ], 537 xref_explicit(Explicit, Ctx). 538xref_body(Term, Ctx) --> 539 { meta_head(Term, Meta), !, 540 most_general_goal(Term, Called), 541 Term =.. [_|Args], 542 Meta =.. [_|Specs] 543 }, 544 [ Ctx-Called ], 545 xref_meta(Specs, Args, Ctx). 546xref_body(Term, Ctx) --> { atom(Term) }, !, [Ctx-Term]. 547xref_body(Term, Ctx) --> { compound(Term), !, most_general_goal(Term,Gen) }, [Ctx-Gen]. 548xref_body(Term, _Ctx) --> [ error-type_error(callable, Term) ]. 549 550meta_head(Term, Meta) :- 551 predicate_property(user:Term, meta_predicate(Meta)). 552meta_head(Term, Meta) :- 553 predicate_property(M:Term, exported), 554 module_property(M, class(library)), 555 predicate_property(M:Term, meta_predicate(Meta)). 556 557xref_meta([], [], _) --> []. 558xref_meta([S|ST], [A|AT], Ctx) --> 559 xref_meta1(S, A, Ctx), 560 xref_meta(ST, AT, Ctx). 561 562xref_meta1(0, A, Ctx) --> !, 563 xref_body(A, Ctx). 564xref_meta1(^, A0, Ctx) --> !, 565 { strip_existential(A0, A) }, 566 xref_body(A, Ctx). 567xref_meta1(N, A0, Ctx) --> 568 { integer(N), N > 0, !, 569 extend(A0, N, A) 570 }, 571 xref_body(A, Ctx). 572xref_meta1(_, _, _) --> []. 573 574 575xref_dcg_head(Var) --> 576 { var(Var) }, !, 577 [ error-instantiation_error(Var) ]. 578xref_dcg_head((A,B)) --> 579 { is_list(B) }, !, 580 xref_dcg_head(A). 581xref_dcg_head(Term) --> 582 { atom(Term), !, 583 functor(Head, Term, 2) 584 }, 585 [ defined-Head ]. 586xref_dcg_head(Term) --> 587 { compound(Term), !, 588 compound_name_arity(Term, Name, Arity0), 589 Arity is Arity0+2, 590 compound_name_arity(Gen, Name, Arity) 591 }, 592 [ defined-Gen ]. 593xref_dcg_head(Term) --> 594 [ error-type_error(callable, Term) ]. 595 596xref_dcg_body(Body) --> 597 { var(Body) }, !. 598xref_dcg_body(Body) --> 599 { dcg_control(Body, Called) }, !, 600 xref_dcg_body_list(Called). 601xref_dcg_body(Terminal) --> 602 { is_list(Terminal) ; string(Terminal) }, !. 603xref_dcg_body(Term) --> 604 { atom(Term), !, 605 functor(Head, Term, 2) 606 }, 607 [ called-Head ]. 608xref_dcg_body(Term) --> 609 { compound(Term), !, 610 compound_name_arity(Term, Name, Arity0), 611 Arity is Arity0+2, 612 compound_name_arity(Gen, Name, Arity) 613 }, 614 [ called-Gen ]. 615xref_dcg_body(Term) --> 616 [ error-type_error(callable, Term) ]. 617 618dcg_control((A,B), [A,B]). 619dcg_control((A;B), [A,B]). 620dcg_control((A->B), [A,B]). 621dcg_control((A*->B), [A,B]). 622dcg_control(\+(A), [A]). 623 624xref_dcg_body_list([]) --> []. 625xref_dcg_body_list([H|T]) --> xref_dcg_body(H), xref_dcg_body_list(T). 626 627xref_explicit([], _) --> 628 []. 629xref_explicit([G+N|T], Ctx) --> 630 !, 631 { extend(G,N,G1) }, 632 xref_body(G1, Ctx), 633 xref_explicit(T, Ctx). 634xref_explicit([G|T], Ctx) --> 635 xref_body(G, Ctx), 636 xref_explicit(T, Ctx). 637 638 639 640strip_existential(T0, T) :- 641 ( var(T0) 642 -> T = T0 643 ; T0 = _^T1 644 -> strip_existential(T1, T) 645 ; T = T0 646 ). 647 648extend(T0, N, T) :- 649 atom(T0), !, 650 length(Args, N), 651 T =.. [T0|Args]. 652extend(T0, N, T) :- 653 compound(T0), 654 compound_name_arguments(T0, Name, Args0), 655 length(Extra, N), 656 append(Args0, Extra, Args), 657 compound_name_arguments(T, Name, Args). 658 659built_in(PI) :- 660 pi_head(PI, Head), 661 predicate_property(Head, built_in). 662 663is_answer(Answer) :- 664 var(Answer), 665 !, 666 fail. 667is_answer((A;B)) :- 668 !, 669 is_1answer(A), 670 is_answer(B). 671is_answer(A) :- 672 is_1answer(A). 673 674is_1answer(X) :- var(X), !, fail. 675is_1answer(true) :- !. 676is_1answer(false) :- !. 677is_1answer((A,B)) :- 678 !, 679 is_binding_or_constraint(A), 680 is_1answer(B). 681is_1answer(A) :- 682 is_binding_or_constraint(A). 683 684is_binding_or_constraint(Var) :- 685 var(Var), !, 686 fail. 687is_binding_or_constraint(Var = _) :- 688 !, 689 var(Var). % often shares with query 690is_binding_or_constraint(:-_) :- !, fail. 691is_binding_or_constraint(?-_) :- !, fail. 692is_binding_or_constraint(_). % how to find out? 693 694 695 /******************************* 696 * UPDATE * 697 *******************************/
703pull_examples :- 704 ( ex_repo(ExDir), 705 is_git_directory(ExDir), 706 git([pull], [directory(ExDir)]), 707 fail 708 ; true 709 ), 710 index_examples(1). 711 712 713 /******************************* 714 * HTTP * 715 *******************************/ 716 717:- http_handler(root(examples/pull), pull_examples, []). 718 719pull_examples(Request) :- 720 ( option(method(post), Request) 721 -> http_read_json(Request, JSON), 722 print_message(informational, got(JSON)) 723 ; true 724 ), 725 call_showing_messages(pull_examples, [])