1/* Part of LogicMOO Base bb_env 2% Provides a prolog database *env* 3% =================================================================== 4% File 'script_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: 'script_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/script_files.pl 15:- module(script_files, [ 16 process_this_script_now/0, 17 process_script_file/1, 18 process_stream/1, 19 visit_script_term/1]).
27% :- meta_predicate(process_this_script_now()). 28% :- meta_predicate(process_stream(+)). 29:- meta_predicate(visit_script_term()). 30:- meta_predicate(visit_if()). 31:- meta_predicate(in_space_cmt()). 32 33:- module_transparent(process_this_script_now/0). 34:- module_transparent(process_this_script/0). 35:- module_transparent(process_stream/1). 36:- module_transparent(process_this_stream/1). 37:- module_transparent(process_script_file/1). 38:- module_transparent(visit_script_term/1). 39:- module_transparent(in_space_cmt/1). 40 41:- thread_local(t_l:each_file_term/1). 42:- thread_local(t_l:block_comment_mode/1). 43:- thread_local(t_l:echo_mode/1). 44 45:- meta_predicate now_doing(,). 46:- meta_predicate each_doing(,). 47:- meta_predicate doing(,). 48 49 50till_eof(In) :- 51 repeat, 52 ( at_end_of_stream(In) 53 -> ! 54 ; (read_pending_codes(In, Chars, []), 55 (t_l:echo_mode(echo_file) -> 56 echo_format('~s',[Chars]); 57 true), 58 fail) 59 ).
Echoing the file
Same as
:- process_this_script_with(compile_normally, echo_file).
71process_this_script:-
72 assert_until_eof(t_l:echo_mode(echo_file)),
73 process_this_script_now.Not echoing the file
Same as
:- process_this_script_with(Pred1, skip(_)).
Example Pred1s compile_dynamic/1, compile_normally/1, Or one that you define
Your Pred will be invoked as:
call(Pred1, :- Clause),
call(Pred1, ?- Clause),
or call(Pred1,Clause).
Example: To compile all file predicates dynamic
:- process_this_script_with(compile_dynamic).
101process_this_script_with(Pred1):-
102 process_this_script_with(Pred1, skip(_)).
Echo may be file, skip(_) or skip(items)
111process_this_script_with(Pred1,Echo):-
112 (atom(Pred1)->assertion(current_predicate(Pred1/1));true),
113 assert_until_eof(t_l:each_file_term(Pred1)),
114 assert_until_eof(t_l:echo_mode(Echo)),
115 process_this_script_now.
Same as
:- process_this_script_with(compile_normally, skip(_)).
126process_this_script_now:- current_prolog_flag(xref,true),!. 127process_this_script_now:- prolog_load_context(stream,S) -> process_this_stream(S) ; assertion(prolog_load_context(stream,_)). 128 129process_this_stream(S):- 130 repeat, 131 once(process_stream(S)), 132 at_end_of_stream(S). 133 134% in_space_cmt(Goal):- call_cleanup(prepend_each_line(' % ',Goal),echo_format('~N',[])). 135in_space_cmt(Goal):- setup_call_cleanup(echo_format('~N /*~n',[]),Goal,echo_format('~N*/~n',[])). 136 137 138till_eol(S):- read_line_to_string(S,String), 139 (t_l:echo_mode(skip(_))->true ; (echo_format('~N~s~n',[String]))).
148process_stream(S):- at_end_of_stream(S),!,visit_script_term_pre_expanded(end_of_file). 149process_stream(S):- peek_code(S,W),char_type(W,end_of_line),!,get_code(S,W),echo_format('~s',[[W]]). 150process_stream(S):- (peek_string(S,2,W);peek_string(S,1,W);peek_string(S,3,W)),process_stream_peeked213(S,W),!. 151process_stream(S):- peek_code(S,W),char_type(W,white),\+ char_type(W,end_of_line),get_code(S,W),echo_format('~s',[[W]]),!. 152 153process_stream(S):- must((read_term(S,T,[variable_names(Vs)]),put_variable_names( Vs))), 154 call(b_setval,'$variable_names',Vs), b_setval('$term',T), 155 (t_l:echo_mode(skip(items)) -> true ; write_stream_item(user_error,T)),!, 156 flush_output(user_error), 157 must(visit_script_term(T)),!, 158 echo_format('~N',[]),!. 159 160process_stream_peeked213(S,W):- t_l:block_comment_mode(Was)-> 161 ((W=="*/")->((retract(t_l:block_comment_mode(Was))));true),!, 162 till_eol(S). 163process_stream_peeked213(S," /*"):- asserta(t_l:block_comment_mode(invisible)),!,!,till_eol(S). 164process_stream_peeked213(S," %"):- !, read_line_to_string(S,_). 165process_stream_peeked213(S,"/*"):- !, asserta(t_l:block_comment_mode(visible)),!,till_eol(S). 166process_stream_peeked213(S,"#!"):- !, till_eol(S). 167process_stream_peeked213(S,"%"):- !,till_eol(S). 168 169 170 171echo_format(_Fmt,_Args):- flush_output, t_l:block_comment_mode(Was),Was==invisible,!. 172echo_format(Fmt,Args):- t_l:block_comment_mode(_),t_l:echo_mode(echo_file),!,format(Fmt,Args),flush_output. 173echo_format(Fmt,Args):- t_l:echo_mode(echo_file),!,format(Fmt,Args),flush_output. 174echo_format(_Fmt,_Args). 175 176 177write_stream_item(Out,T):- 178 flush_output, 179 format(Out,'~N~n',[]), 180 must(with_output_to(Out,portray_clause_w_vars(T))), 181 format(Out,'~N~n',[]),!,flush_output(Out). 182 183 184process_script_file(File):- process_script_file(File,visit_script_term). 185process_script_file(File,Process):- open(File,read,Stream),locally_tl(each_file_term(Process),process_this_stream(Stream)),!. 186 187expand_script_directive(include(G),Pos,process_script_file(G),Pos). 188expand_script_directive(In,Pos,Out,PosOut):- expand_goal(In,Pos,Out,PosOut). 189 190:- create_prolog_flag(if_level,0,[]). 191 192if_level(L):- current_prolog_flag(if_level,IF),!,L=IF. 193 194set_if_level(0):- !, set_prolog_flag(if_level,0). 195set_if_level(1):- !, set_prolog_flag(if_level,1). 196set_if_level(N):- must(current_prolog_flag(if_level,Level)),NewLevel is Level + N, set_prolog_flag(if_level,NewLevel). 197 198:- thread_local(t_l:on_elseif/1). 199:- thread_local(t_l:on_endif/1). 200visit_if(_):- current_prolog_flag(ignoring_input,true),!,set_if_level(+ 1). 201visit_if(G):- call(G),!,set_if_level(+1), 202 asserta(t_l:on_elseif(set_prolog_flag(ignoring_input,true))), 203 asserta(t_l:on_endif(set_prolog_flag(ignoring_input,false))). 204visit_if(_):- set_if_level(+1), set_prolog_flag(ignoring_input,true), 205 asserta(t_l:on_elseif(set_prolog_flag(ignoring_input,false))), 206 asserta(t_l:on_endif(set_prolog_flag(ignoring_input,false))). 207 208do_directive(else):- if_level(0)-> (sanity(retract(t_l:on_elseif(G))),call(G)) ; true. 209do_directive(endif):- set_if_level(-1), if_level(0)-> (sanity(retract(t_l:on_endif(G))),call(G)) ; true.
216visit_script_term(:- if(G)):- !, (visit_if(G)->true;(trace,visit_if(G))). 217visit_script_term(:- else):- !, must(do_directive(else)). 218visit_script_term(:- endif):- !, must(do_directive(endif)). 219visit_script_term( end_of_file ):- !,prolog_load_context(stream,S),till_eof(S),!, 220 visit_script_term_pre_expanded(end_of_file). 221visit_script_term( _Term ):- current_prolog_flag(ignoring_input,true). 222visit_script_term( Term ):- visit_script_term_pre_expanded( Term ). 223 224skip_file_term_expand:- current_prolog_flag(ignoring_input,true),!. 225skip_file_term_expand:- current_prolog_flag(skip_file_term_expand,true). 226 227get_term_pos(Pos):- prolog_load_context(term_position,Pos),!. 228get_term_pos(_). 229 230visit_script_term_pre_expanded( Term ) :- skip_file_term_expand, 231 Term \== end_of_file,!, 232 visit_script_term_post_expanded( Term ). 233 234visit_script_term_pre_expanded( T ) :- 235 get_term_pos(Pos), !, 236 expand_term(T,Pos,Term,_), 237 visit_script_term_post_expanded( Term ). 238 239 240visit_script_term_post_expanded(T):- get_file_compiler(Pred1),!, 241 (call(doing(Pred1),T)*-> true ; print_message(warning,failed(call(Pred1,T)))). 242 243get_file_compiler(Pred1):- t_l:each_file_term(Pred1),!. 244get_file_compiler(compile_normally). 245 246directive_doing(Pred1,_,M,(?- G)):- 247 get_term_pos(Pos), M:expand_goal(G,Pos,GG,_),!, 248 M:in_space_cmt(forall(M:call(Pred1,?- GG),M:portray_one_line(G))). 249 250directive_doing(Pred1,_,M,(:- G)):- 251 get_term_pos(Pos), !, M:expand_script_directive(G,Pos,GG,_),!, 252 M:(in_space_cmt(call(Pred1,( :- GG)))*-> true ; print_message(warning,failed(GG))). 253 254doing(Pred1,MG):- nonvar(MG),strip_module(MG,M,G), M:directive_doing(Pred1,MG,M,G),!. 255doing(Pred1,T):- 256 term_to_clause(T,G), 257 each_doing(Pred1,G). 258 259each_doing(Pred1,G):- is_list(G),!,maplist(now_doing(Pred1),G). 260each_doing(Pred1,G):-now_doing(Pred1,G). 261 262now_doing(Pred1,MG):- nonvar(MG),strip_module(MG,M,G), M:directive_doing(Pred1,MG,M,G),!. 263now_doing(Pred1,G):- call(Pred1,G). 264 265 266get_pred_head_term(G,M:H):- \+ compound(G),!,strip_module(G,M,H). 267get_pred_head_term(( :- _) , _):- !,fail. 268get_pred_head_term(G:-_,M:H):-!,strip_module(G,M,H). 269get_pred_head_term(G,M:H):-!,strip_module(G,M,H). 270 271 272term_to_clause(T,Clause):- 273 get_term_pos(Pos), 274 (skip_file_term_expand -> expand_term(T,Pos,Term,_) ; T = Term), 275 term_to_clause2(Term,Clause). 276 277term_to_clause2(Term,Clause):- 278 '$set_source_module'(SM, SM), 279 strip_module(SM:Term, M, _Plain), 280 ( M == SM 281 -> Clause = Term 282 ; Clause = M:Term 283 ). 284 285 286compile_normally(T):- 287 term_to_clause(T,Clause), 288 compile_like_normal(Clause). 289 290compile_like_normal(Clause):- 291 source_location(File,Line), 292 % '$store_clause'('$source_location'(File, Line):Clause, File). 293 system_store_clause('$source_location'(File, Line):Clause, File). 294 295 296system_store_clause(A, C) :- 297 '$clause_source'(A, B, D), 298 '$compile_term'(B, _, C, D). 299 300 301 302 303compile_dynamic(MG):- strip_module(MG,M,G), compile_dynamic(M,G). 304compile_dynamic(M, ?- G):-!, M:compile_like_normal(?- M:G). 305compile_dynamic(M, :- G):-!, M:compile_like_normal(:- M:G). 306compile_dynamic(M, G):- 307 (M:get_pred_head_term(G,H)->maybe_dynamic(M,H);true),!, 308 M:compile_like_normal(M:G). 309 310maybe_dynamic(M,H):- predicate_property(M:H,static),!. 311maybe_dynamic(M,H):- predicate_property(M:H,dynamic),!. 312maybe_dynamic(M,H):- M:dynamic(M:H). 313 314 315 316:- fixup_exports.
script_files
Prolog source-code will echo while running
*/