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