1:- module(cgp_common_logic, 
    2  [%run_tests/0, 
    3   test_logicmoo_cg_clif/0,
    4   convert_clif_to_cg/2]).    5
    6:- use_module(library(logicmoo_common)).    7:- use_module(library(logicmoo/dcg_meta)).    8:- use_module(library(logicmoo/util_bb_frame)).    9:- ensure_loaded(library(cgp_lib/cgp_swipl)).   10:- use_module(library(logicmoo_clif)).   11:- cgp_common_logic:import(dcg_basics:eol/2).   12
   13%:-ensure_loaded('cgp_common_logic.plt').
   14
   15% ==========================================================================
   16% do_varaibles/5 replaces the VARS in things like (exists ...VARS... Stuff)
   17% ==========================================================================
   18do_varaibles(Mode, EoF, Var, Asserts, Fixes):- \+ is_list(Var), !, 
   19  do_varaibles(Mode, EoF, [Var], Asserts, Fixes).
   20
   21do_varaibles(Mode, EoF, Vars, Asserts, Fixes):- is_list(Vars), !, 
   22   maplist(do_one_var(Mode, EoF), _, Vars, Assert, Fix), 
   23   flatten(Assert, Asserts), 
   24   flatten(Fix, Fixes), 
   25   !.
   26   
   27
   28do_one_var(Mode, EoF, X, Var, Asserts, Fixes):- \+ is_list(Var), !, 
   29  do_one_var(Mode, EoF, X, [Var], Asserts, Fixes).
   30
   31do_one_var(Mode, EoF, X, [VarName| Types], [Grok|Asserts], [Fix|Fixes]):-
   32  \+ number(VarName),
   33  var(X), cg_var_name(VarName, X, Fix), 
   34  add_mode(Mode, cg_quantz(EoF, X), Grok), 
   35  do_one_var(Mode, EoF, X, Types, Asserts, Fixes).
   36do_one_var(Mode, EoF, X, [Number| Types], [Grok|Asserts], Fixes):-
   37  number(Number),
   38  add_mode(Mode, cg_quantz_num(EoF,Number,'?'(X)), Grok),
   39  do_one_var(Mode, EoF, X, Types, Asserts, Fixes).
   40do_one_var(Mode, EoF, X, [Type| Types], [cg_type('?'(X),Type)|Asserts], Fixes):-
   41  do_one_var(Mode, EoF, X, Types, Asserts, Fixes).
   42do_one_var(_Mode, _EoF, _X, [], [], []).
   43
   44cg_var_name('?'(X), X, []):-!.
   45cg_var_name(X, X, [X = '?'(X)]).
   46
   47% ==========================================================================
   48% unchop/3 - unchops (joins) things into a list
   49% ==========================================================================
   50unchop(In1, In2, Out):- flatten([In1, In2], Out), !.
   51unchop(In1, In2, Out):-
   52  listify_h(In1, L1), 
   53  listify_h(In2, L2), 
   54  append(L1, L2, Out).
   55
   56listify_h(L1, L2):- flatten([L1], L2), !.
   57listify_h(L1, L2):- listify(L1, L2), !.
   58
   59% ==========================================================================
   60% chop_up_clif/2 - chops up and replaces CLIF into CG
   61% ==========================================================================
   62
   63chop_up_clif(Stuff, Out):- chop_up_clif(Stuff,Stuff, Out).
   64
   65chop_up_clif(OF, Stuff, Out):-
   66   chop_up_clif(OF, +, Stuff, Out).
   67
   68
   69is_var_with_name(X,N):- var(X),!,get_var_name(X,N).
   70is_var_with_name('$VAR'(Var),N):-!, is_var_with_name(Var,N).
   71is_var_with_name('?'(Var),N):-is_var_with_name(Var,N).
   72is_var_with_name(N,N).
   73
   74% ==========================================================================
   75% chop_up_clif/3 - Like chop_up_clif/2 (chops up and replaces CLIF into CG) but takes a +/-
   76% ==========================================================================
   77
   78chop_up_clif(_OF, _Mode, (Var), '$VAR'(Name)):- is_ftVar(Var), is_var_with_name(Var,Name),!.
   79chop_up_clif(_OF, _Mode, Var, Out):- var(Var),!, Out = Var.
   80chop_up_clif(_OF, _Mode, '$VAR'(Name), '$VAR'(Name)):-!.
   81chop_up_clif(OF, Mode, '?'(Var), Out):- !, chop_up_clif(OF, Mode, '$VAR'(Var), Out).
   82chop_up_clif(OF, Mode, [Var|Stuff], Out):- var(Var),!,chop_up_clif(OF, Mode, [holds,Var|Stuff], Out).
   83chop_up_clif(OF, Mode, [ExistsOrForall, VarList, Stuff], Out):- 
   84   nonvar(ExistsOrForall),
   85   member(ExistsOrForall, [exists, forall]), 
   86   do_varaibles(Mode, ExistsOrForall, VarList, Out1, NewVars), 
   87   subst_each(Stuff, NewVars, NewStuff), 
   88   chop_up_clif(OF, Mode, NewStuff, Out2), 
   89   unchop(Out1, Out2, Out).
   90
   91chop_up_clif(OF, Mode, ['implies'|Stuff], Out) :- chop_up_clif(OF, Mode, ['=>'|Stuff], Out).
   92chop_up_clif(OF, Mode, ['if'|Stuff], Out) :- chop_up_clif(OF, Mode, ['=>'|Stuff], Out).
   93
   94chop_up_clif(OF, Mode, ^(X,Y), Out):- !,
   95  chop_up_clif(OF, Mode, exists(X,Y), Out).
   96
   97chop_up_clif(OF, Mode, object(_Frame,Var,Type,countable,na,eq,1), Out):- 
   98  Type \== '?',!,
   99  chop_up_clif(OF, Mode, isA(Var,Type), Out).
  100
  101   
  102chop_up_clif(OF, Mode, intrans_pred(Type1,Type2,Pred,Arg1), Out):- 
  103  chop_up_clif(OF, Mode, (isA(Arg1,Type1),isA(Arg1,Type2),[Pred,Arg1]), Out).
  104
  105chop_up_clif(OF, Mode, generic_pred(Type,Pred,Arg1,Arg2), Out):- 
  106  chop_up_clif(OF, Mode, (isA(Arg1,Type),[Pred,Arg1,Arg2]), Out).
  107
  108chop_up_clif(OF, Mode, property(Var,Type,adj), Out):- 
  109  Type \== '?',!,
  110  chop_up_clif(OF, Mode, property(Var,Type), Out).
  111
  112chop_up_clif(OF, Mode, object(_Frame,Var,Type,dom,na,na,na), Out):- 
  113  Type \== '?',!,
  114  chop_up_clif(OF, Mode, isA(Var,Type), Out).
  115
  116chop_up_clif(OF, Mode, isa(Var,Type), Out):- 
  117   chop_up_clif(OF, Mode, isA(Var,Type), Out).
  118
  119chop_up_clif(OF, Mode, ti(Type,Var), Out):- 
  120   chop_up_clif(OF, Mode, isA(Var,Type), Out).
  121
  122chop_up_clif(OF, Mode, isA(Var,Type), Out):- 
  123  chop_up_clif(OF, Mode, cg_type(Var,Type), Out).
  124
  125chop_up_clif(OF, Mode, [predicate,_Frame,_Exists_Be,Verb|Args], Out):- !,
  126  chop_up_clif(OF, Mode, [Verb|Args], Out).
  127
  128
  129
  130chop_up_clif(OF, Mode, :-(X,Y), Out):- !,
  131  chop_up_clif(OF, Mode, if(Y,X), Out).
  132
  133chop_up_clif(OF, Mode, relation(_Frame,X,of,Y), Out):- !,
  134  chop_up_clif(OF, Mode, of(X,Y), Out).
  135
  136chop_up_clif(OF, Mode, (X,Y), Out):- !,  pred_juncts_to_list(',',(X,Y),List),
  137  chop_up_clif(OF, Mode,[and|List], Out).
  138
  139chop_up_clif(OF, Mode, '&'(X,Y), Out):- !,  pred_juncts_to_list('&',(X,Y),List),
  140  chop_up_clif(OF, Mode,[and|List], Out).
  141
  142
  143
  144chop_up_clif(_OF, _Mode, ['#'(quote), Mary], '#'(Mary)).
  145chop_up_clif(_OF, _Mode, '$STRING'(S), S).
  146chop_up_clif(_OF, _Mode, 'named'(S), S).
  147
  148
  149chop_up_clif(OF, +, [not, Stuff], Out) :- chop_up_clif(OF, -, Stuff, Out).
  150chop_up_clif(OF, -, [not, Stuff], Out) :- chop_up_clif(OF, +, Stuff, Out).
  151
  152chop_up_clif(OF, Mode, [Type, Arg], Out) :- var(Arg), nonvar(Type), chop_up_clif(OF, Mode, ['Type', Arg, Type], Out).
  153
  154chop_up_clif(OF, +, [and|Stuff],    Out )  :- chop_up_list(OF, +, Stuff, Out).
  155chop_up_clif(OF, -, [and|Stuff], or(Out))  :- chop_up_list(OF, -, Stuff, Out).
  156chop_up_clif(OF, +, [or|Stuff],  or(Out))  :- chop_up_list(OF, +, Stuff, Out).
  157chop_up_clif(OF, -, [or|Stuff],     Out )  :- chop_up_list(OF, -, Stuff, Out).
  158
  159
  160chop_up_clif(OF, Mode, ['=>', Arg1, Arg2], Out):-
  161  chop_up_clif(OF, Mode, Arg1, F1),flatten([F1],Out1),
  162  chop_up_clif(OF, Mode, Arg2, F2),flatten([F2],Out2),
  163  Out =.. ['cg_implies', Out1, Out2], !.
  164
  165
  166chop_up_clif(OF, Mode, [Name, Arg1, Arg2], Out):- is_cg_pred(Name, Pred), !, 
  167  chop_up_clif(OF, Mode, Arg1, Out1), 
  168  chop_up_clif(OF, Mode, Arg2, Out2),  
  169  Out =.. [Pred, Out1, Out2], !.
  170
  171chop_up_clif(OF, Mode, [Pred|Args], Out):-  
  172  chop_up_list(OF, +, Args, ArgsO), 
  173  (HOLDS =.. [cg_holds, Pred|ArgsO]), 
  174  add_mode(Mode, HOLDS, Out).
  175
  176chop_up_clif(OF, Mode, C, Out):- compound(C), \+ is_list(C), compound_name_arguments(C,F,A),
  177  chop_up_clif(OF, Mode, [F|A], Out).
  178
  179chop_up_clif(_OF, _Mode, O, O).
  180
  181  
  182
  183
  184is_cg_pred(Name, _):- \+ atom(Name), !, fail.
  185is_cg_pred('=>', 'cg_implies'):-!. 
  186is_cg_pred(Name, Pred):- downcase_atom(Name, NameDC), member(NameDC, [name, type]), atom_concat('cg_', NameDC, Pred), !.
  187is_cg_pred(Name, Pred):- downcase_atom(Name, Pred), atom_concat('cg_', _, Pred).
  188
  189add_mode(-, - A, A).
  190add_mode(-, A, -A).
  191add_mode(_, A, A).
  192
  193% ==========================================================================
  194% chop_up_list/3 is the maplist version of chop_up_clif/3
  195% ==========================================================================
  196chop_up_list(OF, Mode, Stuff, Out):- maplist(chop_up_clif(OF, Mode), Stuff, Out). 
  197
  198
  199% ==========================================================================
  200%% kif_to_term(+InS, -Clif)
  201% Converts InS string into Clif
  202% ==========================================================================
  203kif_to_term(InS, Clif):-
  204  locally(t_l:sreader_options(logicmoo_read_kif, true), 
  205      parse_sexpr(string(InS), Clif)), !.
  206 
  207 
  208% ==========================================================================
  209%% run_1_test(+String)
  210% Converts InS string into Clif
  211% ==========================================================================
  212run_1_test(String):-
  213   write('\n\n\n'), 
  214   dmsg("================================================="), 
  215  mpred_test(mort(cgp_common_logic:kif_to_term(String, Clif))),
  216  pprint_ecp(magenta, (?- run_1_test(String))), 
  217  pprint_ecp(yellow, clif=Clif), 
  218  mpred_test(mort(cgp_common_logic:convert_clif_to_cg(Clif, CG))),
  219   pprint_ecp(cyan, cg=(CG)), 
  220   ensure_fvars(CG,FVOut),
  221   nl,
  222   pprint_ecp(cyan, cgflat=(FVOut)), 
  223   dmsg("================================================="), !.
  224
  225test_logicmoo_cg_clif:- notrace(update_changed_files),
  226  
  227  forall(cl_example(String), run_1_test(String)).
  228
  229:- system:import(test_logicmoo_cg_clif/0).  230
  231:- public(test_logicmoo_cg_clif/0).  232
  233:- add_history(test_logicmoo_cg_clif).  234
  235% write_list(L):- maplist(write, L).
  236% ?- compound(a(b)).  %Yes   ?-atom(a(b)) % No
  237% ?- compound([a]).  %Yes
  238% ?- compound(a).  % No 
  239% ?- compound(1).  % No 
  240
  241
  242% Convert all  '?'(Name)  into  '$VAR'(UPPER)
  243qvar_to_vvar(I, O):- \+ compound(I), !, I=O.
  244qvar_to_vvar('?'(Name), '$VAR'(UPPER)):- atomic(Name), upcase_atom(Name, UPPER), !.
  245qvar_to_vvar(I, O):-
  246  compound_name_arguments(I, F, ARGS), 
  247  maplist(qvar_to_vvar, ARGS, ArgsO), 
  248  compound_name_arguments(O, F, ArgsO).
  249
  250renumbervars_with_names_l(In0,In):- 
  251  guess_varnames(In0),
  252  term_variables(In0,Vs),
  253  logicmoo_util_terms:pred_subst(cgp_common_logic:var_q_var(Vs),In0,In).
  254
  255var_q_var(_Vs,V,'$VAR'(Name)):- var(V),!,get_var_name(V,Name).
  256var_q_var(_Vs,'$VAR'(V),'$VAR'(V)):- !.
  257var_q_var(_Vs,'?'(V),'$VAR'(V)):- !.
  258
  259var_k_var(Var):- get_var_name(Var,Name),(Var = ('?'(Name))). 
  260
  261% ==========================================================================
  262%% convert_clif_to_cg(+Clif, -CG)
  263%  Redoes Clif forms into CG forms
  264% ==========================================================================
  265convert_clif_to_cg(In0, CG):-
  266  nl,
  267  guess_varnames(In0),
  268  renumbervars_with_names_l(In0,In),
  269  display(renumbervars_with_names(In0,In)),
  270  nl,
  271  chop_up_clif(In, Mid), 
  272  qvar_to_vvar(Mid, Mid2), 
  273  unnumbervars(Mid2, Out),!,  
  274  to_out_cg(Out,OutCG),
  275  cleanup_cg(OutCG,CG).
  276
  277ensure_fvars(OutCG,FVOut):- \+ compound(OutCG),!,OutCG=FVOut.
  278ensure_fvars(OutCG,FVOut):- arg(1,OutCG,O),is_frmvar(O),!,OutCG=FVOut.
  279ensure_fvars(OutCG,FVOut):- is_cg_frame_var(OutCG,_),OutCG=FVOut.
  280ensure_fvars(OutCG,FVOut):- make_fv(FV), frame_to_db(FV,OutCG,FVOut).
  281
  282is_frmvar(O):- is_ftVar(O),!.
  283%is_frmvar(O):- is_cg_frame(O),!.
  284
  285make_fv(FV):-
  286  gensym('CGIF_',Sym),
  287  %debug_var(Sym,FV).
  288  %FV='$VAR'(Sym).
  289  FV='cgf'(Sym).
  290
  291to_out_cg(Out,OutCG):- var(Out),!,OutCG = cg(Out).
  292to_out_cg(cg(Out),(Out)):-!.
  293to_out_cg((Out),(Out)):- nonvar(Out),!.
  294
  295frame_to_db(FV,OutCG,FVOut):- frame_to_db(FV,0,OutCG,FVOut).
  296
  297frame_to_db(_FV,_,P,P):- var(P).
  298frame_to_db(_,_,cgf(P),cgf(P)):-!.
  299frame_to_db(_,_,'$VAR'(P),'$VAR'(P)):-!.
  300frame_to_db(_,_,CGP,cg(FV,FVP)):- compound(CGP),CGP=cg(FV,FVP),!.
  301frame_to_db(FV,C,CGP,cg(FV,FVP)):- compound(CGP),CGP=cg(P),!, frame_to_db(FV,C,P,FVP).
  302%frame_to_db(FV,_,P,cg(FV,P)):- is_list(P),!.
  303%frame_to_db(FV,C,P,(FVP)):- is_list(P),!,maplist(frame_to_db(FV,C),P,FVP).
  304frame_to_db(FV,C,P,CJS):- is_list(P),!,maplist(frame_to_db(FV,C),P,FVP),list_to_conjuncts(',',FVP,CJS).
  305frame_to_db(FV,C,P,FVP):- number(C),C\==0,!,frame_to_db(FV,0,P,FVP).
  306frame_to_db(FV,:,P,FVP):- !, frame_to_db(FV,0,P,FVP).
  307frame_to_db(_,-,P,P):-!.
  308frame_to_db(_,+,P,P):-!.
  309frame_to_db(_,?,P,P):-!.
  310frame_to_db(FV,0,P,in_frame(FV,P)):- var(P).
  311frame_to_db(_, _,P,FVP):- \+ compound(P),!,FVP=P.
  312frame_to_db(_, _,P,FVP):- compound_name_arity(P,_,0),!,FVP=P.
  313frame_to_db(FV,C,-P,CJS):- !, frame_to_db(FV,C,P,CJS).
  314frame_to_db(FV,C,P,CJS):- P=..[F,E],frame_to_db(FV,C,E,M),!, CJS=..[F,M].
  315frame_to_db(FV,C,P,FVP):- compound(C),compound(P),compound_name_arity(C,_,A),compound_name_arity(P,F,A),!,
  316  compound_name_arguments(C,F,Ns),compound_name_arguments(P,F,As),
  317  maplist(frame_to_db(FV),Ns,As,FVPs), compound_name_arguments(FVP,F,FVPs).
  318frame_to_db(FV,_,P,FVP):- predicate_property(P,meta_predicate(Template)),!,frame_to_db(FV,Template,P,FVP).
  319frame_to_db(_, _,P,FVP):- predicate_property(P,builtin),!,FVP=P.
  320frame_to_db(FV,_,P,FVP):- contains_var(FV,P),!,FVP=P.
  321
  322frame_to_db(FV,C,P,FVPO):- arg(_,P,E),is_cg_frame(E),nonvar(E),E\=cgf(_),
  323  once(is_cg_frame_var(E,F);make_fv(F)),into_cgvar(F,CGVAR),!,
  324  subst(P,E,CGVAR,M),frame_to_db(FV,C,M,FVP),
  325  frame_to_db(F,C,E,FVPE),
  326  conjoin(FVP,FVPE,FVPO).
  327
  328frame_to_db(FV,_,P,FVP):- compound_name_arguments(P,F,FVPs), 
  329  maplist(frame_to_db(FV),FVPs,FVPsO),
  330  compound_name_arguments(FVP,F,[FV|FVPsO]),!.
  331frame_to_db(_, _,P,FVP):- FVP=P.
  332
  333into_cgvar(F,CGVAR):- var(F),CGVAR=cgf(F).
  334into_cgvar(cgf(F),cgf(F)):-!.
  335is_cg_frame(E):- var(E),!,fail.
  336is_cg_frame(E):- is_list(E),!.
  337is_cg_frame(cg(_)):-!.
  338is_cg_frame(cgf(_)):-!.
  339is_cg_frame(cg(_,_)):-!.
  340is_cg_frame_var(E,_):- var(E),!,fail.
  341is_cg_frame_var(cgf(V),V):-!.
  342is_cg_frame_var(cg(V,_),V):-!.
  343
  344% ==========================================================================
  345%% compound_name_arguments_sAfe(?Compound, ?Name ?Arguments)
  346%  Safely does compound_name_arguments/3 but with a special case
  347% ==========================================================================
  348compound_name_arguments_sAfe(F, F, []):- !. % special case
  349compound_name_arguments_sAfe(LpsM, F, ArgsO):- compound_name_arguments(LpsM, F, ArgsO).
  350
  351
  352
  353
  354/*
  355(documentation Hajj EnglishLanguage "The Pilgrimage to Mecca in Islam.  It is
  356the fifth obligatory Pillar of the Five Pillars of Islam for those who are
  357ablebodied and can afford to do pilgrimage to Mecca at least once in their
  358lifetime.  It takes place every year in the Islamic month of Dhu al-Hijjah.")
  359*/
  360
  361cl_example("
  362(=>
  363  (and
  364    (attribute ?P Muslim)
  365    (capability Hajj agent ?P))
  366
  367  (modalAttribute
  368    (exists (?H)
  369      (and
  370        (instance ?H Hajj)
  371        (agent ?H ?P)))
  372    Obligation))  ").
  373cl_example("
  374(exists (x y) (and (Red x) (not (Ball x)) (On x y) (not (and (Table y) (not (Blue y))))))").
  375
  376cl_example('
  377(exists ((x Drive) (y Chevy) (z Old))
  378  (and (Person Bob) (City "St. Louis")
  379   (Agnt x Bob)(Dest x "St. Louis") (Thme x y) (Poss Bob y) (Attr y z) ))').
  380
  381% If a cat is on a mat, then the cat is a happy pet.
  382cl_example("(not (exists ((x Cat) (y Mat)) (and (On x y)(not (exists z) (and (Pet x) (Happy z) (Attr x z))))))").
  383
  384% For every cat x and every mat y and x is on y, then x is a happy pet.
  385cl_example("(forall ((x Cat) (y Mat))(if (On x y) (and (Pet x) (exists ((z Happy)) (Attr x z)))))").
  386
  387cl_example("(exists ((r Relation)) (and (Familial r) (r Bob Sue)))").
  388
  389cl_example("(exists ( ?y ) (implies (isa ?y Mat)  (Pred ?y ?z)))").
  390
  391% a cat on a mat
  392cl_example("(exists ((?x Cat) (?y Mat)) (On ?x ?y))").
  393
  394cl_example("(not (exists ((?x Cat)) (not (exists ((?y Mat)) (On ?x ?y)))))").
  395
  396%all cats are on a mat
  397cl_example("(forall ((?x Cat)) (exists ((?y Mat)) (On ?x ?y)))").
  398
  399%there are two cats on a mat.
  400cl_example("(exists ((?y Mat)(?x Cat)(?z Cat)) (and (On ?x ?y)(On ?z ?y)(different ?x ?z)))").
  401
  402%john goes to Boston by bus... or something like that
  403cl_example("
  404(exists ((x Go) (y Bus))
  405      (and (Person John) (city Boston)
  406           (Agnt x John) (Dest x Boston) (Inst x y)))").
  407
  408cl_example("
  409(exists ((?x Go) (?y Person) (?z City) (?w Bus))
  410        (and (Name ?y John) (Name ?z Boston)
  411             (Agnt ?x ?y) (Dest ?x ?z) (Inst ?x ?w)))").
  412
  413
  414
  415
  416%he believes that mary wants to marry a sailor
  417cl_example("
  418(exists ((?x1 person) (?x2 believe))
  419   (and (expr ?x2 ?x1)
  420        (thme ?x2
  421           (exists ((?x3 person) (?x4 want) (?x8 situation))
  422              (and (name ?x3 'Mary) (expr ?x4 ?x3) (thme ?x4 ?x8)
  423                   (dscr ?x8 (exists ((?x5 marry) (?x6 sailor))
  424                                (and (Agnt ?x5 ?x3) (Thme ?x5 ?x6)))))))))").
  425% cg_reader_tests
  426
  427
  428skip_cl_example("
  429(exists ((?x person) (?y rock) (?z place) (?w hard))
  430        (and (betw ?y ?z ?x) (attr ?z ?w)))").
  431
  432skip_cl_example(  "
  433(For a number x, a number y is ((x+7) / sqrt(7)))")