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   op(1150,fx,(share_mp)),
   14   op(1150,fx,(shared_parser_data)),
   15   op(1150,fx,(dynamic_multifile_exported))]).   16
   17% :- op(900, fy, not).
   18
   19% Miscellaneous generic utility predicates.
   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).
   39%each_parser_module_0(M):- current_module(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).
  116% shared_parser_data(P):- each_parser_module(M),predicate_property(M:P,defined), \+ predicate_property(M:P,imported_from(_)),!,shared_parser_data(M:P).
  117shared_parser_data(P):- prolog_load_context(module,SM),!,shared_parser_data(SM:P).
  118% shared_parser_data(P):- get_query_from(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 ),!.   
  159/*
  160def_parser_data(M,P):- throw(old_code),
  161   ( \+ predicate_property(M:P,defined) -> define_shared_loadable_pred(M,P) ; true ),   
  162   kb_shared(M:P),
  163   share_mp(M,P).
  164*/
  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
  171% define_shared_loadable_pred(M,P):- !, mpred_ain(isBorked==>M:P).
  172define_shared_loadable_pred(M,P):- % throw(old_code),
  173   '$current_source_module'(SM),'$current_typein_module'(CM),
  174   %mpred_ain(isBorked==>M:P),
  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),!.
  213%importing_body_lit(_,_B,(:),E,E):- !.
  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).
  227%is_leave_alone('--->',_).
  228%is_leave_alone('-->',_).
  229is_leave_alone(A,_):- upcase_atom(A,A).
  230
  231% :- fixup_exports.
  232
  233%:- multifile(parser_sharing:term_expansion/4).
  234%:- rtrace.
  235/*
  236parser_sharing:term_expansion(G,I,GG,O):- nonvar(I),compound(G),importing_clause(G,GG) -> G \== GG, I=O.
  237:- export(parser_sharing:term_expansion/4).
  238*/
  239%:- nortrace.