1:- encoding(iso_latin_1).
2:- module(prolog_plus_cg_reader,[cg_begin/0,cg_end/0,set_cg_file/1]). 3:- set_module(class(library)). 4:- nodebug(cg_inline). 5:- use_module(library(cgprolog)). 6
7:- multifile_data(cg/1). 8:- multifile_data(cg_inline/1). 9
10ppcg_expansion(IS, _, _):- var(IS), !, fail.
11ppcg_expansion(_, In, _):- var(In), !, fail.
12ppcg_expansion(_, end_of_file, _Out):-
13 source_location(F,_), retractall(t_l:cg_term_expand(_,F,_)),
14 set_cg_file(false),
15 fail.
16ppcg_expansion(_, In, _):- \+ compound(In), !, fail.
17ppcg_expansion(_, In, _):- \+ is_current_source_term(In), !, fail.
18ppcg_expansion(IS, _, _):- compound(IS), \+ is_in_cg(IS), !, fail.
19ppcg_expansion(_, In, Out):- ppcg_expand(In, Out), In\==Out, ignore((debugging(cg_inline),wdmsg(Out),nl)).
20
21
22
23prolog_plus_cg_op(',').
24prolog_plus_cg_op('->').
25prolog_plus_cg_op('-').
26prolog_plus_cg_op(OP):- current_op(Priority,_,OP), 7 is Priority mod 10.
27inline_reader_ops(OPS):- OPS = [op(1157,yfx,'::'),op(1157,yfx,'>'),op(957,yfx,'<-'),op(957,yfx,'->'),op(1157,yfx,'=')].
28
29inline_reader_ops(OPS):-
30
31 current_op(X1,Y1,('+')),
32 current_op(X,Y,('->')),
33 =(OPS,
34 ([op(X,Y,('<-')),
35 op(X1,Y1,('*')),op(X1,Y1,('?')),op(X1,Y1,('@')),
36 op(900,xfy,('<-')),op(1000,yfx,('->')),op(1100,xfy,('-')),op(1110,xfx,('-')),op(1100,yfx,('-')),op(500,xfx,(':')),
37 op(300, fx,('?')),op(300, fx,('#')),op(300, fx,('*')),op(300, fx,('@')),
38 op(300,yfx,('?')),op(300,yfx,('#')),op(300,yfx,('*')),op(300,yfx,('@')),
39 op(1200,xfx,(':')),op(1200,xfx,('='))])).
40
41
42term_to_cg(In,Out):-
43 format(chars(Chars),' ~q. ',[In]),
44 any_to_string(Chars,Str),
45 46 replace_in_string(['\r'='\n'],Str,Str0),
47 atom_codes(Str0,Codes),
48 must_or_rtrace(tokenize_cg(Toks,Codes,[])),
49 parse_cg(Out,Toks,[]),!,
50 ignore((fail,Out\=@=In, with_no_operators((nl,display(bf(In)),nl,display(af(Out)),nl)))),!.
51
52
53atom_unless_var(N,_):- \+ atomic(N),!.
54atom_unless_var(N,_):- atom_concat('_',_,N).
55atom_unless_var(N,_):- downcase_atom(N,N).
56atom_unless_var(N,V):- N = V.
57
58
59ppcg_expand(In, _):- debugging(cg_inline), display(In),nl,fail.
60ppcg_expand(In, _Out):- \+ compound(In), !, fail.
61ppcg_expand(In, _Out):- In = ( :- _ ),!, fail.
62ppcg_expand((H:-B), Out):- !, is_ppcg_head(H), force_ppcg_expand((H:-B), Out).
63ppcg_expand(H, Out):- !, is_ppcg_head(H), force_ppcg_expand(H, Out).
64
65is_ppcg_head(In):- var(In),!.
66is_ppcg_head(In):- compound(In), functor(In,F,A), prolog_plus_cg_op(F), member(A,[1,2]).
67
68force_ppcg_expand(In, Out):-
69 implode_varnames_pred(atom_unless_var, In),
70 Out = cg_inline(In),!.
71
72force_ppcg_expand(cg(In),Out) :-
73 implode_varnames_pred(=, In),
74 term_to_cg(In,CG),
75 current_why(UU),
76 Out = (:- with_current_why(UU, assert_cg(cg(CG)))).
77
78:- dynamic(t_l:cg_term_expand/3). 79
80is_file_in_cg(F,CL):-
81 t_l:cg_term_expand(begin_cg,F,BL), (CL > BL), !,
82 \+ (t_l:cg_term_expand(end_cg,F,EL), ((EL > BL), (EL < CL))).
83
84cg_begin:- source_location(F,L),assertz(t_l:cg_term_expand(begin_cg,F,L)),!, set_cg_file(true),!.
85cg_end:- source_location(F,L),assertz(t_l:cg_term_expand(end_cg,F,L)), set_cg_file(false),!.
86
87
88is_in_cg(_IS):- check_in_cg.
89
90
91check_in_cg:- ignore(((source_location(F,L), fail, (is_file_in_cg(F,L) -> set_cg_file(true) ; set_cg_file(false))))),!,
92 nb_current(cg_term_expand,true).
93
94
95set_cg_file(TF):- nb_current(cg_term_expand,TF),!.
96set_cg_file(TF):- nb_setval(cg_term_expand,TF),
97 set_prolog_flag(allow_variable_name_as_functor,TF),
98 (TF -> ((set_prolog_flag(encoding,iso_latin_1),style_check(-singleton))) ; style_check(+singleton)),
99 (TF -> (inline_reader_ops(OPS), push_operators(OPS, Undo), asserta(undo_cg_file_ops(Undo)))
100 ;ignore((retract(undo_cg_file_ops(Undo)),pop_operators(Undo)))),!.
101
102ppcg_ge(In,Out):- In== (/), Out=!.
103
105
106term_expansion(In,IS,Out,OS) :- ppcg_expansion(IS,In,Out)-> IS=OS.
107goal_expansion(In,Out) :- ppcg_ge(In,Out).
108
109:- dynamic addInstance/2,eq/2,isInstanceOf/2,maximalJoin/6,phrase_imperative/2,read_sentence/1. 110:- multifile addInstance/2,eq/2,isInstanceOf/2,maximalJoin/6,phrase_imperative/2,read_sentence/1. 111
112
113
114:- cg_begin. 115
116Universal > Person, Object, Action, Attribute, Proposition.
117
118
119Person > Man, Woman.
120Object > Pyramid, Cube, Sphere.
121Action > Put, Push, Create, Move.
122Attributc > Size, Color, Modality.
123
124
125Color = blue, red.
126Size = small, big.
127Man = john.
128
129:- discontiguous(lexicon/3). 130
131lexicon("push", verb, [Push]-
132 -obj->[Object],
133 -on->[Object] ).
134lexicon("create", verb, [Create]-obj->[Object]-colorOf->[Color]).
135
136
137lexicon("pyramid", noun, Pyramid).
138lexicon("cube", noun, Cube).
139lexicon("sphere", noun, Cube).
140
141lexicon("small", adj, sizeOf, Size, small).
142lexicon("red", adj, colorOf, Color, red).
143lexicon("big", adj, sizeOf, Size, big).
144lexicon("blue", adj, colorOf, Color, blue).
145
146lexicon("on", prep, on).
147lexicon("under", prep, under).
148lexicon("left", prep, left).
149lexicon("right", prep, right).
150
151lexicon("the", art, x).
152lexicon("a", art, x).
153Verb(v, G) :- lexicon(v, verb, G).
154
155Prep((v|P), P, V) :- lexicon(v, prep, V).
156
157Art((v|P), P, V) :- lexicon(v, art, V), (/).
158Art(P, P, undefined).
159
160Noun((v|P), P, V) :- lexicon(v, noun, V).
161
162Adj(A, R, T, V) :- lexicon(A, adj, R, T, V).
163
164Shrdlu :-
165 write("**** Welcome to the SHRDLU_PCG Program *******"),
166 % new(aShrdlu_Canvas3D, "PrologPlusCG.Shrdlu_Canvas3D", '()'),
167 read_sentence(_sentence),
168 ShrdluDialog(_sentence), (/).
169
170ShrdluDialog(("end", ".")) :- (/).
171ShrdluDialog(_sentence) :-
172 Semantic_Analysis(_sentence, _CG),
173 write(_CG),
174 _CG,
175 read_sentence(_s),
176 ShrdluDialog(_s), (/).
177
178semantic_analyzer :-
179 read_sentence(P),
180 phrase_imperative(P, G),
181 write(G), (/).
182
183Semantic_Analysis(_sentence, _CG) :-
184 imperative_sentence(_sentence, _CG).
185
186% WAS [Proposition = G] - (mode) -> [ Modality = imperative]�:- G.
187['Proposition'='G']-mode->['Modality'=imperative]:-'G' .
188
189[Create]-obj->[T_Obj : _IdObj]-colorOf->[Color = C] :-
190 asserta(object([T_Obj : _IdObj]-colorOf->[Color = C]), '()'),
191 write((T_Obj, _IdObj, C)),
192 193 (/).
194
195imperative_sentence((V|P1),
196 [Proposition = G]-mode->[Modality = imperative]) :-
197 Verb(V, G_V),
198 NP(P1, P2, E_NP1, S1),
199 eq([T_Verb]-obj->E_N_G1, G_V),
200 maximalJoin(G_V, E_N_G1, S1, E_NP1, G1_S1, _),
201 complement(P2, T_Verb, G1_S1, G).
202
203complement(("."), _, G, G) :- (/).
204complement(P2, T_Verb, G1_S1, G) :-
205 Prep(P2, P3, s_prep),
206 NP(P3, ("."), E_NP2, S2),
207 eq([T_Verb]-s_prep->E_N_G2, G1_S1),
208 maximalJoin(G1_S1, E_N_G2, S2, E_NP2, G, _).
209
210
211NP(P, P1, E, G) :-
212 Art(P, P2, A1),
213 AdjsSynt(P2, P3, L_Adjs),
214 Noun(P3, P4, N),
215 suiteNP(P4, P1, N, A1, L_Adjs, E, G), (/).
216
217suiteNP((N1|P1), P1, N, A1, L_Adjs, E, G) :-
218 not(lexicon(N1, _, _)),
219 not(lexicon(N1, _, _, _, _)),
220 traiteInst(N1, N),
221 SemAdjs(L_Adjs, N, N1, G, E), (/).
222suiteNP(P4, P1, N, A1, L_Adjs, E, G) :-
223 SemAdjs(L_Adjs, N, A1, S, E1),
224 AdjsSynt(P4, P1, L_Adjs2),
225 SemAdjs(L_Adjs2, N, A1, S1, E11),
226 maximalJoin(S, E1, S1, E11, G, E).
227
228traiteInst(N1, N) :-
229 isInstanceOf(N1, N), (/).
230traiteInst(N1, N) :-
231 addInstance(N1, N).
232
233AdjsSynt((A|P), P1, (A|L_Adjs)) :-
234 lexicon(A, adj, _, _, _),
235 AdjsSynt(P, P1, L_Adjs), (/).
236AdjsSynt(P, P, '()').
237
238SemAdjs((A|P), N, A1, S, E_N_S) :-
239 Adj(A, R1, T1, V1),
240 eq(G, [N : A1]-R1->[T1 = V1]),
241 eq(G, E_N-R1->x),
242 SemAdjs2(P, G, E_N, N, A1, S, E_N_S), (/).
243SemAdjs('()', N, A1, G, E) :-
244 eq(G, [N : A1]),
245 eq(G, E-rel->[Universal]), (/).
246
247SemAdjs2((A|P), G, E_N, N, A1, S, E_S) :-
248 Adj(A, R, T, V),
249 eq(G1, [N : A1]-R->[T = V]),
250 eq(G1, E_N1-R->x),
251 maximalJoin(G, E_N, G1, E_N1, G2, E_N2),
252 SemAdjs2(P, G2, E_N2, N, A1, S, E_S), (/).
253SemAdjs2