1/* Part of LogicMOO Base bb_env 2% Provides a prolog database *env* 3% =================================================================== 4% File 'echo_files.pl' 5% Purpose: An Implementation in SWI-Prolog of certain debugging tools 6% Maintainer: Douglas Miles 7% Contact: $Author: dmiles $@users.sourceforge.net ; 8% Version: 'echo_files.pl' 1.0.0 9% Revision: $Revision: 1.1 $ 10% Revised At: $Date: 2016/07/11 21:57:28 $ 11% Licience: LGPL 12% =================================================================== 13*/ 14% File: $PACKDIR/subclause_expansion/prolog/echo_files.pl 15:- module(echo_files, 16 [get_file_from_stream/2,assume_caughtup_to/3]). 17 18:- define_into_module( 19 [ 20 check_current_echo/0, 21 echo_source_file/0, 22 echo_source_file_no_catchup/1, 23 echo_source_file/1]).

Utility LOGICMOO_PREDICATE_STREAMS

This module allows running prolog files as echos. @author Douglas R. Miles @license LGPL

Prolog source-code will echo while running

34:- set_module(class(library)). 35 36:- meta_predicate(into_echo_cmt(:)). 37 38 39:- module_transparent(echo_source_file/0). 40:- module_transparent(check_current_echo/1). 41:- module_transparent(into_echo_cmt/1). 42 43:- thread_local(t_l:echoing_file/1). 44:- thread_local(t_l:echoing_file_in_cmt/1). 45:- thread_local(t_l:file_stream_loc/3).

49echo_source_file(F):- 50 (\+ t_l:echoing_file(F) -> asserta(t_l:echoing_file(F)) ; true), 51 check_current_echo(F). 52 53echo_source_file:- prolog_load_context(file,File), echo_source_file(File). 54 55echo_source_file_no_catchup(F):- 56 ignore(( 57 \+ t_l:echoing_file(F), 58 asserta(t_l:echoing_file(F)),!, 59 stream_property(S,file_name(F)), 60 %get_file_from_stream(S,F), 61 character_count(S,Pos), 62 echo_files:assume_caughtup_to(F,S,Pos))),!. 63 64check_current_echo:- 65 source_location(F,_), prolog_load_context(source,S), S\==F,!, 66 check_current_echo(S),check_current_echo(F). 67check_current_echo:- 68 ignore((prolog_load_context(source,S),check_current_echo(S))), 69 ignore((source_location(F,_),S\==F,check_current_echo(F))), 70 ignore((prolog_load_context(file,SL),SL\==S,SL\==F,check_current_echo(SL))),!. 71 72check_current_echo(F):- t_l:echoing_file(F),get_file_from_stream(S,F), character_count(S,Pos),catch_up_to_stream(S,Pos),!. 73check_current_echo(F):- t_l:echoing_file_in_cmt(F),!,get_file_from_stream(S,F), character_count(S,Pos),into_echo_cmt((catch_up_to_stream(S,Pos))). 74check_current_echo(F):- asserta(t_l:echoing_file_in_cmt(F)),!,check_current_echo(F). 75 76 77into_echo_cmt(Goal):- setup_call_cleanup(format('~N/*~~~n',[]),Goal,format('~N~~*/~n',[])). 78 79 80:- thread_local(t_l:feedback_started/2). 81 82:- create_prolog_flag(capture_feedback,false,[keep(true)]). 83 84c_es(X):- stream_property(X,alias(current_error)),!. 85c_es(X):- stream_property(X,alias(user_error)),!. 86c_es(X):- stream_property(X,alias(main_error)),!. 87c_es(X):- stream_property(X,file_no(2)),!. 88 89feedback_open(F):- t_l:feedback_started(F,_),!, format('~N/*~~~n'), 90 ignore(( \+ current_prolog_flag(capture_feedback,false), fail, feedback_close(F),!,feedback_open(F))). 91feedback_open(F):- current_prolog_flag(capture_feedback,true), 92 current_input(I),current_output(O),c_es(E), 93 new_memory_file(MF),open_memory_file(MF,write,S,[free_on_close(false)]), 94 asserta(t_l:feedback_started(F,mf_s(MF,S,I,O,E))),!,tell(S),set_prolog_IO(I,S,S), 95 % for ansi color 96 set_stream(S,tty(true)). 97feedback_open(F):- format('~N/*~~~n'),assert(t_l:feedback_started(F,current_output)). 98 99feedback_close(F):- retract(t_l:feedback_started(F,current_output)),!,format('~N~~*/~n'). 100feedback_close(F):- retract(t_l:feedback_started(F,mf_s(MF,S,I,O,E))),!,set_prolog_IO(I,O,E), 101 close(S),memory_file_to_string(MF,String),free_memory_file(MF), 102 atom_length(String,L), (L>0 -> into_echo_cmt(write(String));true). 103feedback_close(_):- told. 104 105mco_info(F,S,_I,Start,End):- 106 get_file_range(F,Start,End,STerm), 107 read_mco(STerm,Term,Cmnts,QQ,Vs,Sv), 108 character_count(S,Pos), get_file_range(F,End,Pos,After), peek_string(S,6,Peek), 109 fmsg('~N%~~ ~q ~~%~n',[[string(STerm),term(Term),comments(Cmnts),quasi_quotations(QQ), 110 variable_names(Vs),singletons(Sv),after(After),peek(Peek)]]). 111fmsg(Fmt,Args):- flush_output,ttyflush,format(user_output,Fmt,Args),ttyflush. 112 113never_echo_term(_:P):-!,compound(P),never_echo_term(P). 114never_echo_term(end_tests(_)). 115never_echo_term(begin_tests(_)). 116 117:- module_transparent(echo_catchup/4). 118 119echo_catchup(I,P,O,PO):- \+ echo_catchup_f(I,P,O,PO), fail. 120echo_catchup_f(I,P,O,PO):- 121 notrace((compound(P), 122 source_location(F,_L),t_l:echoing_file(F), 123 b_getval('$term', Term),I==Term)), 124 nonvar(I), \+ never_echo_term(I), 125 prolog_load_context(stream,S),stream_property(S,file_name(F)), 126 P=..[_,Start,End|_],!, 127 ttyflush, 128 mco(F,S,I,Start,End,O),!, 129 PO=P. 130 131:- style_check(-singleton). 132mco(F,S,I,Start,End,O):- I == end_of_file, !, feedback_close(F),fail. 133mco(F,S,I,Start,End,O):- t_l:file_stream_loc(F,S,Pos), PosBefore1 is Pos+1, End =< PosBefore1,!, mco_i2(F,S,I,O). 134mco(F,S,I,Start,End,O):- feedback_close(F),fail. 135mco(F,S,I,Start,End,O):- catch_up_to_stream(S,Start), fail. 136mco(F,S,I,Start,End,O):- mco_p(F,S,I,Start,End) -> fail; (print_tree(I), fail). 137mco(F,S,I,Start,End,O):- assume_caughtup_to(F,S,End),fail. 138mco(F,S,I,Start,End,O):- character_count(S,Pos), catch_up_to_stream(S,Pos), fail. 139mco(F,S,I,Start,End,O):- consume_white_space(F,S),fail. 140mco(F,S,I,Start,End,O):- character_count(S,Pos), assume_caughtup_to(F,S,Pos), fail. % for the peek/getch 141%mco(F,S,I,Start,End,O):- mco_info(F,S,I,Start,End),fail. 142mco(F,S,I,Start,End,O):- mco_i(F,S,I,O),!,feedback_open(F),!. 143mco(F,S,I,Start,End,O):- feedback_open(F),fail. 144 145consume_white_space(_,S):- at_end_of_stream(S),!,fail. 146consume_white_space(F,S):- character_count(S,Start),get_file_from(F,Start,SubStr), 147 open_string(SubStr,S2),consume_white_space_proxy(S2),character_count(S2,Consumed), 148 NewPos is Start + Consumed, 149 assume_caughtup_to(F,S,NewPos),!. 150 151consume_white_space_proxy(S):- consume_white(S),!,consume_white_space_proxy(S). 152 153consume_white(S):- at_end_of_stream(S),!,fail. 154consume_white(S):- peek_char(S,C),char_type(C,space),get_char(S,C),put_char(C). 155consume_white(S):- nsl(NSL),atom_length(NSL,L),peek_string(S,L,Str),Str==NSL,!,read_line_to_string(S,_). 156consume_white(S):- peek_string(S,2,"%~"),!,read_line_to_string(S,_). 157consume_white(S):- peek_string(S,1,"%"),!,read_line_to_string(S,Str),write(Str),nl. 158consume_white(S):- peek_string(S,2,"#!"),!,read_line_to_string(S,Str),write(Str),nl. 159 160 161mco_p(F,_S,_I,Start,End):- %garbage_collect_atoms, 162 get_file_range(F,Start,End,STerm), 163 read_mco(STerm,Term,Cmnts,QQ,_Vs,_Sv), 164 % (Cmnts\==[];QQ\==[]),!, 165 % mco_info(F,S,I,Start,End), 166 write(STerm),!, 167 assume_caughtup_to(F,S,End). 168 169mco_p(F,S,I,Start,End):- print_tree(I),!,assume_caughtup_to(F,S,End). 170 171% mco_i(F,S,I,O):- format('~N/*~~'), 172mco_i2(F,S,I,O):- fail. 173mco_i(F,S,I,O):- fail. 174mco_i(F,S,_-->_,O):- fail. 175 176:- style_check(+singleton). 177 178read_mco(STerm,Term,Cmnts,QQ,Vs,Sv):- 179 read_term_from_atom(STerm,CTerm,[cycles(true),comments(Cmnts),quasi_quotations(QQ),variable_names(Vs),singletons(Sv)]), 180 read_term_from_atom(STerm,UTerm,[cycles(false),comments(UCmnts),quasi_quotations(UQQ),variable_names(UVs),singletons(USv)]),!, 181 (CTerm =@= UTerm -> Term = CTerm ; (Term = UTerm, UCmnts = Cmnts, QQ=UQQ, Vs=UVs, USv=Sv)),!. 182 183get_file_from_stream(S,F):- stream_property(S,file_name(F)). 184 185catch_up_to_stream(S,Pos):- \+ t_l:file_stream_loc(_,S,_),get_file_from_stream(S,F), print_file_range(F,S,0,Pos),!. 186catch_up_to_stream(S,Pos):- t_l:file_stream_loc(F,S,PosBefore), Pos>PosBefore, print_file_range(F,S,PosBefore,Pos). 187catch_up_to_stream(S):- character_count(S,Pos),catch_up_to_stream(S,Pos). 188 189get_file_range(F,Start,End,SubStr):- 190 Len is End-Start, 191 read_file_to_string(F,Str,[]), 192 sub_string(Str,Start,Len,_,SubStr). 193get_file_from(F,Start,SubStr):- 194 read_file_to_string(F,Str,[]), 195 sub_string(Str,Start,_,0,SubStr). 196 197 198print_file_range(F,S,Start,End):- 199 get_file_range(F,Start,End,SubStr), 200 assume_caughtup_to(F,S,End), 201 write_ommit_feedback(on,SubStr),!. 202 203nsl('No source location!?'). 204 205write_ommit_feedback(S,String):- nsl(NSL), atom_contains(String,NSL),replace_in_string([NSL='/*~NSL~*/'],String,Rest),!, 206 write_ommit_feedback(S,Rest). 207write_ommit_feedback(on,String):- (sub_string(String,Before,_,After,'\n/*~');sub_string(String,Before,_,After,'/*~')),!, 208 sub_atom(String,0,Before,_A,On),write_ommit_feedback(on,On), 209 sub_atom(String,After,_,0,Rest),write_ommit_feedback(off,Rest). 210write_ommit_feedback(on,String):- (sub_string(String,Before,_,After,'\n%~');sub_string(String,Before,_,After,'%~')),!, 211 sub_atom(String,0,Before,_A,On),write_ommit_feedback(on,On), 212 sub_atom(String,After,_,0,Rest),write_ommit_feedback(lineoff,Rest). 213write_ommit_feedback(on,String):- !, write(String). 214write_ommit_feedback(off,String):- (sub_string(String,_,_,After,'~*/\n');sub_string(String,_,_,After,'~*/')),!, 215 sub_atom(String,After,_,0,Rest),write_ommit_feedback(on,Rest). 216write_ommit_feedback(lineoff,String):- sub_string(String,_,_,After,'\n'), !, 217 sub_atom(String,After,_,0,Rest),write_ommit_feedback(on,Rest). 218write_ommit_feedback(_,_). 219 220 221assume_caughtup_current(F,S):- retractall(t_l:file_stream_loc(F,S,_)),character_count(S,Pos),assert(t_l:file_stream_loc(F,S,Pos)). 222 223assume_caughtup_to(F,S,Pos):- retractall(t_l:file_stream_loc(F,S,_)),assert(t_l:file_stream_loc(F,S,Pos)). 224 225se:echo_expander(system:term_expansion(I,P,O,PO), echo_catchup(I,P,O,PO)). 226 227%user:term_expansion(I,P,O,PO):- echo_catchup(I,P,O,PO). 228system:term_expansion(_,_,_,_):- 229 notrace(( 230 se:echo_expander(H,B), 231 nth_clause(H,1,Ref), 232 \+ (clause(H,_:B,Ref)))), 233 ignore(retract(H:- B)), 234 asserta(H:-B), 235 fail. 236%system:term_expansion(I,P,O,PO):- echo_catchup(I,P,O,PO).