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