1% ===================================================================
    2% File 'parser_all.pl'
    3% Purpose: English to KIF conversions from SWI-Prolog  
    4% This implementation is incomplete
    5% Maintainer: Douglas Miles
    6% Contact: $Author: dmiles $@users.sourceforge.net ;
    7% Version: 'parser_all.pl' 1.0.0
    8% Revision:  $Revision: 1.3 $
    9% Revised At:   $Date: 2002/06/06 15:43:15 $
   10% ===================================================================
   11
   12:- module(parser_sharing,[
   13   (shared_parser_data)/1,
   14   (use_shared_parser_data)/2,
   15   op(1150,fx,(share_mp)),
   16   op(1150,fx,(shared_parser_data)),
   17   op(1150,fx,(dynamic_multifile_exported))]).   18
   19
   20% Miscellaneous generic utility predicates.
   21:- reexport(library(logicmoo_common)).   22%:- ensure_loaded(library(must_sanity)).
   23% :- op(900, fy, not).
   24
   25
   26% :- user:ensure_loaded(library(poor_bugger)).
   27
   28
   29:- module_transparent(only_pfc/1).   30only_pfc(P):- assertion(ignore(ground(P))), !.
   31:- module_transparent(only_if_pfc/1).   32only_if_pfc(_):- fail.
   33:- module_transparent(only_if_adv/1).   34:- meta_predicate only_if_adv(0).   35only_if_adv(P):- call(P).
   36
   37:- module_transparent(each_parser_module_1/1).   38each_parser_module(M):- no_repeats(each_parser_module_0(M)).
   39:- module_transparent(each_parser_module_0/1).   40each_parser_module_0(baseKB).
   41each_parser_module_0(parser_shared).
   42each_parser_module_0(parser_all).
   43each_parser_module_0(M):- each_parser_module_1(E),default_module(E,M).
   44:- export(each_parser_module_0/1).   45%each_parser_module_0(M):- current_module(M).
   46:- module_transparent(each_parser_module/1).   47each_parser_module_1(M):- strip_module(_,M,_).
   48each_parser_module_1(M):- '$current_source_module'(M).
   49each_parser_module_1(M):- '$current_typein_module'(M).
   50
   51:- module_transparent(predicate_visible_home/2).   52predicate_visible_home(H,M):- predicate_property(H,imported_from(M)),!.
   53predicate_visible_home(H,M):- predicate_property(H,defined),strip_module(H,M,_), \+ predicate_property(H,imported_from(_)),!.
   54predicate_visible_home(H,M):- each_parser_module(M),predicate_property(M:H,defined), \+ predicate_property(M:H,imported_from(_)),!. 
   55
   56:- module_transparent(pi_p/2).   57pi_p(X,_):- \+ compound(X),!,fail.
   58pi_p('//'(F,A),P):-!,atom(F),integer(A),AA is A +2,functor(P,F,AA).
   59pi_p(F/A,P):- !,atom(F),integer(A),functor(P,F,A).
   60pi_p(M:PI,M:P):-!,pi_p(PI,P).
   61
   62:- module_transparent(pi_2_p/2).   63pi_2_p(P,P):- \+ callable(P),!.
   64pi_2_p(M:I,M:I):-!.
   65pi_2_p(I,M:I):- pi_p(I,P),predicate_visible_home(P,M),!.
   66pi_2_p(P,P).
   67
   68
   69pi_splits(X,_,_):- \+ compound(X),!,fail.
   70pi_splits([X,Y],X,Y):-!.
   71pi_splits([],nil,nil):-!.
   72pi_splits([X],X,nil):-!.
   73pi_splits([X|Y],X,Y):-!,nonvar(X).
   74pi_splits((X,Y),X,Y):-!.
   75pi_splits(M:XY,M:X,M:Y):- pi_splits(XY,X,Y),!.
   76
   77
   78:- op(1150,fx,user:(share_mp)).   79:- op(1150,fx,baseKB:(share_mp)).   80
   81:- module_transparent((share_mp)/1).   82share_mp(nil):- !.
   83share_mp(XY):- pi_splits(XY,X,Y),!,share_mp(X),share_mp(Y).
   84share_mp(XY):- pi_p(XY,PI),!,share_mp(PI).
   85share_mp(MP):- strip_module(MP,M,P),share_mp(M,P).
   86
   87import_and_export(CM,M:F/A):- 
   88   (CM\==M-> CM:import(M:F/A) ; true),
   89   CM:export(M:F/A),!.
   90
   91
   92:- module_transparent((share_mp)/2).   93share_mp(_,nil):-!.
   94share_mp(M,XY):- pi_splits(XY,X,Y),!,share_mp(M,X),share_mp(M,Y).
   95share_mp(CM,(M:P)):- !, atom(M),share_mp(M,P),(CM==M->true;import_and_export(CM,M:P)).
   96share_mp(M,PI):- pi_p(PI,P)->PI\==P,!,share_mp(M,P).
   97share_mp(M,P):- functor(P,F,A), MFA=M:F/A,
   98   (M:multifile(M:MFA)), 
   99   (M:module_transparent(MFA)),
  100   (M:export(MFA)),
  101   (M:public(MFA)),   
  102   import_and_export(parser_sharing,MFA),
  103   import_and_export(parser_all,MFA),
  104   '$current_source_module'(SM),import_and_export(SM,MFA),
  105   '$current_typein_module'(CM),import_and_export(CM,MFA),
  106   import_and_export(system,MFA),
  107   !.
  108
  109:- share_mp((share_mp)/1).  110:- share_mp((share_mp)/2).  111
  112
  113:- op(1150,fx,user:(shared_parser_data)).  114:- op(1150,fx,baseKB:(shared_parser_data)).  115:- module_transparent((shared_parser_data)/1).  116
  117shared_parser_data(XY):- assertion(compound(XY)),fail.
  118shared_parser_data(XY):- pi_splits(XY,X,Y),!,shared_parser_data(X),shared_parser_data(Y).
  119shared_parser_data(XY):- pi_p(XY,PI)-> XY\==PI,!,shared_parser_data(PI).
  120shared_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).
  121shared_parser_data(M:P):- !,def_parser_data(M,P),strip_module(_,Imp,_), Imp:import(M:P).
  122% shared_parser_data(P):- each_parser_module(M),predicate_property(M:P,defined), \+ predicate_property(M:P,imported_from(_)),!,shared_parser_data(M:P).
  123shared_parser_data(P):- prolog_load_context(module,SM),!,shared_parser_data(SM:P).
  124% shared_parser_data(P):- get_query_from(SM),shared_parser_data(SM:P).
  125:- share_mp((shared_parser_data)/1).  126
  127
  128:- op(1150,fx,user:(dynamic_multifile_exported)).  129:- op(1150,fx,baseKB:(dynamic_multifile_exported)).  130:- module_transparent((dynamic_multifile_exported)/1).  131dynamic_multifile_exported(MP):- shared_parser_data(MP).
  132:- share_mp((dynamic_multifile_exported)/1).  133
  134
  135:- module_transparent(find_predicate_module/2).  136find_predicate_module(P,MP):-find_predicate_module_maybe(MP,P),!.
  137:- share_mp(find_predicate_module/2).  138
  139:- module_transparent(find_predicate_module_maybe/2).  140find_predicate_module_maybe(MPO,F/A):-!, functor(P,F,A),find_predicate_module_maybe(MPO,P).
  141find_predicate_module_maybe(MPO,M:F/A):-!, functor(P,F,A),find_predicate_module_maybe(MPO,M:P).
  142find_predicate_module_maybe(M:P,MP):-  predicate_property(MP,imported_from(M)),!,strip_module(MP,_,P).
  143find_predicate_module_maybe(M:P,M:P):- !, predicate_property(M:P,defined), \+ predicate_property(M:P,imported_from(_)),!.
  144find_predicate_module_maybe(M:P,P):- each_parser_module(M),predicate_property(M:P,defined), \+ predicate_property(M:P,imported_from(_)),!.
  145find_predicate_module_maybe(MPO,P):- find_predicate_module_maybe(MPO,baseKB:P).
  146:- share_mp(find_predicate_module_maybe/2).  147
  148:- dynamic(using_shared_parser_data/2).  149use_shared_parser_data(User,File):- using_shared_parser_data(User,File),!.
  150use_shared_parser_data(User,File):- asserta(using_shared_parser_data(User,File)),!.
  151
  152:- module_transparent(use_shared_parser_data/0).  153use_shared_parser_data:- 
  154   prolog_load_context(module,User),
  155   ignore((source_location(File,_), use_shared_parser_data(User,File))), 
  156   ignore((prolog_load_context(source,File2), use_shared_parser_data(User,File2))), 
  157   ignore((prolog_load_context(file,File3), use_shared_parser_data(User,File3))).
  158
  159:- module_transparent(def_parser_data/2).  160def_parser_data(M,F/A):- !, assertion((atom(F),integer(A),functor(P,F,A))), def_parser_data(M,P).
  161def_parser_data(_,M:XY):- !, def_parser_data(M,XY).
  162def_parser_data(M,P):-
  163   use_shared_parser_data,
  164   ( \+ predicate_property(M:P,defined) -> define_shared_loadable_pred(M,P) ; true ),!.   
  165/*
  166def_parser_data(M,P):- throw(old_code),
  167   ( \+ predicate_property(M:P,defined) -> define_shared_loadable_pred(M,P) ; true ),   
  168   kb_shared(M:P),
  169   share_mp(M,P).
  170*/
  171:- share_mp(def_parser_data/2).  172
  173:- module_transparent(define_shared_loadable_pred/2).  174define_shared_loadable_pred(M,P):- current_prolog_flag(access_level,system),!,set_prolog_flag(access_level,user),
  175   define_shared_loadable_pred(M,P),set_prolog_flag(access_level,system).
  176
  177% define_shared_loadable_pred(M,P):- !, mpred_ain(isBorked==>M:P).
  178define_shared_loadable_pred(M,P):- % throw(old_code),
  179   '$current_source_module'(SM),'$current_typein_module'(CM),
  180   %mpred_ain(isBorked==>M:P),
  181   functor(P,F,A),dmsg(def_parser_data(sm=SM,cm=CM,m=M,F/A)),
  182   dynamic(M:P),multifile(M:P),discontiguous(M:P).
  183
  184:- module_transparent(show_shared_pred_info/1).  185show_shared_pred_info(FA):-
  186   prolog_load_context(module,User),
  187   (pi_p(FA,P);P=FA),!,
  188   functor(P,F,A),
  189   ((User:predicate_property(P,defined))->
  190       (predicate_property(P,number_of_clauses(N)),
  191         (N<20 -> User:listing(FA) ; dmsg(big(User,F/A)));
  192    dmsg(unkonw_number_of_clauses(User,F/A)));dmsg(undefined(User,F/A))),
  193   findall(PP,User:predicate_property(P,PP),PPL),dmsg(FA=PPL),!.
  194:- share_mp(show_shared_pred_info/1).  195
  196
  197:- module_transparent(importing_head/2).  198importing_head(H,H):- \+ callable(H),!.
  199importing_head(M:H,M:H):- !.
  200importing_head(H,M:H):- predicate_visible_home(H,M),!.
  201importing_head(H,H).
  202
  203:- module_transparent(importing_body/3).  204importing_body(_CM,B,B):- \+ callable(B),!.
  205importing_body(CM,(A,B),(AA,BB)):-!,importing_body(CM,A,AA),importing_body(CM,B,BB).
  206importing_body(CM,B,BB):- compound(B),
  207  CM:predicate_property(B,meta_predicate(MP)),!,
  208  B=..[F|EL],MP=..[F|ML],
  209  maplist(importing_body_lit(CM,MP),ML,EL,EEL),
  210  BB=..[F|EEL].
  211importing_body(_CM,B,B).
  212
  213:- module_transparent(importing_body_lit/5).  214importing_body_lit(_CM,_B,_Me,E,E):- \+ callable(E),!.
  215importing_body_lit(CM,_B,Int,E,EE):- integer(Int),!,importing_body(CM,E,EE).
  216importing_body_lit(CM,_B,(*),E,EE):- !,importing_body(CM,E,EE).
  217importing_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).
  218importing_body_lit(CM, B,(:),E,M:E):- functor(B,_,1),pi_p(E,P),CM:predicate_visible_home(P,M),!.
  219%importing_body_lit(_,_B,(:),E,E):- !.
  220importing_body_lit(_CM,_B,_,E,E).
  221
  222:- module_transparent(importing_clause/2).  223importing_clause(H,H):- \+ callable(H),!.
  224importing_clause((:-B),(:-BB)):- !,strip_module(B,CM,_),importing_body(CM,B,BB).
  225importing_clause((H:-B),(HH:-BB)):- !, importing_head(H,HH),!,strip_module(HH,CM,_),importing_body(CM,B,BB).
  226importing_clause((H), (H)):- is_leave_alone(H),!.
  227importing_clause((H),(HH)):- importing_head(H,HH),!.
  228importing_clause((B),(BB)):- strip_module(B,CM,_),importing_body(CM,B,BB),!.
  229importing_clause(HB,HB).
  230:- share_mp(importing_clause/2).  231
  232is_leave_alone(H):- compound(H),functor(H,F,A),is_leave_alone(F,A).
  233%is_leave_alone('--->',_).
  234%is_leave_alone('-->',_).
  235is_leave_alone(A,_):- upcase_atom(A,A).
  236
  237% :- fixup_exports.
  238
  239%:- multifile(parser_sharing:term_expansion/4).
  240%:- rtrace.
  241/*
  242parser_sharing:term_expansion(G,I,GG,O):- nonvar(I),compound(G),importing_clause(G,GG) -> G \== GG, I=O.
  243:- export(parser_sharing:term_expansion/4).
  244*/
  245%:- nortrace.