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]).

script_files

Prolog source-code will echo while running

*/

   27% :- meta_predicate(process_this_script_now()).
   28% :- meta_predicate(process_stream(+)).
   29:- meta_predicate(visit_script_term(*)).   30:- meta_predicate(visit_if(0)).   31:- meta_predicate(in_space_cmt(0)).   32
   33% % % OFF :- system:use_module('../file_scope').
   34:- module_transparent(process_this_script_now/0).   35:- module_transparent(process_this_script/0).   36:- module_transparent(process_stream/1).   37:- module_transparent(process_this_stream/1).   38:- module_transparent(process_script_file/1).   39:- module_transparent(visit_script_term/1).   40:- module_transparent(in_space_cmt/1).   41
   42:- thread_local(t_l:each_file_term/1).   43:- thread_local(t_l:block_comment_mode/1).   44:- thread_local(t_l:echo_mode/1).   45
   46:- meta_predicate now_doing(1,?).   47:- meta_predicate each_doing(1,?).   48:- meta_predicate doing(1,*).   49
   50
   51till_eof(In) :-
   52        repeat,
   53            (   at_end_of_stream(In)
   54            ->  !
   55            ;   (read_pending_codes(In, Chars, []),
   56                (t_l:echo_mode(echo_file) ->
   57                  echo_format('~s',[Chars]);
   58                  true),
   59                fail)
   60            ).
 process_this_script is det
Process This Script.

Echoing the file

Same as :- process_this_script_with(compile_normally, echo_file).

   72process_this_script:- 
   73   assert_until_eof(t_l:echo_mode(echo_file)),
   74   process_this_script_now.
 process_this_script_with(:Pred1) is det
Process This Script with :Pred1

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).

  102process_this_script_with(Pred1):- 
  103   process_this_script_with(Pred1, skip(_)).
 process_this_script_with(:Pred1, +Echo) is det
Process This Script with :Pred1 echo Echo

Echo may be file, skip(_) or skip(items)

  112process_this_script_with(Pred1,Echo):- 
  113   (atom(Pred1)->assertion(current_predicate(Pred1/1));true),
  114   assert_until_eof(t_l:each_file_term(Pred1)),
  115   assert_until_eof(t_l:echo_mode(Echo)),
  116   process_this_script_now.
Process This Script with :Pred1 echo Echo

Same as :- process_this_script_with(compile_normally, skip(_)).

  127process_this_script_now:- current_prolog_flag(xref,true),!.
  128process_this_script_now:- prolog_load_context(stream,S) -> process_this_stream(S) ; assertion(prolog_load_context(stream,_)).
  129
  130process_this_stream(S):- 
  131  repeat,
  132  once(process_stream(S)),
  133  at_end_of_stream(S).
  134
  135% in_space_cmt(Goal):- call_cleanup(prepend_each_line(' % ',Goal),echo_format('~N',[])).
  136in_space_cmt(Goal):- setup_call_cleanup(echo_format('~N /*~n',[]),Goal,echo_format('~N*/~n',[])).
  137
  138
  139till_eol(S):- read_line_to_string(S,String),
  140  (t_l:echo_mode(skip(_))->true ; (echo_format('~N~s~n',[String]))).
 process_stream(?S) is det
Process file stream input
  149process_stream(S):- at_end_of_stream(S),!,visit_script_term_pre_expanded(end_of_file).
  150process_stream(S):- peek_code(S,W),char_type(W,end_of_line),!,get_code(S,W),echo_format('~s',[[W]]).
  151process_stream(S):- (peek_string(S,2,W);peek_string(S,1,W);peek_string(S,3,W)),process_stream_peeked213(S,W),!.
  152process_stream(S):- peek_code(S,W),char_type(W,white),\+ char_type(W,end_of_line),get_code(S,W),echo_format('~s',[[W]]),!.
  153
  154process_stream(S):- must((read_term(S,T,[variable_names(Vs)]),put_variable_names( Vs))),
  155  call(b_setval,'$variable_names',Vs), b_setval('$term',T), 
  156  (t_l:echo_mode(skip(items)) -> true ; write_stream_item(user_error,T)),!,
  157  flush_output(user_error),
  158  must(visit_script_term(T)),!,
  159  echo_format('~N',[]),!.
  160
  161process_stream_peeked213(S,W):- t_l:block_comment_mode(Was)->
  162  ((W=="*/")->((retract(t_l:block_comment_mode(Was))));true),!,
  163  till_eol(S).
  164process_stream_peeked213(S," /*"):- asserta(t_l:block_comment_mode(invisible)),!,!,till_eol(S).
  165process_stream_peeked213(S," %"):- !, read_line_to_string(S,_).
  166process_stream_peeked213(S,"/*"):- !, asserta(t_l:block_comment_mode(visible)),!,till_eol(S).
  167process_stream_peeked213(S,"#!"):- !, till_eol(S).
  168process_stream_peeked213(S,"%"):- !,till_eol(S).
  169
  170
  171
  172echo_format(_Fmt,_Args):- flush_output, t_l:block_comment_mode(Was),Was==invisible,!.
  173echo_format(Fmt,Args):- t_l:block_comment_mode(_),t_l:echo_mode(echo_file),!,format(Fmt,Args),flush_output.
  174echo_format(Fmt,Args):- t_l:echo_mode(echo_file),!,format(Fmt,Args),flush_output.
  175echo_format(_Fmt,_Args).
  176
  177
  178write_stream_item(Out,T):- 
  179  flush_output,
  180  format(Out,'~N~n',[]),
  181  must(with_output_to(Out,portray_clause_w_vars(T))),
  182  format(Out,'~N~n',[]),!,flush_output(Out).
  183
  184
  185process_script_file(File):- process_script_file(File,visit_script_term).
  186process_script_file(File,Process):- open(File,read,Stream),locally_tl(each_file_term(Process),process_this_stream(Stream)),!.
  187
  188expand_script_directive(include(G),Pos,process_script_file(G),Pos).
  189expand_script_directive(In,Pos,Out,PosOut):- expand_goal(In,Pos,Out,PosOut).
  190
  191:- create_prolog_flag(if_level,0,[]).  192
  193if_level(L):- current_prolog_flag(if_level,IF),!,L=IF.
  194
  195set_if_level(0):- !, set_prolog_flag(if_level,0).
  196set_if_level(1):- !, set_prolog_flag(if_level,1).
  197set_if_level(N):- must(current_prolog_flag(if_level,Level)),NewLevel is Level + N, set_prolog_flag(if_level,NewLevel).
  198
  199:- thread_local(t_l:on_elseif/1).  200:- thread_local(t_l:on_endif/1).  201visit_if(_):- current_prolog_flag(ignoring_input,true),!,set_if_level(+ 1).
  202visit_if(G):- call(G),!,set_if_level(+1), 
  203    asserta(t_l:on_elseif(set_prolog_flag(ignoring_input,true))),
  204    asserta(t_l:on_endif(set_prolog_flag(ignoring_input,false))).
  205visit_if(_):- set_if_level(+1), set_prolog_flag(ignoring_input,true),
  206    asserta(t_l:on_elseif(set_prolog_flag(ignoring_input,false))),
  207    asserta(t_l:on_endif(set_prolog_flag(ignoring_input,false))).
  208
  209do_directive(else):- if_level(0)-> (sanity(retract(t_l:on_elseif(G))),call(G)) ; true.
  210do_directive(endif):- set_if_level(-1), if_level(0)-> (sanity(retract(t_l:on_endif(G))),call(G)) ; true.
 visit_script_term(+Pos, +Term, +Vs) is det
Process A Script Term.
  217visit_script_term(:- if(G)):- !, (visit_if(G)->true;(trace,visit_if(G))).
  218visit_script_term(:- else):- !, must(do_directive(else)).
  219visit_script_term(:- endif):- !, must(do_directive(endif)).
  220visit_script_term( end_of_file ):- !,prolog_load_context(stream,S),till_eof(S),!,
  221  visit_script_term_pre_expanded(end_of_file).
  222visit_script_term( _Term ):- current_prolog_flag(ignoring_input,true).
  223visit_script_term( Term ):- visit_script_term_pre_expanded( Term ).
  224
  225skip_file_term_expand:- current_prolog_flag(ignoring_input,true),!.
  226skip_file_term_expand:- current_prolog_flag(skip_file_term_expand,true).
  227
  228get_term_pos(Pos):- prolog_load_context(term_position,Pos),!.
  229get_term_pos(_).
  230
  231visit_script_term_pre_expanded( Term ) :- skip_file_term_expand,
  232   Term \== end_of_file,!,
  233   visit_script_term_post_expanded( Term ).
  234
  235visit_script_term_pre_expanded( T ) :-
  236     get_term_pos(Pos), !,
  237     expand_term(T,Pos,Term,_),
  238     visit_script_term_post_expanded( Term ).
  239
  240
  241visit_script_term_post_expanded(T):- get_file_compiler(Pred1),!,
  242   (call(doing(Pred1),T)*-> true ; print_message(warning,failed(call(Pred1,T)))).
  243
  244get_file_compiler(Pred1):- t_l:each_file_term(Pred1),!.
  245get_file_compiler(compile_normally).
  246
  247directive_doing(Pred1,_,M,(?- G)):-
  248   get_term_pos(Pos), M:expand_goal(G,Pos,GG,_),!, 
  249   M:in_space_cmt(forall(M:call(Pred1,?- GG),M:portray_one_line(G))).
  250
  251directive_doing(Pred1,_,M,(:- G)):-
  252  get_term_pos(Pos), !, M:expand_script_directive(G,Pos,GG,_),!,
  253  M:(in_space_cmt(call(Pred1,( :- GG)))*-> true ; print_message(warning,failed(GG))).
  254
  255doing(Pred1,MG):- nonvar(MG),strip_module(MG,M,G), M:directive_doing(Pred1,MG,M,G),!.
  256doing(Pred1,T):-
  257  term_to_clause(T,G),
  258   each_doing(Pred1,G).
  259
  260each_doing(Pred1,G):- is_list(G),!,maplist(now_doing(Pred1),G).
  261each_doing(Pred1,G):-now_doing(Pred1,G).
  262
  263now_doing(Pred1,MG):- nonvar(MG),strip_module(MG,M,G), M:directive_doing(Pred1,MG,M,G),!.
  264now_doing(Pred1,G):- call(Pred1,G).
  265
  266
  267get_pred_head_term(G,M:H):- \+ compound(G),!,strip_module(G,M,H).
  268get_pred_head_term(( :- _) , _):- !,fail.
  269get_pred_head_term(G:-_,M:H):-!,strip_module(G,M,H).
  270get_pred_head_term(G,M:H):-!,strip_module(G,M,H).
  271
  272
  273term_to_clause(T,Clause):- 
  274   get_term_pos(Pos),
  275   (skip_file_term_expand -> expand_term(T,Pos,Term,_) ; T = Term),
  276   term_to_clause2(Term,Clause).
  277
  278term_to_clause2(Term,Clause):-
  279   '$set_source_module'(SM, SM),
  280   strip_module(SM:Term, M, _Plain),
  281    (   M == SM
  282    ->  Clause = Term
  283    ;   Clause = M:Term
  284    ).
  285
  286
  287compile_normally(T):- 
  288   term_to_clause(T,Clause),
  289   compile_like_normal(Clause).
  290
  291compile_like_normal(Clause):- 
  292    source_location(File,Line),
  293    % '$store_clause'('$source_location'(File, Line):Clause, File).
  294    system_store_clause('$source_location'(File, Line):Clause, File).
  295
  296
  297system_store_clause(A, C) :-
  298        '$clause_source'(A, B, D),
  299        '$compile_term'(B, _, C, D).
  300
  301
  302
  303
  304compile_dynamic(MG):- strip_module(MG,M,G), compile_dynamic(M,G).
  305compile_dynamic(M, ?- G):-!, M:compile_like_normal(?- M:G).
  306compile_dynamic(M, :- G):-!, M:compile_like_normal(:- M:G).
  307compile_dynamic(M, G):- 
  308 (M:get_pred_head_term(G,H)->maybe_dynamic(M,H);true),!,
  309  M:compile_like_normal(M:G).
  310
  311maybe_dynamic(M,H):- predicate_property(M:H,static),!.
  312maybe_dynamic(M,H):- predicate_property(M:H,dynamic),!.
  313maybe_dynamic(M,H):- M:dynamic(M:H).
  314
  315
  316
  317:- fixup_exports.