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 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 26 replace_in_string(['//'='%'],Str,Str0),
27 with_only_operators(
28 [ 29 op(1000,yfx,'<-'),op(1000,yfx,'->'),
30 op(1000,yfx,'-'), 31 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
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
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), 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,'<-'). 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].
145
146reop_cg_mid(IO,IO):-!.
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.
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.
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.
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])}.
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),[']'],!.
233:- begin_cg. 234
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
266
267
268
270
272
273
277
278
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 322:- fixup_exports. 323
324:- pop_operators.