1/* Part of LogicMOO Base bb_env
    2% Provides a prolog database *env*
    3% ===================================================================
    4% File 'clause_expansion.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: 'clause_expansion.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: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/clause_expansion.pl
   15:- module(subclause_expansion, [save_pred_to/2]).

Prolog compile-time and runtime source-code transformations

This module specifies a set of more specialized term and goal expansions

as they are read from a file before they are processed by the compiler.

The toplevel is expand_clause/2. This uses other translators:

Note that this ordering implies that conditional compilation directives cannot be generated by clause_expansion/2 rules: they must literally appear in the source-code.

*/

   34:- set_module(class(library)).   35:- use_module(library(apply)).   36
   37:- create_prolog_flag(subclause_expansion,true,[keep(true)]).   38
   39
   40:- dynamic(sce:buffer_clauses/5).   41:- volatile(sce:buffer_clauses/5).   42
   43mst(G):- catch((G*->true;writeln(failed_mst(G))),_E,writeln(err(G))).
   44
   45call_pred_to(Where,List):-is_list(List),!,maplist(call_pred_to(Where),List).
   46call_pred_to(Where,F/A):- call_pred_to(Where,_:F/A).
   47call_pred_to(Where,M:F/A):- ground(F/A),functor(P,F,A),call_pred_to(Where,M:P).
   48call_pred_to(Where,M:F/A):- forall(current_predicate(F/A),((functor(P,F,A),call_pred_to(Where,M:P)))).
   49call_pred_to(Where,M:P):-var(M),!,forall(current_module(M),call_pred_to(Where,M:P)).
   50call_pred_to(Where,M:P):-!,call(Where,M,P).
   51call_pred_to(Where,P):-forall(current_module(M),call_pred_to(Where,M:P)).
   52
   53
   54save_pred_to(Where,Each):-
   55  call_pred_to(save_pred_to_Act(Where),Each).
   56
   57save_pred_to_Act(Where,M,P):-
   58  forall(clause(M:P,_,Ref), 
   59    (sce:buffer_clauses(Where,M,_,_,Ref)-> true;
   60     ( ((clause(H,B,Ref), (clause_property(Ref,module(_))->true;throw( clause(H,B,Ref))),
   61    ignore(((clause_property(Ref,module(M)),assert(sce:buffer_clauses(Where,M,H,B,Ref)),true)))))))).
   62
   63erase_except(Where,Each):-
   64  call_pred_to(erase_except_Act(Where),Each).
   65
   66erase_except_Act(Where,M,P):-
   67    forall(clause(M:P,_,Ref), 
   68    ((clause(HH,BB,Ref), 
   69     (clause_property(Ref,module(_))->true;throw( clause(HH,BB,Ref))),
   70     ignore(((clause_property(Ref,module(M)),\+ (sce:buffer_clauses(Where,M,HH,BB,Ref)),
   71              % writeln(erase(HH,BB,Ref)),
   72              set_prolog_flag(access_level,system),
   73              catch(M:erase(Ref),_E,mst(M:retract((HH:-BB)))))))))).
   74
   75restore_preds(Where):-
   76 forall(sce:buffer_clauses(Where,M,H,B,Ref),
   77    (M:clause(H,B,Ref)->true; M:assert(H,B))).
   78 
   79
   80erase_preds(Where):-
   81 forall(sce:buffer_clauses(Where,M,H,B,Ref),
   82    (M:clause(H,B,Ref)->erase(Ref);true)).
   83 
   84
   85
   86:- save_pred_to(load_expansion,[term_expansion/2,term_expansion/4,goal_expansion/2,goal_expansion/4]).   87
   88
   89% :- listing(sce:buffer_clauses/5).
   90
   91:- if( \+ current_predicate(system:each_call_cleanup/3)).   92:- use_module(system:library(logicmoo/each_call)).   93:- endif.   94
   95:- set_module(class(library)).   96
   97:- multifile((system:clause_expansion/2,
   98              system:directive_expansion/2,
   99              system:file_body_expansion/3)).  100:- dynamic((  system:clause_expansion/2,
  101              system:directive_expansion/2,
  102              system:file_body_expansion/3)).  103
  104/*
  105:- multifile((user:clause_expansion/2,
  106              user:directive_expansion/2,
  107              user:file_body_expansion/3)).
  108:- dynamic((  user:clause_expansion/2,
  109              user:directive_expansion/2,
  110              user:file_body_expansion/3)).
  111*/
  112
  113:- meta_predicate without_subclause_expansion(0).  114
  115% with_subclause_expansion(Goal):- current_prolog_flag(subclause_expansion,true),!,call(Goal).
  116with_subclause_expansion(Goal):- locally(set_prolog_flag(subclause_expansion,true),Goal).
  117
  118% without_subclause_expansion(Goal):- current_prolog_flag(subclause_expansion,false),!,call(Goal).
  119without_subclause_expansion(Goal):- locally(set_prolog_flag(subclause_expansion,false),Goal).
  120
  121:- multifile(system:goal_expansion/4).  122:- dynamic(system:goal_expansion/4).  123:- multifile(system:term_expansion/4).  124:- dynamic(system:term_expansion/4).  125
  126
  127:- nb_setval( '$term_user',[]).  128:- initialization(nb_setval( '$term_user',[]),restore).  129:- initialization(nb_setval( '$term_position',[]),restore).  130:- initialization(nb_setval( '$term',[]),restore).  131
  132
  133call_expansion_from(From, Type, In, Out):-
  134   functor(Type,F,A),APlus2 is A + 2,
  135  '$def_modules'(From:[F/APlus2], MList),
  136   call_expansions(MList,Type,[], In,  Out).
  137
  138:- module_transparent(call_expansion_from/4).  139
  140call_expansions([],_,_, InOut, InOut).
  141call_expansions([M-_|T], Type,Completed, In, Out) :- 
  142  ((\+ memberchk(M,Completed), M:call(M:Type, In, Mid)) -> true ; In = Mid),
  143 call_expansions(T, Type,[M|Completed], Mid, Out).
  144
  145:- module_transparent(call_expansions/5).  146
  147% directive_expansion
  148file_expansion(From,Term,(:- DirIn),(:- DirOut)):-
  149   (Term == (:- DirIn)) -> 
  150   call_expansion_from(From,directive_expansion,DirIn, DirOut),!.
  151
  152% clause_expansion
  153file_expansion(From,Term,In,Out):- 
  154   Term == In ->  call_expansion_from(From,clause_expansion,In,Out),!.
  155
  156% file_body_expansion
  157file_expansion(From,Term,(Head:-In),(Head:-Out)):-
  158   Term == (Head:-In) ->  call_expansion_from(From,file_body_expansion(Head),In,Out),!.
  159
  160:- module_transparent(file_expansion/4).  161
  162
  163subclause_term_expansion(In,Pos,Out):-   
  164  notrace(\+ current_prolog_flag(subclause_expansion,false)),
  165  \+ current_prolog_flag(xref,true),
  166  nonvar(Pos),nonvar(In),
  167  nb_current('$term',FileTerm),
  168  prolog_load_context(module,From),
  169  file_expansion(From,FileTerm,In,FileTermOut),!, In\=@=FileTermOut,
  170  %\+ current_prolog_flag(xref,true),
  171  Out=FileTermOut,
  172  b_setval('$term',FileTermOut).
  173
  174
  175system:term_expansion(In,Pos,Out,PosOut):- In\==end_of_file, 
  176   subclause_term_expansion(In,Pos,Out)->PosOut=Pos.
  177user:term_expansion(In,Pos,_,_):- nonvar(Pos), nb_setval('$term_user',In),fail.
  178
  179/*
  180system:file_body_expansion(Head,I,_):- current_prolog_flag(show_expanders,true),dmsg(system:file_body_expansion(Head:-I)),fail.
  181system:clause_expansion(I,_):- current_prolog_flag(show_expanders,true),dmsg(system:clause_expansion(I)),fail.
  182system:directive_expansion(I,_):-  current_prolog_flag(show_expanders,true),dmsg(system:directive_expansion(I)),fail.
  183:- set_prolog_flag(show_expanders,true).
  184*/
  185
  186:- fixup_exports.