11
12:- module(parser_sharing,[
13 op(1150,fx,(share_mp)),
14 op(1150,fx,(shared_parser_data)),
15 op(1150,fx,(dynamic_multifile_exported))]). 16
18
20
21:- user:ensure_loaded(library(poor_bugger)). 22
23
24:- module_transparent(only_pfc/1). 25only_pfc(P):- assertion(ignore(ground(P))), !.
26:- module_transparent(only_if_pfc/1). 27only_if_pfc(_):- fail.
28:- module_transparent(only_if_adv/1). 29only_if_adv(P):- call(P).
30
31
32:- module_transparent(each_parser_module_1/1). 33each_parser_module(M):- no_repeats(each_parser_module_0(M)).
34:- module_transparent(each_parser_module_0/1). 35each_parser_module_0(baseKB).
36each_parser_module_0(parser_shared).
37each_parser_module_0(parser_all).
38each_parser_module_0(M):- each_parser_module_1(E),default_module(E,M).
40:- module_transparent(each_parser_module/1). 41each_parser_module_1(M):- strip_module(_,M,_).
42each_parser_module_1(M):- '$current_source_module'(M).
43each_parser_module_1(M):- '$current_typein_module'(M).
44
45:- module_transparent(predicate_visible_home/2). 46predicate_visible_home(H,M):- predicate_property(H,imported_from(M)),!.
47predicate_visible_home(H,M):- predicate_property(H,defined),strip_module(H,M,_), \+ predicate_property(H,imported_from(_)),!.
48predicate_visible_home(H,M):- each_parser_module(M),predicate_property(M:H,defined), \+ predicate_property(M:H,imported_from(_)),!.
49
50:- module_transparent(pi_p/2). 51pi_p(X,_):- \+ compound(X),!,fail.
52pi_p('//'(F,A),P):-!,atom(F),integer(A),AA is A +2,functor(P,F,AA).
53pi_p(F/A,P):- !,atom(F),integer(A),functor(P,F,A).
54pi_p(M:PI,M:P):-!,pi_p(PI,P).
55
56:- module_transparent(pi_2_p/2). 57pi_2_p(P,P):- \+ callable(P),!.
58pi_2_p(M:I,M:I):-!.
59pi_2_p(I,M:I):- pi_p(I,P),predicate_visible_home(P,M),!.
60pi_2_p(P,P).
61
62
63pi_splits(X,_,_):- \+ compound(X),!,fail.
64pi_splits([X,Y],X,Y):-!.
65pi_splits([],nil,nil):-!.
66pi_splits([X],X,nil):-!.
67pi_splits([X|Y],X,Y):-!,nonvar(X).
68pi_splits((X,Y),X,Y):-!.
69pi_splits(M:XY,M:X,M:Y):- pi_splits(XY,X,Y),!.
70
71
72:- op(1150,fx,user:(share_mp)). 73:- op(1150,fx,baseKB:(share_mp)). 74
75:- module_transparent((share_mp)/1). 76share_mp(nil):- !.
77share_mp(XY):- pi_splits(XY,X,Y),!,share_mp(X),share_mp(Y).
78share_mp(XY):- pi_p(XY,PI),!,share_mp(PI).
79share_mp(MP):- strip_module(MP,M,P),share_mp(M,P).
80
81import_and_export(CM,M:F/A):-
82 (CM\==M-> CM:import(M:F/A) ; true),
83 CM:export(M:F/A),!.
84
85
86:- module_transparent((share_mp)/2). 87share_mp(_,nil):-!.
88share_mp(M,XY):- pi_splits(XY,X,Y),!,share_mp(M,X),share_mp(M,Y).
89share_mp(CM,(M:P)):- !, atom(M),share_mp(M,P),(CM==M->true;import_and_export(CM,M:P)).
90share_mp(M,PI):- pi_p(PI,P)->PI\==P,!,share_mp(M,P).
91share_mp(M,P):- functor(P,F,A), MFA=M:F/A,
92 (M:multifile(M:MFA)),
93 (M:module_transparent(MFA)),
94 (M:export(MFA)),
95 (M:public(MFA)),
96 import_and_export(parser_sharing,MFA),
97 import_and_export(parser_all,MFA),
98 '$current_source_module'(SM),import_and_export(SM,MFA),
99 '$current_typein_module'(CM),import_and_export(CM,MFA),
100 import_and_export(system,MFA),
101 !.
102
103:- share_mp((share_mp)/1). 104:- share_mp((share_mp)/2). 105
106
107:- op(1150,fx,user:(shared_parser_data)). 108:- op(1150,fx,baseKB:(shared_parser_data)). 109:- module_transparent((shared_parser_data)/1). 110
111shared_parser_data(XY):- assertion(compound(XY)),fail.
112shared_parser_data(XY):- pi_splits(XY,X,Y),!,shared_parser_data(X),shared_parser_data(Y).
113shared_parser_data(XY):- pi_p(XY,PI)-> XY\==PI,!,shared_parser_data(PI).
114shared_parser_data(MP):- predicate_visible_home(MP,M)->strip_module(MP,Imp,P),MP\==M:P,!,shared_parser_data(M:P),Imp:import(M:P).
115shared_parser_data(M:P):- !,def_parser_data(M,P),strip_module(_,Imp,_), Imp:import(M:P).
117shared_parser_data(P):- prolog_load_context(module,SM),!,shared_parser_data(SM:P).
119:- share_mp((shared_parser_data)/1). 120
121
122:- op(1150,fx,user:(dynamic_multifile_exported)). 123:- op(1150,fx,baseKB:(dynamic_multifile_exported)). 124:- module_transparent((dynamic_multifile_exported)/1). 125dynamic_multifile_exported(MP):- shared_parser_data(MP).
126:- share_mp((dynamic_multifile_exported)/1). 127
128
129:- module_transparent(find_predicate_module/2). 130find_predicate_module(P,MP):-find_predicate_module_maybe(MP,P),!.
131:- share_mp(find_predicate_module/2). 132
133:- module_transparent(find_predicate_module_maybe/2). 134find_predicate_module_maybe(MPO,F/A):-!, functor(P,F,A),find_predicate_module_maybe(MPO,P).
135find_predicate_module_maybe(MPO,M:F/A):-!, functor(P,F,A),find_predicate_module_maybe(MPO,M:P).
136find_predicate_module_maybe(M:P,MP):- predicate_property(MP,imported_from(M)),!,strip_module(MP,_,P).
137find_predicate_module_maybe(M:P,M:P):- !, predicate_property(M:P,defined), \+ predicate_property(M:P,imported_from(_)),!.
138find_predicate_module_maybe(M:P,P):- each_parser_module(M),predicate_property(M:P,defined), \+ predicate_property(M:P,imported_from(_)),!.
139find_predicate_module_maybe(MPO,P):- find_predicate_module_maybe(MPO,baseKB:P).
140:- share_mp(find_predicate_module_maybe/2). 141
142:- dynamic(using_shared_parser_data/2). 143use_shared_parser_data(User,File):- using_shared_parser_data(User,File),!.
144use_shared_parser_data(User,File):- asserta(using_shared_parser_data(User,File)),!.
145
146:- module_transparent(use_shared_parser_data/0). 147use_shared_parser_data:-
148 prolog_load_context(module,User),
149 ignore((source_location(File,_), use_shared_parser_data(User,File))),
150 ignore((prolog_load_context(source,File2), use_shared_parser_data(User,File2))),
151 ignore((prolog_load_context(file,File3), use_shared_parser_data(User,File3))).
152
153:- module_transparent(def_parser_data/2). 154def_parser_data(M,F/A):- !, assertion((atom(F),integer(A),functor(P,F,A))), def_parser_data(M,P).
155def_parser_data(_,M:XY):- !, def_parser_data(M,XY).
156def_parser_data(M,P):-
157 use_shared_parser_data,
158 ( \+ predicate_property(M:P,defined) -> define_shared_loadable_pred(M,P) ; true ),!.
165:- share_mp(def_parser_data/2). 166
167:- module_transparent(define_shared_loadable_pred/2). 168define_shared_loadable_pred(M,P):- current_prolog_flag(access_level,system),!,set_prolog_flag(access_level,user),
169 define_shared_loadable_pred(M,P),set_prolog_flag(access_level,system).
170
172define_shared_loadable_pred(M,P):- 173 '$current_source_module'(SM),'$current_typein_module'(CM),
174 175 functor(P,F,A),dbug(def_parser_data(sm=SM,cm=CM,m=M,F/A)),
176 dynamic(M:P),multifile(M:P),discontiguous(M:P).
177
178:- module_transparent(show_shared_pred_info/1). 179show_shared_pred_info(FA):-
180 prolog_load_context(module,User),
181 (pi_p(FA,P);P=FA),!,
182 functor(P,F,A),
183 ((User:predicate_property(P,defined))->
184 (predicate_property(P,number_of_clauses(N)),
185 (N<20 -> User:listing(FA) ; dbug(big(User,F/A)));
186 dbug(unkonw_number_of_clauses(User,F/A)));dbug(undefined(User,F/A))),
187 findall(PP,User:predicate_property(P,PP),PPL),dbug(FA=PPL),!.
188:- share_mp(show_shared_pred_info/1). 189
190
191:- module_transparent(importing_head/2). 192importing_head(H,H):- \+ callable(H),!.
193importing_head(M:H,M:H):- !.
194importing_head(H,M:H):- predicate_visible_home(H,M),!.
195importing_head(H,H).
196
197:- module_transparent(importing_body/3). 198importing_body(_CM,B,B):- \+ callable(B),!.
199importing_body(CM,(A,B),(AA,BB)):-!,importing_body(CM,A,AA),importing_body(CM,B,BB).
200importing_body(CM,B,BB):- compound(B),
201 CM:predicate_property(B,meta_predicate(MP)),!,
202 B=..[F|EL],MP=..[F|ML],
203 maplist(importing_body_lit(CM,MP),ML,EL,EEL),
204 BB=..[F|EEL].
205importing_body(_CM,B,B).
206
207:- module_transparent(importing_body_lit/5). 208importing_body_lit(_CM,_B,_Me,E,E):- \+ callable(E),!.
209importing_body_lit(CM,_B,Int,E,EE):- integer(Int),!,importing_body(CM,E,EE).
210importing_body_lit(CM,_B,(*),E,EE):- !,importing_body(CM,E,EE).
211importing_body_lit(CM, B,(:),[H|T],[HH|TT]):- Meta = (:), !,importing_body_lit(CM,B,Meta,H,HH),importing_body_lit(CM,B,Meta,T,TT).
212importing_body_lit(CM, B,(:),E,M:E):- functor(B,_,1),pi_p(E,P),CM:predicate_visible_home(P,M),!.
214importing_body_lit(_CM,_B,_,E,E).
215
216:- module_transparent(importing_clause/2). 217importing_clause(H,H):- \+ callable(H),!.
218importing_clause((:-B),(:-BB)):- !,strip_module(B,CM,_),importing_body(CM,B,BB).
219importing_clause((H:-B),(HH:-BB)):- !, importing_head(H,HH),!,strip_module(HH,CM,_),importing_body(CM,B,BB).
220importing_clause((H), (H)):- is_leave_alone(H),!.
221importing_clause((H),(HH)):- importing_head(H,HH),!.
222importing_clause((B),(BB)):- strip_module(B,CM,_),importing_body(CM,B,BB),!.
223importing_clause(HB,HB).
224:- share_mp(importing_clause/2). 225
226is_leave_alone(H):- compound(H),functor(H,F,A),is_leave_alone(F,A).
229is_leave_alone(A,_):- upcase_atom(A,A).
230
232