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 this_script_begin/0, 17 this_script_ends/0, 18 process_script_file/0, 19 process_script_file/1, 20 process_script_file/2, 21 process_stream/1, 22 visit_script_term/1]).

Utility LOGICMOO_PREDICATE_STREAMS

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

Prolog source-code will echo while running

33:- reexport(echo_source_files). 34 35:- set_module(class(library)). 36 37:- use_module(library(occurs)). 38:- use_module(library(gensym)). 39:- use_module(library(when)). 40 41:- use_module(library(occurs)). 42:- use_module(library(gensym)). 43:- use_module(library(when)). 44 45 46:- use_module(library(backcomp)). 47:- use_module(library(codesio)). 48:- use_module(library(charsio)). 49:- use_module(library(debug)). 50:- use_module(library(check)). 51 52 53:- use_module(library(edinburgh)). 54:- use_module(library(debug)). 55:- use_module(library(prolog_stack)). 56:- use_module(library(make)). 57 58 59% :- use_module(library(gui_tracer)). 60:- use_module(library(system)). 61:- use_module(library(socket)). 62:- use_module(library(readutil)). 63:- abolish(system:time/1). 64:- use_module(library(statistics)). 65:- use_module(library(ssl)). 66:- use_module(library(prolog_codewalk)). 67:- use_module(library(prolog_source)). 68:- use_module(library(date)). 69%:- use_module(library(editline)). 70:- use_module(library(listing)). 71 72% :- meta_predicate(process_script_file()). 73% :- meta_predicate(process_stream(+)). 74:- meta_predicate(visit_script_term(*)). 75:- meta_predicate(visit_if(0)). 76:- meta_predicate(in_space_cmt(0)). 77:- meta_predicate(now_doing(1,?)). 78:- meta_predicate each_doing(1,?). 79:- meta_predicate doing(1,*). 80 81 82% % % OFF :- system:use_module('../file_scope'). 83:- module_transparent(process_script_file/0). 84:- module_transparent(this_script_begin/0). 85:- module_transparent(process_stream/1). 86:- module_transparent(process_this_stream/1). 87:- module_transparent(process_script_file/1). 88:- module_transparent(visit_script_term/1). 89:- module_transparent(in_space_cmt/1). 90 91:- thread_local(t_l:each_file_term/1). 92:- thread_local(t_l:quit_processing_stream/1). 93:- thread_local(t_l:block_comment_mode/1). 94:- thread_local(t_l:echo_mode/1). 95 96is_echo_mode(Mode):- t_l:echo_mode(Cur),!,Mode=Cur. 97is_echo_mode(skip(_)). 98 99till_eof(In) :- 100 repeat, 101 ( at_end_of_stream(In) 102 -> ! 103 ; (read_pending_codes(In, Chars, []), 104 (is_echo_mode(echo_file) -> 105 echo_format('~s',[Chars]); 106 true), 107 fail) 108 ).

181process_script_file:- 182 prolog_load_context(stream,S) -> process_this_stream(S) ; assertion(prolog_load_context(stream,_)). 183 184 185process_this_stream(S):- 186 repeat, 187 once(process_stream(S)), 188 done_processing_stream(S), 189 retractall(t_l:quit_processing_stream(S)). 190 191done_processing_stream(S):- t_l:quit_processing_stream(S),!. 192done_processing_stream(S):- at_end_of_stream(S). 193 194% in_space_cmt(Goal):- call_cleanup(prepend_each_line(' % ',Goal),echo_format('~N',[])). 195in_space_cmt(Goal):- setup_call_cleanup(echo_format('~N /*~n',[]),Goal,echo_format('~N*/~n',[])). 196 197 198till_eol(S):- read_line_to_string(S,String), 199 (is_echo_mode(skip(_))->true ; (echo_format('~N~s~n',[String]))).

208process_stream(S):- at_end_of_stream(S),!,visit_script_term_pre_expanded(end_of_file). 209process_stream(S):- peek_code(S,W),char_type(W,end_of_line),!,get_code(S,W),echo_format('~s',[[W]]). 210process_stream(S):- (peek_string(S,2,W);peek_string(S,1,W);peek_string(S,3,W)),process_stream_peeked213(S,W),!. 211process_stream(S):- peek_code(S,W),char_type(W,white),\+ char_type(W,end_of_line),get_code(S,W),echo_format('~s',[[W]]),!. 212 213process_stream(S):- must((read_term(S,T,[variable_names(Vs)]),put_variable_names( Vs))), 214 call(b_setval,'$variable_names',Vs), b_setval('$term',T), 215 (is_echo_mode(skip(items)) -> true ; write_stream_item(user_error,T)),!, 216 flush_output(user_error), 217 must(visit_script_term(T)),!, 218 echo_format('~N',[]),!. 219 220process_stream_peeked213(S,W):- t_l:block_comment_mode(Was)-> 221 ((W=="*/")->((retract(t_l:block_comment_mode(Was))));true),!, 222 till_eol(S). 223process_stream_peeked213(S," /*"):- asserta(t_l:block_comment_mode(invisible)),!,!,till_eol(S). 224process_stream_peeked213(S," %"):- !, read_line_to_string(S,_). 225process_stream_peeked213(S,"/*"):- !, asserta(t_l:block_comment_mode(visible)),!,till_eol(S). 226process_stream_peeked213(S,"#!"):- !, till_eol(S). 227process_stream_peeked213(S,"%"):- !,till_eol(S). 228 229 230 231echo_format(_Fmt,_Args):- flush_output, t_l:block_comment_mode(Was),Was==invisible,!. 232echo_format(Fmt,Args):- t_l:block_comment_mode(_),is_echo_mode(echo_file),!,format(Fmt,Args),flush_output. 233echo_format(Fmt,Args):- is_echo_mode(echo_file),!,format(Fmt,Args),flush_output. 234echo_format(_Fmt,_Args). 235 236 237write_stream_item(Out,T):- 238 flush_output, 239 format(Out,'~N~n',[]), 240 must(with_output_to(Out,portray_clause_w_vars(T))), 241 format(Out,'~N~n',[]),!,flush_output(Out). 242 243 244process_script_file(File):- process_script_file(File,visit_script_term). 245process_script_file(File,Process):- open(File,read,Stream), 246 locally(tl:each_file_term(Process), process_this_stream(Stream)),!. 247 248expand_script_directive(include(G),Pos,process_script_file(G),Pos). 249expand_script_directive(In,Pos,Out,PosOut):- expand_goal(In,Pos,Out,PosOut). 250 251:- create_prolog_flag(if_level,0,[]). 252 253if_level(L):- current_prolog_flag(if_level,IF),!,L=IF. 254 255set_if_level(0):- !, set_prolog_flag(if_level,0). 256set_if_level(1):- !, set_prolog_flag(if_level,1). 257set_if_level(N):- must(current_prolog_flag(if_level,Level)),NewLevel is Level + N, set_prolog_flag(if_level,NewLevel). 258 259:- thread_local(t_l:on_elseif/1). 260:- thread_local(t_l:on_endif/1). 261visit_if(_):- current_prolog_flag(ignoring_input,true),!,set_if_level(+ 1). 262visit_if(G):- call(G),!,set_if_level(+1), 263 asserta(t_l:on_elseif(set_prolog_flag(ignoring_input,true))), 264 asserta(t_l:on_endif(set_prolog_flag(ignoring_input,false))). 265visit_if(_):- set_if_level(+1), set_prolog_flag(ignoring_input,true), 266 asserta(t_l:on_elseif(set_prolog_flag(ignoring_input,false))), 267 asserta(t_l:on_endif(set_prolog_flag(ignoring_input,false))). 268 269do_directive(else):- if_level(0)-> (sanity(retract(t_l:on_elseif(G))),call(G)) ; true. 270do_directive(endif):- set_if_level(-1), if_level(0)-> (sanity(retract(t_l:on_endif(G))),call(G)) ; true.

277visit_script_term(:- if(G)):- !, (visit_if(G)->true;(trace,visit_if(G))). 278visit_script_term(:- else):- !, must(do_directive(else)). 279visit_script_term(:- endif):- !, must(do_directive(endif)). 280visit_script_term( end_of_file ):- !,prolog_load_context(stream,S),till_eof(S),!, 281 visit_script_term_pre_expanded(end_of_file). 282visit_script_term( _Term ):- current_prolog_flag(ignoring_input,true). 283visit_script_term( Term ):- visit_script_term_pre_expanded( Term ). 284 285skip_file_term_expand:- current_prolog_flag(ignoring_input,true),!. 286skip_file_term_expand:- current_prolog_flag(skip_file_term_expand,true). 287 288get_term_pos(Pos):- prolog_load_context(term_position,Pos),!. 289get_term_pos(_). 290 291visit_script_term_pre_expanded( Term ) :- skip_file_term_expand, 292 Term \== end_of_file,!, 293 visit_script_term_post_expanded( Term ). 294 295visit_script_term_pre_expanded( T ) :- 296 get_term_pos(Pos), !, 297 expand_term(T,Pos,Term,_), 298 visit_script_term_post_expanded( Term ). 299 300 301visit_script_term_post_expanded(T):- get_file_compiler(Pred1),!, 302 (call(doing(Pred1),T)*-> true ; print_message(warning,failed(call(Pred1,T)))). 303 304get_file_compiler(Pred1):- t_l:each_file_term(Pred1),!. 305get_file_compiler(compile_normally). 306 307directive_doing(Pred1,_,M,(?- G)):- 308 get_term_pos(Pos), M:expand_goal(G,Pos,GG,_),!, 309 M:in_space_cmt(forall(M:call(Pred1,?- GG),M:portray_one_line(G))). 310 311directive_doing(Pred1,_,M,(:- G)):- 312 get_term_pos(Pos), !, M:expand_script_directive(G,Pos,GG,_),!, 313 M:(in_space_cmt(call(Pred1,( :- GG)))*-> true ; print_message(warning,failed(GG))). 314 315doing(Pred1,MG):- nonvar(MG),strip_module(MG,M,G), M:directive_doing(Pred1,MG,M,G),!. 316doing(Pred1,T):- 317 term_to_clause(T,G), 318 each_doing(Pred1,G). 319 320each_doing(Pred1,G):- is_list(G),!,maplist(now_doing(Pred1),G). 321each_doing(Pred1,G):-now_doing(Pred1,G). 322 323now_doing(Pred1,MG):- nonvar(MG),strip_module(MG,M,G), M:directive_doing(Pred1,MG,M,G),!. 324now_doing(Pred1,G):- call(Pred1,G). 325 326 327get_pred_head_term(G,M:H):- \+ compound(G),!,strip_module(G,M,H). 328get_pred_head_term(( :- _) , _):- !,fail. 329get_pred_head_term(G:-_,M:H):-!,strip_module(G,M,H). 330get_pred_head_term(G,M:H):-!,strip_module(G,M,H). 331 332 333term_to_clause(T,Clause):- 334 get_term_pos(Pos), 335 (skip_file_term_expand -> expand_term(T,Pos,Term,_) ; T = Term), 336 term_to_clause2(Term,Clause). 337 338term_to_clause2(Term,Clause):- 339 '$set_source_module'(SM, SM), 340 strip_module(SM:Term, M, _Plain), 341 ( M == SM 342 -> Clause = Term 343 ; Clause = M:Term 344 ). 345 346 347compile_normally(T):- 348 term_to_clause(T,Clause), 349 compile_like_normal(Clause). 350 351compile_like_normal(Clause):- 352 source_location(File,Line), 353 % '$store_clause'('$source_location'(File, Line):Clause, File). 354 system_store_clause('$source_location'(File, Line):Clause, File). 355 356 357system_store_clause(A, C) :- 358 '$clause_source'(A, B, D), 359 '$compile_term'(B, _, C, D). 360 361 362 363 364compile_dynamic(MG):- strip_module(MG,M,G), compile_dynamic(M,G). 365compile_dynamic(M, ?- G):-!, M:compile_like_normal(?- M:G). 366compile_dynamic(M, :- G):-!, M:compile_like_normal(:- M:G). 367compile_dynamic(M, G):- 368 (M:get_pred_head_term(G,H)->maybe_dynamic(M,H);true),!, 369 M:compile_like_normal(M:G). 370 371maybe_dynamic(M,H):- predicate_property(M:H,static),!. 372maybe_dynamic(M,H):- predicate_property(M:H,dynamic),!. 373maybe_dynamic(M,H):- functor(H,F,A),M:dynamic(M:F/A). 374 375 376 377% :- fixup_exports.