1% dcg_pfc: translation of dcg-like grammar rules into pfc rules.
    2
    3:- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )).    4:- module(pfc_dcg,[]).    5:- endif.    6
    7
    8:- op(1200,xfx,'-->>').    9:- op(1200,xfx,'--*>>').   10% :- op(1200,xfx,'<<--').
   11:- op(400,yfx,'\\\\').   12
   13% :- use_module(library(strings)), use_module(library(lists)).
   14
   15
   16mpred_translate_rule((LP-->>[]),H) :- !, mpred_t_lp(LP,_Id,S,S,H).
   17
   18mpred_translate_rule((LP-->>RP),(H <= B)):-
   19   mpred_t_lp(LP,Id,S,SR,H),
   20   mpred_t_rp(RP,Id,S,SR,B1),
   21   mpred_tidy(B1,B).
   22
   23
   24mpred_translate_rule((LP--*>>[]),H) :- !, mpred_t_lp(LP,_Id,S,S,H).
   25mpred_translate_rule((LP--*>>RP),(B ==> H)):-
   26   mpred_t_lp(LP,Id,S,SR,H),
   27   mpred_t_rp(RP,Id,S,SR,B1),
   28   mpred_tidy(B1,B).
   29
   30mpred_t_lp(X,Id,S,SR,ss(X,Id,(S \\ SR))) :- var(X),!.
   31
   32mpred_t_lp((LP,List),Id,S,SR,ss(LP,Id,(S \\ List2))):-
   33   !,
   34   append(List,SR,List2).
   35
   36mpred_t_lp(LP,Id,S,SR,ss(LP,Id,(S \\ SR))).
   37
   38mpred_t_rp(!,_Id,S,S,!) :- !.
   39mpred_t_rp([],_Id,S,S1,S=S1) :- !.
   40mpred_t_rp([X],Id,S,SR,ss(word(X),Id,(S \\ SR))) :- !.
   41mpred_t_rp([X|R],Id,S,SR,(ss(word(X),Id,(S \\ SR1)),RB)) :-
   42  !,
   43  mpred_t_rp(R,Id,SR1,SR,RB).
   44mpred_t_rp({T},_Id,S,S,{T}) :- !.
   45mpred_t_rp((T,R),Id,S,SR,(Tt,Rt)) :- !,
   46   mpred_t_rp(T,Id,S,SR1,Tt),
   47   mpred_t_rp(R,Id,SR1,SR,Rt).
   48mpred_t_rp((T;R),Id,S,SR,(Tt;Rt)) :- !,
   49   mpred_t_or(T,Id,S,SR,Tt),
   50   mpred_t_or(R,Id,S,SR,Rt).
   51mpred_t_rp(T,Id,S,SR,ss(T,Id,(S \\ SR))).
   52
   53mpred_t_or(X,Id,S0,S,P) :-
   54   mpred_t_rp(X,Id,S0a,S,Pa),
   55 ( var(S0a), (\==(S0a,S)), !, S0=S0a, P=Pa;
   56   P=(S0=S0a,Pa) ).
   57
   58mpred_tidy((P1;P2),(Q1;Q2)) :-
   59   !,
   60   mpred_tidy(P1,Q1),
   61   mpred_tidy(P2,Q2).
   62mpred_tidy(((P1,P2),P3),Q) :-
   63   mpred_tidy((P1,(P2,P3)),Q).
   64mpred_tidy((P1,P2),(Q1,Q2)) :-
   65   !,
   66   mpred_tidy(P1,Q1),
   67   mpred_tidy(P2,Q2).
   68mpred_tidy(A,A) :- !.
   69
   70:- was_dynamic(sentence/2).   71
   72compile_pfcg :-
   73  ((retract((L -->> R)), mpred_translate_rule((L -->> R), PfcRule));
   74    (retract((L --*>> R)), mpred_translate_rule((L --*>> R), PfcRule))),
   75  ain(PfcRule),
   76  fail.
   77compile_pfcg.
   78
   79parse(Words) :-
   80  parse(Words,Id),
   81  format("~N% sentence id = ~w",Id),
   82  show(Id,sentence(_X)).
   83
   84
   85parse(Words,Id) :-
   86  gen_s_tag(Id),
   87  parse1(Words,Id),
   88  ain(sentence(Id,Words)).
   89
   90parse1([],_) :- !.
   91parse1([H|T],Id) :-
   92 l_do(ain(ss(word(H),Id,([H|T] \\ T)))),
   93 parse1(T,Id).
   94
   95
   96:- was_dynamic(sentences/2).   97
   98show_sentences(Id) :- show_sentences(Id,_).
   99
  100show_sentences(Id,Words) :-
  101  sentence(Id,Words),
  102  call_u(ss(s(S),Id,(Words \\ []))),
  103  nl,write(S),
  104  fail.
  105show_sentences(_,_).
  106
  107:- meta_predicate l_do(0).  108l_do(X) :- call(X) -> true;true.
  109
  110show(Id,C) :-
  111  call_u(ss(C,Id,A \\ B)),
  112  append(Words,B,A),
  113  format("~N%  ~w    :   ~w",[C,Words]),
  114  fail.
  115
  116gen_s_tag(s(N2)) :-
  117  % var(_V),
  118  (retract(s_tag(N)); N=0),
  119  N2 is N+1,
  120  assert(s_tag(N2)).
  121
  122make_term(ss(Constituent,Id,String),Term) :-
  123   Constituent =.. [Name|Args],
  124   name(Name,Name_string),
  125   name(Name2,[36|Name_string]),
  126   append([Name2|Args],[Id,String],Term_string),
  127   Term =.. Term_string.
  128
  129
  130is_mpred_term_expansion((P -->> Q),(:- ain(Rule))) :-
  131  mpred_translate_rule((P -->> Q), Rule).
  132is_mpred_term_expansion((P --*>> Q),(:- ain(Rule))) :-
  133  mpred_translate_rule((P --*>> Q), Rule)