35
36:- module(pengines_io,
37 [ pengine_writeln/1, 38 pengine_nl/0,
39 pengine_tab/1,
40 pengine_flush_output/0,
41 pengine_format/1, 42 pengine_format/2, 43
44 pengine_write_term/2, 45 pengine_write/1, 46 pengine_writeq/1, 47 pengine_display/1, 48 pengine_print/1, 49 pengine_write_canonical/1, 50
51 pengine_listing/0,
52 pengine_listing/1, 53 pengine_portray_clause/1, 54
55 pengine_read/1, 56 pengine_read_line_to_string/2, 57 pengine_read_line_to_codes/2, 58
59 pengine_io_predicate/1, 60 pengine_bind_io_to_html/1, 61 pengine_io_goal_expansion/2, 62
63 message_lines_to_html/3 64 ]). 65:- autoload(library(apply),[foldl/4,maplist/3,maplist/4]). 66:- autoload(library(backcomp),[thread_at_exit/1]). 67:- autoload(library(debug),[assertion/1]). 68:- autoload(library(error),[must_be/2]). 69:- autoload(library(listing),[listing/1,portray_clause/1]). 70:- autoload(library(lists),[append/2,append/3,subtract/3]). 71:- autoload(library(option),[option/3,merge_options/3]). 72:- autoload(library(pengines),
73 [ pengine_self/1,
74 pengine_output/1,
75 pengine_input/2,
76 pengine_property/2
77 ]). 78:- autoload(library(prolog_stream),[open_prolog_stream/4]). 79:- autoload(library(readutil),[read_line_to_string/2]). 80:- autoload(library(yall),[(>>)/4]). 81:- autoload(library(http/term_html),[term/4]). 82
83:- use_module(library(http/html_write),[html/3,print_html/1, op(_,_,_)]). 84:- use_module(library(settings),[setting/4,setting/2]). 85
86:- use_module(library(sandbox), []). 87:- autoload(library(thread), [call_in_thread/2]). 88
89:- html_meta send_html(html). 90:- public send_html/1. 91
92:- meta_predicate
93 pengine_format(+,:). 94
127
128:- setting(write_options, list(any), [max_depth(1000)],
129 'Additional options for stringifying Prolog results'). 130
131
132 135
139
140pengine_writeln(Term) :-
141 pengine_output,
142 !,
143 pengine_module(Module),
144 send_html(span(class(writeln),
145 [ \term(Term,
146 [ module(Module)
147 ]),
148 br([])
149 ])).
150pengine_writeln(Term) :-
151 writeln(Term).
152
156
157pengine_nl :-
158 pengine_output,
159 !,
160 send_html(br([])).
161pengine_nl :-
162 nl.
163
167
168pengine_tab(Expr) :-
169 pengine_output,
170 !,
171 N is Expr,
172 length(List, N),
173 maplist(=(&(nbsp)), List),
174 send_html(List).
175pengine_tab(N) :-
176 tab(N).
177
178
183
184pengine_flush_output :-
185 pengine_output,
186 !.
187pengine_flush_output :-
188 flush_output.
189
197
198pengine_write_term(Term, Options) :-
199 pengine_output,
200 !,
201 option(class(Class), Options, write),
202 pengine_module(Module),
203 send_html(span(class(Class), \term(Term,[module(Module)|Options]))).
204pengine_write_term(Term, Options) :-
205 write_term(Term, Options).
206
214
215pengine_write(Term) :-
216 pengine_write_term(Term, [numbervars(true)]).
217pengine_writeq(Term) :-
218 pengine_write_term(Term, [quoted(true), numbervars(true)]).
219pengine_display(Term) :-
220 pengine_write_term(Term, [quoted(true), ignore_ops(true)]).
221pengine_print(Term) :-
222 current_prolog_flag(print_write_options, Options),
223 pengine_write_term(Term, Options).
224pengine_write_canonical(Term) :-
225 pengine_output,
226 !,
227 with_output_to(string(String), write_canonical(Term)),
228 send_html(span(class([write, cononical]), String)).
229pengine_write_canonical(Term) :-
230 write_canonical(Term).
231
239
240pengine_format(Format) :-
241 pengine_format(Format, []).
242pengine_format(Format, Args) :-
243 pengine_output,
244 !,
245 format(string(String), Format, Args),
246 split_string(String, "\n", "", Lines),
247 send_html(\lines(Lines, format)).
248pengine_format(Format, Args) :-
249 format(Format, Args).
250
251
252 255
261
262pengine_listing :-
263 pengine_listing(_).
264
265pengine_listing(Spec) :-
266 pengine_self(Module),
267 with_output_to(string(String), listing(Module:Spec)),
268 split_string(String, "", "\n", [Pre]),
269 send_html(pre(class(listing), Pre)).
270
271pengine_portray_clause(Term) :-
272 pengine_output,
273 !,
274 with_output_to(string(String), portray_clause(Term)),
275 split_string(String, "", "\n", [Pre]),
276 send_html(pre(class(listing), Pre)).
277pengine_portray_clause(Term) :-
278 portray_clause(Term).
279
280
281 284
285:- multifile user:message_hook/3. 286
291
292user:message_hook(Term, Kind, Lines) :-
293 Kind \== silent,
294 pengine_self(_),
295 atom_concat('msg-', Kind, Class),
296 message_lines_to_html(Lines, [Class], HTMlString),
297 ( source_location(File, Line)
298 -> Src = File:Line
299 ; Src = (-)
300 ),
301 pengine_output(message(Term, Kind, HTMlString, Src)).
302
308
309message_lines_to_html(Lines, Classes, HTMlString) :-
310 phrase(html(pre(class(['prolog-message'|Classes]),
311 \message_lines(Lines))), Tokens),
312 with_output_to(string(HTMlString), print_html(Tokens)).
313
314message_lines([]) -->
315 !.
316message_lines([nl|T]) -->
317 !,
318 html('\n'), 319 message_lines(T).
320message_lines([flush]) -->
321 !.
322message_lines([ansi(Attributes, Fmt, Args)|T]) -->
323 !,
324 { is_list(Attributes)
325 -> foldl(style, Attributes, Fmt-Args, HTML)
326 ; style(Attributes, Fmt-Args, HTML)
327 },
328 html(HTML),
329 message_lines(T).
330message_lines([url(Pos)|T]) -->
331 !,
332 location(Pos),
333 message_lines(T).
334message_lines([url(HREF, Label)|T]) -->
335 !,
336 html(a(href(HREF),Label)),
337 message_lines(T).
338message_lines([H|T]) -->
339 html(H),
340 message_lines(T).
341
342location(File:Line:Column) -->
343 !,
344 html([File, :, Line, :, Column]).
345location(File:Line) -->
346 !,
347 html([File, :, Line]).
348location(File) -->
349 html([File]).
350
351style(bold, Content, b(Content)) :- !.
352style(fg(default), Content, span(style('color: black'), Content)) :- !.
353style(fg(Color), Content, span(style('color:'+Color), Content)) :- !.
354style(_, Content, Content).
355
356
357 360
361pengine_read(Term) :-
362 pengine_input,
363 !,
364 prompt(Prompt, Prompt),
365 pengine_input(Prompt, Term).
366pengine_read(Term) :-
367 read(Term).
368
369pengine_read_line_to_string(From, String) :-
370 pengine_input,
371 !,
372 must_be(oneof([current_input,user_input]), From),
373 ( prompt(Prompt, Prompt),
374 Prompt \== ''
375 -> true
376 ; Prompt = 'line> '
377 ),
378 pengine_input(_{type: console, prompt:Prompt}, StringNL),
379 string_concat(String, "\n", StringNL).
380pengine_read_line_to_string(From, String) :-
381 read_line_to_string(From, String).
382
383pengine_read_line_to_codes(From, Codes) :-
384 pengine_read_line_to_string(From, String),
385 string_codes(String, Codes).
386
387
388 391
392lines([], _) --> [].
393lines([H|T], Class) -->
394 html(span(class(Class), H)),
395 ( { T == [] }
396 -> []
397 ; html(br([])),
398 lines(T, Class)
399 ).
400
405
406send_html(HTML) :-
407 phrase(html(HTML), Tokens),
408 with_output_to(string(HTMlString), print_html(Tokens)),
409 pengine_output(HTMlString).
410
411
415
416pengine_module(Module) :-
417 pengine_self(Pengine),
418 !,
419 pengine_property(Pengine, module(Module)).
420pengine_module(user).
421
422 425
452
453:- multifile
454 pengines:event_to_json/3. 455
470
471pengines:event_to_json(success(ID, Answers0, Projection, Time, More), JSON,
472 'json-s') :-
473 !,
474 JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
475 maplist(answer_to_json_strings(ID), Answers0, Answers),
476 add_projection(Projection, JSON0, JSON).
477pengines:event_to_json(output(ID, Term), JSON, 'json-s') :-
478 !,
479 map_output(ID, Term, JSON).
480
481add_projection([], JSON, JSON) :- !.
482add_projection(VarNames, JSON0, JSON0.put(projection, VarNames)).
483
484
489
490answer_to_json_strings(Pengine, DictIn, DictOut) :-
491 dict_pairs(DictIn, Tag, Pairs),
492 maplist(term_string_value(Pengine), Pairs, BindingsOut),
493 dict_pairs(DictOut, Tag, BindingsOut).
494
495term_string_value(Pengine, N-V, N-A) :-
496 with_output_to(string(A),
497 write_term(V,
498 [ module(Pengine),
499 quoted(true)
500 ])).
501
513
514pengines:event_to_json(success(ID, Answers0, Projection, Time, More),
515 JSON, 'json-html') :-
516 !,
517 JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
518 maplist(map_answer(ID), Answers0, ResVars, Answers),
519 add_projection(Projection, ResVars, JSON0, JSON).
520pengines:event_to_json(output(ID, Term), JSON, 'json-html') :-
521 !,
522 map_output(ID, Term, JSON).
523
524map_answer(ID, Bindings0, ResVars, Answer) :-
525 dict_bindings(Bindings0, Bindings1),
526 select_residuals(Bindings1, Bindings2, ResVars, Residuals0, Clauses),
527 append(Residuals0, Residuals1),
528 prolog:translate_bindings(Bindings2, Bindings3, [], Residuals1,
529 ID:Residuals-_HiddenResiduals),
530 maplist(binding_to_html(ID), Bindings3, VarBindings),
531 final_answer(ID, VarBindings, Residuals, Clauses, Answer).
532
533final_answer(_Id, VarBindings, [], [], Answer) :-
534 !,
535 Answer = json{variables:VarBindings}.
536final_answer(ID, VarBindings, Residuals, [], Answer) :-
537 !,
538 residuals_html(Residuals, ID, ResHTML),
539 Answer = json{variables:VarBindings, residuals:ResHTML}.
540final_answer(ID, VarBindings, [], Clauses, Answer) :-
541 !,
542 clauses_html(Clauses, ID, ClausesHTML),
543 Answer = json{variables:VarBindings, wfs_residual_program:ClausesHTML}.
544final_answer(ID, VarBindings, Residuals, Clauses, Answer) :-
545 !,
546 residuals_html(Residuals, ID, ResHTML),
547 clauses_html(Clauses, ID, ClausesHTML),
548 Answer = json{variables:VarBindings,
549 residuals:ResHTML,
550 wfs_residual_program:ClausesHTML}.
551
552residuals_html([], _, []).
553residuals_html([H0|T0], Module, [H|T]) :-
554 term_html_string(H0, [], Module, H, [priority(999)]),
555 residuals_html(T0, Module, T).
556
557clauses_html(Clauses, _ID, HTMLString) :-
558 with_output_to(string(Program), list_clauses(Clauses)),
559 phrase(html(pre([class('wfs-residual-program')], Program)), Tokens),
560 with_output_to(string(HTMLString), print_html(Tokens)).
561
562list_clauses([]).
563list_clauses([H|T]) :-
564 ( system_undefined(H)
565 -> true
566 ; portray_clause(H)
567 ),
568 list_clauses(T).
569
570system_undefined((undefined :- tnot(undefined))).
571system_undefined((answer_count_restraint :- tnot(answer_count_restraint))).
572system_undefined((radial_restraint :- tnot(radial_restraint))).
573
574dict_bindings(Dict, Bindings) :-
575 dict_pairs(Dict, _Tag, Pairs),
576 maplist([N-V,N=V]>>true, Pairs, Bindings).
577
578select_residuals([], [], [], [], []).
579select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
580 binding_residual(H, Var, Residual),
581 !,
582 Vars = [Var|TV],
583 Residuals = [Residual|TR],
584 select_residuals(T, Bindings, TV, TR, Clauses).
585select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
586 binding_residual_clauses(H, Var, Delays, Clauses0),
587 !,
588 Vars = [Var|TV],
589 Residuals = [Delays|TR],
590 append(Clauses0, CT, Clauses),
591 select_residuals(T, Bindings, TV, TR, CT).
592select_residuals([H|T0], [H|T], Vars, Residuals, Clauses) :-
593 select_residuals(T0, T, Vars, Residuals, Clauses).
594
595binding_residual('_residuals' = '$residuals'(Residuals), '_residuals', Residuals) :-
596 is_list(Residuals).
597binding_residual('Residuals' = '$residuals'(Residuals), 'Residuals', Residuals) :-
598 is_list(Residuals).
599binding_residual('Residual' = '$residual'(Residual), 'Residual', [Residual]) :-
600 callable(Residual).
601
602binding_residual_clauses(
603 '_wfs_residual_program' = '$wfs_residual_program'(Delays, Clauses),
604 '_wfs_residual_program', Residuals, Clauses) :-
605 phrase(delay_list(Delays), Residuals).
606
607delay_list(true) --> !.
608delay_list((A,B)) --> !, delay_list(A), delay_list(B).
609delay_list(M:A) --> !, [M:'$wfs_undefined'(A)].
610delay_list(A) --> ['$wfs_undefined'(A)].
611
612add_projection(-, _, JSON, JSON) :- !.
613add_projection(VarNames0, ResVars0, JSON0, JSON) :-
614 append(ResVars0, ResVars1),
615 sort(ResVars1, ResVars),
616 subtract(VarNames0, ResVars, VarNames),
617 add_projection(VarNames, JSON0, JSON).
618
619
627
628binding_to_html(ID, binding(Vars,Term,Substitutions), JSON) :-
629 JSON0 = json{variables:Vars, value:HTMLString},
630 binding_write_options(ID, Options),
631 term_html_string(Term, Vars, ID, HTMLString, Options),
632 ( Substitutions == []
633 -> JSON = JSON0
634 ; maplist(subst_to_html(ID), Substitutions, HTMLSubst),
635 JSON = JSON0.put(substitutions, HTMLSubst)
636 ).
637
638binding_write_options(Pengine, Options) :-
639 ( current_predicate(Pengine:screen_property/1),
640 Pengine:screen_property(tabled(true))
641 -> Options = []
642 ; Options = [priority(699)]
643 ).
644
651
652term_html_string(Term, Vars, Module, HTMLString, Options) :-
653 setting(write_options, WOptions),
654 merge_options(WOptions,
655 [ quoted(true),
656 numbervars(true),
657 module(Module)
658 | Options
659 ], WriteOptions),
660 phrase(term_html(Term, Vars, WriteOptions), Tokens),
661 with_output_to(string(HTMLString), print_html(Tokens)).
662
672
673:- multifile binding_term//3. 674
675term_html(Term, Vars, WriteOptions) -->
676 { nonvar(Term) },
677 binding_term(Term, Vars, WriteOptions),
678 !.
679term_html(Undef, _Vars, WriteOptions) -->
680 { nonvar(Undef),
681 Undef = '$wfs_undefined'(Term),
682 !
683 },
684 html(span(class(wfs_undefined), \term(Term, WriteOptions))).
685term_html(Term, _Vars, WriteOptions) -->
686 term(Term, WriteOptions).
687
692
693subst_to_html(ID, '$VAR'(Name)=Value, json{var:Name, value:HTMLString}) :-
694 !,
695 binding_write_options(ID, Options),
696 term_html_string(Value, [Name], ID, HTMLString, Options).
697subst_to_html(_, Term, _) :-
698 assertion(Term = '$VAR'(_)).
699
700
704
705map_output(ID, message(Term, Kind, HTMLString, Src), JSON) :-
706 atomic(HTMLString),
707 !,
708 JSON0 = json{event:output, id:ID, message:Kind, data:HTMLString},
709 pengines:add_error_details(Term, JSON0, JSON1),
710 ( Src = File:Line,
711 \+ JSON1.get(location) = _
712 -> JSON = JSON1.put(_{location:_{file:File, line:Line}})
713 ; JSON = JSON1
714 ).
715map_output(ID, Term, json{event:output, id:ID, data:Data}) :-
716 ( atomic(Term)
717 -> Data = Term
718 ; is_dict(Term, json),
719 ground(json) 720 -> Data = Term
721 ; term_string(Term, Data)
722 ).
723
724
728
729:- multifile
730 prolog_help:show_html_hook/1. 731
732prolog_help:show_html_hook(HTML) :-
733 pengine_output,
734 pengine_output(HTML).
735
736
737 740
741:- multifile
742 sandbox:safe_primitive/1, 743 sandbox:safe_meta/2. 744
745sandbox:safe_primitive(pengines_io:pengine_listing(_)).
746sandbox:safe_primitive(pengines_io:pengine_nl).
747sandbox:safe_primitive(pengines_io:pengine_tab(_)).
748sandbox:safe_primitive(pengines_io:pengine_flush_output).
749sandbox:safe_primitive(pengines_io:pengine_print(_)).
750sandbox:safe_primitive(pengines_io:pengine_write(_)).
751sandbox:safe_primitive(pengines_io:pengine_read(_)).
752sandbox:safe_primitive(pengines_io:pengine_read_line_to_string(_,_)).
753sandbox:safe_primitive(pengines_io:pengine_read_line_to_codes(_,_)).
754sandbox:safe_primitive(pengines_io:pengine_write_canonical(_)).
755sandbox:safe_primitive(pengines_io:pengine_write_term(_,_)).
756sandbox:safe_primitive(pengines_io:pengine_writeln(_)).
757sandbox:safe_primitive(pengines_io:pengine_writeq(_)).
758sandbox:safe_primitive(pengines_io:pengine_portray_clause(_)).
759sandbox:safe_primitive(system:write_term(_,_)).
760sandbox:safe_primitive(system:prompt(_,_)).
761sandbox:safe_primitive(system:statistics(_,_)).
762
763sandbox:safe_meta(pengines_io:pengine_format(Format, Args), Calls) :-
764 sandbox:format_calls(Format, Args, Calls).
765
766
767 770
775
776pengine_io_predicate(writeln(_)).
777pengine_io_predicate(nl).
778pengine_io_predicate(tab(_)).
779pengine_io_predicate(flush_output).
780pengine_io_predicate(format(_)).
781pengine_io_predicate(format(_,_)).
782pengine_io_predicate(read(_)).
783pengine_io_predicate(read_line_to_string(_,_)).
784pengine_io_predicate(read_line_to_codes(_,_)).
785pengine_io_predicate(write_term(_,_)).
786pengine_io_predicate(write(_)).
787pengine_io_predicate(writeq(_)).
788pengine_io_predicate(display(_)).
789pengine_io_predicate(print(_)).
790pengine_io_predicate(write_canonical(_)).
791pengine_io_predicate(listing).
792pengine_io_predicate(listing(_)).
793pengine_io_predicate(portray_clause(_)).
794
795term_expansion(pengine_io_goal_expansion(_,_),
796 Clauses) :-
797 findall(Clause, io_mapping(Clause), Clauses).
798
799io_mapping(pengine_io_goal_expansion(Head, Mapped)) :-
800 pengine_io_predicate(Head),
801 Head =.. [Name|Args],
802 atom_concat(pengine_, Name, BodyName),
803 Mapped =.. [BodyName|Args].
804
805pengine_io_goal_expansion(_, _).
806
807
808 811
812:- public
813 stream_write/2,
814 stream_read/2,
815 stream_close/1. 816
817:- thread_local
818 pengine_io/2. 819
820stream_write(Stream, Out) :-
821 ( pengine_io(_,_)
822 -> send_html(pre(class(console), Out))
823 ; current_prolog_flag(pengine_main_thread, TID),
824 thread_signal(TID, stream_write(Stream, Out))
825 ).
826stream_read(Stream, Data) :-
827 ( pengine_io(_,_)
828 -> prompt(Prompt, Prompt),
829 pengine_input(_{type:console, prompt:Prompt}, Data)
830 ; current_prolog_flag(pengine_main_thread, TID),
831 call_in_thread(TID, stream_read(Stream, Data))
832 ).
833stream_close(_Stream).
834
842
843pengine_bind_user_streams :-
844 Err = Out,
845 open_prolog_stream(pengines_io, write, Out, []),
846 set_stream(Out, buffer(line)),
847 open_prolog_stream(pengines_io, read, In, []),
848 set_stream(In, alias(user_input)),
849 set_stream(Out, alias(user_output)),
850 set_stream(Err, alias(user_error)),
851 set_stream(In, alias(current_input)),
852 set_stream(Out, alias(current_output)),
853 assertz(pengine_io(In, Out)),
854 thread_self(Me),
855 thread_property(Me, id(Id)),
856 set_prolog_flag(pengine_main_thread, Id),
857 thread_at_exit(close_io).
858
859close_io :-
860 retract(pengine_io(In, Out)),
861 !,
862 close(In, [force(true)]),
863 close(Out, [force(true)]).
864close_io.
865
870
871pengine_output :-
872 current_output(Out),
873 pengine_io(_, Out).
874
875pengine_input :-
876 current_input(In),
877 pengine_io(In, _).
878
879
884
885pengine_bind_io_to_html(Module) :-
886 forall(pengine_io_predicate(Head),
887 bind_io(Head, Module)),
888 pengine_bind_user_streams.
889
890bind_io(Head, Module) :-
891 prompt(_, ''),
892 redefine_system_predicate(Module:Head),
893 functor(Head, Name, Arity),
894 Head =.. [Name|Args],
895 atom_concat(pengine_, Name, BodyName),
896 Body =.. [BodyName|Args],
897 assertz(Module:(Head :- Body)),
898 compile_predicates([Module:Name/Arity])