1/*:- current_op(X,Y,'->'),cginput:op(X,Y,'<-').
    2:- current_op(X,Y,'->'),cginput:op(X,Y,'-').
    3*/
    4:- throw(cgp_common_logic_extra).    5
    6:- forall(current_op(X,Y,(+)),op(X,Y,(*))).    7:- forall(current_op(X,Y,(+)),op(X,Y,(?))).    8:- forall(current_op(X,Y,(+)),op(X,Y,(@))).    9
   10:- discontiguous(cg_test_data/2). 
   11:- multifile_data(cg/1).   12
   13:- current_op(X,Y,'->'),push_operators([op(X,Y,'<-')]).   14
   15cg_df_to_term(In,Out):- any_to_string(In,Str),
   16  % replace_in_string(['('='{',')'='}'],Str,Str0),
   17  replace_in_string(['//'='%'],Str,Str0),
   18  atom_codes(Str0,Codes),
   19  tokenize_cg(Toks,Codes,[]),
   20  must_or_rtrace(parse_cg(CG,Toks,[])),
   21  Out = cg(CG),!.
   22
   23
   24unused_cg_df_to_term(In,Out):- any_to_string(In,Str),
   25  % replace_in_string(['('='{',')'='}'],Str,Str0),
   26  replace_in_string(['//'='%'],Str,Str0),
   27  with_only_operators(
   28   [% op(900,xfy,'<-'),op(1000,yfx,'->'),op(1100,xfy,'-'),op(1110,xfx,'-'),op(1100,yfx,'-'),op(500,xfx,':'),
   29   op(1000,yfx,'<-'),op(1000,yfx,'->'),
   30   op(1000,yfx,'-'), %op(1100,yfx,'-'),
   31    /*% op(1170,yfx,'<-'),op(1150,yfx,'->'),
   32    % op(1000,yfx,'<-'),op(1000,yfx,'->'),    
   33   op(900,xfy,'<-'),
   34  % op(900,yfx,'<-'),
   35  % op(900,xfx,'<-'), 
   36   op(900,yfx,'->'), 
   37  % op(900,xfy,'->'),
   38  % op(900,xfx,'->'), 
   39    op(1100,xfy,'-'),
   40  %  op(1000,fy,'-'),
   41
   42  */
   43   
   44
   45    op(300, fx,'?'),op(300, fx,'#'),op(300, fx,'*'),op(300, fx,'@'),
   46    op(300,yfx,'?'),op(300,yfx,'#'),op(300,yfx,'*'),op(300,yfx,'@'),
   47
   48    op(1200,xfx,':'),op(1200,xfx,'=')],
   49
   50     read_term_from_atom(Str0,Out,[variable_names(Vs)])), maplist(call,Vs),!.
   51  
   52
   53% cg_test_data(call,"[M1]<-(equal)-[Mat]<-(On)-[Cat: ?x].").
   54cg_test_data(reader,"[Mat #1]-(equal)->[Thingy #1].").
   55cg_test_data(reader,"[Thingy #1]<-(equal)-[Mat #1].").
   56cg_test_data(reader,"[Mat #1]<- (on)- [Cat: #1]").
   57
   58cg_test_data(reader,"[Cat #1]-(On)->[Mat #1]-(equal)->[Thingy #1].").
   59
   60cg_test_data(reader,"[Thingy #1] <- (equal) -[Mat #1]<- (on)- [Cat: #1]").
   61
   62cg_test_data(reader,"[Cat: #1]-(On)->[Mat #1]-(equal)->[Thingy #1].").
   63
   64cg_test_data(reader,"[Man:karim]<-agnt-[Drink]-obj->[Water]").
   65
   66cg_test_data(call,"[Cat: ?x]-(On)->[Mat #1]-(equal)->[Thingy #1].").
   67
   68cg_test_data(call,"[?x]-(On)->[Mat #1]-(equal)->[Thingy #1].").
   69cg_test_data(call,"?x -(On)->[Mat #1]-(equal)->[Thingy #1].").
   70cg_test_data(call,"?x -(On)->[Mat #1].").
   71
   72cg_test_data(call,"[Mat ?x]-(equal)->[Thingy #1].").
   73cg_test_data(call,"[?x] -(equal)-> [Thingy #1].").
   74cg_test_data(call,"?x -(equal)-> [Thingy #1].").
   75
   76
   77
   78% cg_test_data(reader,"[Cat: ?x]-(On)->[Mat]-(equal)->M1.").
   79
   80cg_reader_tests :- make, forall((cg_test_data(reader,X)),assert_cg(text(X))).
   81
   82cg_demo :- make, forall(cg_test_data(call,X),(call_cg(X))).
   83
   84ground_variables_as_atoms([],_Vars):-!.
   85ground_variables_as_atoms(_,[]):-!.
   86ground_variables_as_atoms(Vs,[N=V|Vars]):-
   87  ground_variables_as_atoms(Vs,Vars),
   88  (member_eq0(V, Vs) -> V = N ; true).
   89
   90term_expansion(In,IS, Out,OS):- notrace((compound(In), In= cg(Stuff), nonvar(Stuff),nb_current(cg_term_expand,true))),
   91   prolog_load_context('term',Term), % dmsg(Term=In),
   92   Term=@=In,    
   93   nb_current('$variable_names',Vars), 
   94   term_variables(Stuff,Vs),!,
   95   ground_variables_as_atoms(Vs,Vars),
   96   current_why(UU),IS=OS,
   97   Out = (:- with_current_why(UU, assert_cg(cg(Stuff)))).
   98
   99
  100begin_cg:- style_check(-singleton), nb_setval(cg_term_expand,true).
  101
  102
  103:- current_op(X,Y,'->'),cginput:op(X,Y,'<-').  104%:- current_op(X,Y,'->'),X2 is X + 1, cginput:op(X2,Y,'-').
  105%:- current_op(X,Y,(+)),cginput:op(X,Y,(*)).
  106%:- cginput:current_op(X,Y,(*)),cginput:op(X,Y,(?)).
  107%:- cginput:current_op(X,Y,(*)),cginput:op(X,Y,(@)).
  108
  109
  110
  111not_oper(S):-  compound(S), compound_name_arity(S,F,_),member(F,['<-','-','->']),!,fail.
  112not_oper(_).
  113
  114assert_cg(X):- !,newId(Id),locally(nb_setval(cgid,Id), pred_cg(assert_cg_real,X)).
  115assert_cg_real(X):- nb_current(cgid,Id), print_cg(Id,X),  ain(cg(Id,X)).
  116
  117call_cg(X):- pred_cg(call_cg_real,X).
  118call_cg_real(X):- print_cg(X),call(cg(X)).
  119
  120
  121pred_cg(Pred, X):- is_list(X),maplist(pred_cg(Pred),X).
  122pred_cg(Pred, text(X)):- cg_df_to_term(X,Y),!, pred_cg(Pred, cg(Y)).
  123pred_cg(Pred, cg(CG)):- wdmsg(pred_cg(Pred, CG)), !, call(Pred,CG).
  124pred_cg(Pred, X):- reop_cg_post(X,Y), X\=@= Y, pred_cg(Pred, Y).
  125pred_cg(Pred, X):- reop_cg_pred(Pred,X).
  126
  127
  128print_cg(X):- is_list(X),!, maplist(print_cg,X).
  129print_cg(X):- nl,display(X),nl.
  130
  131
  132
  133
  134
  135reop_cg(In,Out):- reop_cg_pre(In,M1),reop_cg_mid(M1,M2),reop_cg_post(M2,Out).
  136
  137reop_cg_pre(In,Out):- \+ compound(In),!, Out=In.
  138reop_cg_pre(['#'(Type,Numbr)],Out):- !, reop_cg_pre(type_thing(Type,'#'(Numbr)),Out).
  139reop_cg_pre(['#'(Numbr)],Out):- !, reop_cg_pre(entity('#'(Numbr)),Out).
  140reop_cg_pre([Type:Thing],Out):- !, reop_cg_pre(type_thing(Type,Thing),Out).
  141reop_cg_pre([Thing],Out):- \+compound(Thing), !, reop_cg_pre(entity(Thing),Out).
  142reop_cg_pre(In,Out):- is_list(In),!,maplist(reop_cg_pre,In,Out).
  143reop_cg_pre(In,Out):- In=..[OP|AB],maplist(reop_cg_pre,AB,AABB),Out=..[OP|AABB].
  144% reop_cg_pre(OIn,OIn).
  145
  146reop_cg_mid(IO,IO):-!.
  147%reop_cg_mid(In,Out):- format(chars(Chars),' ~q . ',[In]),cg_df_to_term(Chars,Out),
  148%  ignore((fail,Out\=@=In, with_no_operators((nl,display(bf(In)),nl,display(af(Out)),nl)))),!.
  149
  150
  151reop_cg_base(-(S,->(P,O)),spo(r,S,P,O)).
  152reop_cg_base(->(-(S,P),O),spo(r,S,P,O)).
  153reop_cg_base(-(<-(O,P),S),spo(l,S,P,O)).
  154reop_cg_base(<-(O,-(P,S)),spo(i,S,P,O)).
  155
  156
  157not_oper(SPOS,S):- is_entity(SPOS),!,S = SPOS.
  158%right_side(spo(SPO,_,_),S):- !, right_side(SPO,S),!. 
  159% not_oper(SPOS,S):- arg(_,SPOS,A1), compound(A1),!, not_oper(A1,S).
  160
  161
  162reop_cg_pred(Pred, S-A-B):- !,reop_cg_pred(Pred, S-A),reop_cg_pred(Pred, S-B).
  163reop_cg_pred(Pred, In):- is_list(In), !,maplist(reop_cg_pred(Pred),In).
  164reop_cg_pred(Pred, In):- reop_cg_base(In,O),!,reop_cg_pred(Pred, O).
  165reop_cg_pred(Pred, spo(RL,SPO,P,O)):- reop_cg_base(SPO,SPOC), reop_cg_pred(Pred, spo(RL,SPOC,P,O)).
  166reop_cg_pred(Pred, spo(RL,S,P,SPO)):- reop_cg_base(SPO,SPOC), reop_cg_pred(Pred, spo(RL,S,P,SPOC)).
  167reop_cg_pred(Pred, spo(RL,spo(l,SS,PP,OO),P,O)):- reop_cg_pred(Pred, spo(l,SS,PP,OO)),reop_cg_pred(Pred, spo(RL,SS,P,O)).
  168reop_cg_pred(Pred, spo(RL,spo(r,SS,PP,OO),P,O)):- reop_cg_pred(Pred, spo(r,SS,PP,OO)),reop_cg_pred(Pred, spo(RL,OO,P,O)).
  169reop_cg_pred(Pred, spo(RL,S,P,spo(l,SS,PP,OO))):- reop_cg_pred(Pred, spo(l,SS,PP,OO)),reop_cg_pred(Pred, spo(RL,S,P,SS)).
  170reop_cg_pred(Pred, spo(RL,S,P,spo(r,SS,PP,OO))):- reop_cg_pred(Pred, spo(r,SS,PP,OO)),reop_cg_pred(Pred, spo(RL,S,P,OO)).
  171reop_cg_pred(Pred, spo(RL,S,P,O)):- not_oper(S),not_oper(P),not_oper(O),!,wdmsg(call(Pred,spo(RL,S,P,O))).
  172reop_cg_pred(Pred, Error):- trace_or_throw(reop_cg_pred(Pred, Error)).
  173
  174
  175reop_cg_post(In,Out):-  is_entity(In),!,Out=In.
  176reop_cg_post(In,Out):- \+ compound(In),!, Out=In.
  177%reop_cg_post(In,Out):- is_list(In),!,Out=In.
  178%reop_cg_post(-(<-(O,P),SPOS),[SPOS,SPO]):- left_side(SPOS,S), SPO = (spo(S,P,O)).
  179reop_cg_post(In,Out):- In=..[OP|AB],maplist(reop_cg_post,AB,AABB),Out=..[OP|AABB].
  180reop_cg_post(OIn,OIn).
  181
  182
  183is_entity(Atom):- atom(Atom).
  184is_entity(entity(_)).
  185is_entity(type_thing(_,_)).
  186
  187dcg_used_chars(DCG1, O, S, E):- phrase(DCG1,S, E),!,O=S.
  188% dcg_both(DCG1,DCG2, S, E):- phrase(DCG1,S, E),!,phrase(DCG2,S, E).
  189%  ['Man':imad]<-agnt-['Drive']-obj->['Car']                                
  190
  191:- use_module(library(http/dcg_basics)).  192prolog_id_conted([C|T])--> [C], {(C=45;code_type(C, prolog_identifier_continue))},!,prolog_id_conted(T).
  193prolog_id_conted([])-->[].
  194
  195tokenize_cg('[')--> `[`,!.
  196
  197tokenize_cg('<-')--> `<-`,!.
  198tokenize_cg('->')--> `->`,!.
  199tokenize_cg(Name)--> [C], {member(C,`[()]*@-=:,.$#`)},!,{ atom_codes(Name, [C])}.
  200%tokenize_cg(Name)--> dcg_used_chars(((`[` ; `(` ;`)` ; `]` ; `*`; `@`; `=`; `,`; `.`)), CL),!,{ atom_codes(Name, CL)}.
  201tokenize_cg(var(Name)) --> `?`,prolog_id_conted(CL),{ atom_codes(Name, CL)},!.
  202tokenize_cg(T)--> dcg_basics:number(T),!.
  203tokenize_cg(Name)--> prolog_id_conted(CL), !,{ atom_codes(Name, CL)},!.
  204tokenize_cg(Name)--> [C],{ atom_codes(Name, [C])},!.
  205
  206tokenize_cg_list([],S,E):- S=[],!,E=[].
  207tokenize_cg_list(HT)--> blank,!,tokenize_cg_list(HT).
  208tokenize_cg_list([H|T])--> tokenize_cg(H),!,tokenize_cg_list(T).
  209tokenize_cg_list([])-->[],!.                                             
  210
  211dcg_look(Grammar,List,List):- (var(Grammar)->((N=2;N=1;between(3,20,N)),length(Grammar,N)); true),phrase(Grammar,List,_),!.
  212
  213parse_cg(List) --> concept(S),['-'], dcg_look(['-']),!,graph_listnode(S,List).
  214parse_cg([rel(Rel,Subj,Obj)|List]) --> concept(Subj),['-'], rel(Rel),['->'],!,concept(Obj),graph_listnode(Obj,List).
  215parse_cg([rel(Rel,Subj,Obj)|List]) --> concept(Obj),['<-'], rel(Rel),['-'],!,concept(Subj),graph_listnode(Subj,List).
  216graph_listnode(Subj,[rel(Rel,Subj,Obj)|List]) --> ['-'],rel(Rel),['->'], concept(Obj), ([','];dcg_look(['-'])) ,!, graph_listnode(Subj,List).
  217graph_listnode(Subj,[rel(Rel,Subj,Obj)|List]) --> ['-'],rel(Rel),['->'], concept(Obj), graph_listnode(Obj,List).
  218graph_listnode(Obj,[rel(Rel,Subj,Obj)|List]) --> ['<-'],rel(Rel),['-'], concept(Subj), graph_listnode(Subj,List).
  219graph_listnode(_,[])--> ((\+ [_]);['.']).
  220
  221rel(C)--> ['(',C,')'].
  222concept(entity(C)):- ['[',C,']'],!.
  223concept(ct(Type,Word)):- ['[',Type,':',Word,']'],!.
  224concept(cg(Concept,SubGraph))--> ['[',Concept,'='], parse_cg(SubGraph),[']'],!.
  225/*
  226tokenize_cg_list(L,`[`,[]).
  227tokenize_cg_list(L,`[Begin]-        -obj->[Session],
  228        -srce->[Proposition = [Press] -
  229       -obj -> [Key : enter]-partOf->[Keyboard],
  230       -agnt -> [Person : John] ],
  231        -agnt->[Person : John]`,O).
  232*/
  233:- begin_cg.  234
  235%cg_test_data(reader,"[Cat: ?x]-(equal)->M1-(On)->[Mat].").
  236cg_test_data(reader,"[Cat: ?x]-(On)->[Mat].").
  237cg_test_data(reader,"[Mat]<-(On)-[Cat: ?x].").
  238
  239
  240
  241
  242cg_test_data(reader,"
  243
  244// ontology required (to load first): aminePlatform/samples/ontology/ManOntology2.xml
  245[Eat #0] -
  246      -obj->[Apple],
  247      -manr->[Fast],
  248      -agnt->[Man]
  249
  250").
  251
  252
  253cg_test_data(reader,"
  254[Begin]-
  255        -obj->[Session],
  256        -srce->[Proposition = [Press] -
  257	       -obj -> [Key : enter]-partOf->[Keyboard],
  258	       -agnt -> [Person : John] ],
  259        -agnt->[Person : John]").
  260
  261cg_test_data(reader,"[Man:karim]<-agnt-[Drink]-obj->[Water]").
  262
  263cg_test_data(reader,"[Woman:red]<-knows-[Man:karim]<-agnt-[Eat]-obj->[Apple]-(on)->table").
  264
  265%cg([Man:karim]<-agnt-[Eat]-obj->[Apple]).
  266
  267
  268
  269%cg([Cat: @every]->(On)->[Mat]).
  270
  271%cg([Man:karim]<-agnt-[Drink]-obj->[Water]).
  272
  273
  274%cg([Woman:red]<-knows-[Man:karim]<-agnt-[Eat]-obj->[Apple]-(on)->table).
  275%cg([Man:imad]<-agnt-[Drive]-obj->[Car]).
  276%cg([Cat: ?x]-(On)->[Mat]).
  277
  278
  279% syntax errpr cg_test_data(reader,"[Cat: @every]->(On)->[Mat]").
  280cg_test_data(reader,"
  281
  282[Go]-
  283   (Agnt)->[Person: John] -
  284   (Dest)->[City: Boston] -
  285   (Inst)->[Bus].
  286
  287").
  288
  289
  290dont_cg_test_data(reader,"
  291[Person: Tom]<-(Expr)<-[Believe]->(Thme)-
  292     [Proposition:  [Person: Mary *x]<-(Expr)<-[Want]->(Thme)-
  293     [Situation:  [?x]<-(Agnt)<-[Marry]->(Thme)->[Sailor] ]].
  294").
  295
  296
  297 /*
  298cg([Go]-
  299   (Agnt)->[Person: John] -
  300   (Dest)->[City: Boston] -
  301   (Inst)->[Bus]).
  302
  303cg([Go2]
  304   - (Agnt)->[Person: John2]
  305   - (Dest)->[City: Boston2]
  306   - (Inst)->[Bus2]).
  307
  308cg(
  309   [Person: John2] <- (Agnt) - 
  310   [City: Boston2] <- (Dest) -
  311   [Bus2] <- (Inst) -
  312
  313   [Go2]).
  314
  315
  316cg(
  317[Person: Tom]<-(Expr)<-[Believe]->(Thme)-
  318     [Proposition:  [Person: Mary *x]<-(Expr)<-[Want]->(Thme)-
  319     [Situation:  [?x]<-(Agnt)<-[Marry]->(Thme)->[Sailor] ]]).
  320
  321*/
  322:- fixup_exports.  323
  324:- pop_operators.