1:- module(tidylog_dcg, [ read_prolog//1, write_prolog//1 ]). 2
3:- use_module(library(tidylog/atom/name), [name//1]). 4:- use_module(library(tidylog/atom/punc), [punctuation//1]). 5
6:- use_module(library(tidylog/comment/aol), [aol_comment//1]). 7:- use_module(library(tidylog/comment/ml), [ml_comment//1]). 8
9:- use_module(library(tidylog/number/decimal), [decimal//1]). 10:- use_module(library(tidylog/number/hex), [hex//1]). 11:- use_module(library(tidylog/number/octal), [octal//1]). 12:- use_module(library(tidylog/number/binary), [binary//1]). 13:- use_module(library(tidylog/number/float), [float//1]). 14
15:- use_module(library(tidylog/text), [text//2]). 16
17:- use_module(library(dcg/basics), [eos//0]). 18:- use_module(library(lists), [proper_length/2]). 19:- use_module(library(portray_text), []). 20
24
25read_prolog(T) -->
26 comment(T),
27 eos.
28read_prolog(T) -->
29 term(T,1200),
30 end.
31
32
33write_prolog(T) -->
34 term_out(T),
35 ( { is_comment(T) } -> []; end ).
36
37
39term(T,P) -->
40 number_term(T,P).
41term(T,P) -->
42 variable_term(T,P).
43term(T,P) -->
44 compound_term(T,P).
45term(T,P) -->
46 atom_term(T,P).
47term(T,P) -->
48 paren_term(T,P).
49term(T,P) -->
50 string_term(T,P).
51term(T,P) -->
52 prefix_operator_term(T,P).
53
54
56term_out(Var) -->
57 { var(Var), ! },
58 { name_the_vars(Var, Names) },
59 write_term(Var,[variable_names(Names)]).
60term_out(AolComment) -->
61 aol_comment(AolComment).
62term_out(MlComment) -->
63 ml_comment(MlComment).
64term_out(Integer) -->
65 decimal(Integer).
66term_out(Op) -->
67 { is_operator(Op) },
68 format("(~w)",[Op]).
69term_out(Atom) -->
70 { atom(Atom) },
71 name(Atom).
72term_out(Punctuation) -->
73 { atom(Punctuation) },
74 punctuation(Punctuation).
75term_out(Text) -->
76 text(_,Text).
77term_out(Head :- Body) -->
78 term_out(Head),
79 " :-",
80 nl,
81 indent,
82 term_out(Body).
83term_out(F) -->
84 float(F).
85term_out(T) -->
86 format("~q",[T]).
87
88
89number_term(T,P) -->
90 float_number(F),
91 rest_term(F,T,0,P).
92number_term(T,P) -->
93 decimal(I),
94 rest_term(I,T,0,P).
95number_term(T,P) -->
96 hex(I),
97 rest_term(I,T,0,P).
98number_term(T,P) -->
99 octal(I),
100 rest_term(I,T,0,P).
101number_term(T,P) -->
102 binary(I),
103 rest_term(I,T,0,P).
104
105
106variable_term(T,P) -->
107 variable(V),
108 rest_term(V,T,0,P).
109
110name_the_vars(Term,Names) :-
111 term_variables(Term, Vars),
112 maplist(variable_name,Vars,Names).
113
114variable_name(Var,Name=Var) :-
115 get_attr(Var, tidylog, name(Name)).
116
117atom_term(T,P) -->
118 atom(A),
119 { \+ is_operator(A) },
120 rest_term(A,T,0,P).
121atom_term(Op,_P) -->
122 atom(Op),
123 { is_operator(Op) }.
124
125atom(A) -->
126 optional_layout_text,
127 name_token(A).
128
129
130compound_term(T,P) -->
131 132 atom(F),
133 open_paren,
134 term(Arg,999),
135 arg_list(L),
136 { Term =.. [F, Arg | L ] },
137 rest_term(Term,T,0,P).
138compound_term(T,P) -->
139 140 open_bracket,
141 term(Arg,999),
142 items(List),
143 rest_term('[|]'(Arg,List),T,0,P).
144compound_term(T,P) -->
145 146 open_curly,
147 term(Term,1200),
148 close_curly,
149 rest_term('{}'(Term),T,0,P).
150
151arg_list([]) -->
152 close_paren.
153arg_list([H|T]) -->
154 comma,
155 term(H,999),
156 arg_list(T).
157
158items('[|]'(H,T)) -->
159 comma,
160 term(H,999),
161 items(T).
162items(T) -->
163 head_tail_separator,
164 term(T,999),
165 close_bracket.
166items('[]') -->
167 close_bracket.
168
169
170paren_term(T,P) -->
171 open_paren,
172 term(Term,1200),
173 close_paren,
174 rest_term(Term,T,0,P).
175paren_term(T,P) -->
176 "(",
177 term(Term,1200),
178 close,
179 rest_term(Term,T,0,P).
180
181
182string_term(T,P) -->
183 text(string,S),
184 rest_term(S,T,0,P).
185string_term(T,P) -->
186 text(codes,S),
187 rest_term(S,T,0,P).
188
189
190prefix_operator_term(T,P) -->
191 atom(Op),
192 term(Arg,ArgP),
193 { prefix_operator(Op,OpP,ArgP) },
194 { P >= OpP },
195 { Term =.. [Op, Arg] },
196 rest_term(Term,T,OpP,P).
197
198
199rest_term(LeftArg,T,LeftP,P) -->
200 atom(Op),
201 { infix_operator(Op,OpP,LAP,RAP) },
202 { P >= OpP },
203 { LeftP =< LAP },
204 term(RightArg,RAP),
205 { Term =.. [Op,LeftArg,RightArg] },
206 rest_term(Term,T,OpP,P).
207rest_term(LeftArg,T,LeftP,P) -->
208 atom(Op),
209 { postfix_operator(Op,OpP,LAP) },
210 { P >= OpP },
211 { LeftP =< LAP },
212 { Term =.. [Op, LeftArg] },
213 rest_term(Term,T,OpP,P).
214rest_term(Left,T,LeftP,P) -->
215 comma,
216 { P >= 1000 },
217 { LeftP < 1000 },
218 term(Right,1000),
219 rest_term(','(Left,Right),T,1000,P).
220rest_term(Term,Term,_,_) -->
221 [].
222
223
224variable(Var) -->
225 optional_layout_text,
226 variable_token(X),
227 { atom_codes(Name,X) },
228 { set_variable_name(Var,Name) }.
229
230set_variable_name(Var,Name) :-
231 put_attr(Var,tidylog,name(Name)).
232
233
234float_number(F) -->
235 optional_layout_text,
236 float(F).
237
238
239open_paren -->
240 optional_layout_text,
241 "(".
242
243
244close_paren -->
245 optional_layout_text,
246 ")".
247
248
249open_bracket -->
250 optional_layout_text,
251 "[".
252
253
254close_bracket -->
255 optional_layout_text,
256 "]".
257
258
259open_curly -->
260 optional_layout_text,
261 "{".
262
263
264close_curly -->
265 optional_layout_text,
266 "}".
267
268
269head_tail_separator -->
270 optional_layout_text,
271 "|".
272
273
274comma -->
275 optional_layout_text,
276 ",".
277
278
279end -->
280 optional_layout_text,
281 ".".
282
283
285parsing(H,H) :-
286 nonvar(H).
287
289:- meta_predicate greedy(//,?,?). 290greedy(Rule) -->
291 call(Rule),
292 greedy(Rule).
293greedy(_) -->
294 [].
295
296format(Pattern,Args,H,T) :-
297 format(codes(H,T),Pattern,Args).
298
299write_term(Term,Options,H,T) :-
300 with_output_to(codes(H,T),write_term(Term,Options)).
301
302
303optional_layout_text -->
304 ( parsing -> greedy(layout_text) ; [] ).
305
306
307layout_text -->
308 comment(_).
309layout_text -->
310 layout_char(_).
311
312
(Var) :-
314 var(Var),
315 !,
316 fail.
317is_comment('tidylog %full'(_)).
318is_comment('tidylog %multi'(_)).
319
320
(Comment) -->
322 aol_comment(Comment).
323comment(Comment) -->
324 ml_comment(Comment).
325
326
327name_token(A) -->
328 name(A).
329name_token(A) -->
330 text(atom, A).
331name_token(A) -->
332 punctuation(A).
333
334
335alpha_num_seq_char([A|L]) -->
336 alpha_num_char(A),
337 alpha_num_seq_char(L).
338alpha_num_seq_char([]) -->
339 [].
340
341
342variable_token(V) -->
343 anonymous_variable(V).
344variable_token(V) -->
345 named_variable(V).
346
347anonymous_variable(`_`) -->
348 "_".
349
350named_variable([0'_,A|S]) -->
351 "_",
352 alpha_num_char(A),
353 alpha_num_seq_char(S).
354named_variable([C|S]) -->
355 capital_letter_char(C),
356 alpha_num_seq_char(S).
357
358
359type_char(Type,C) -->
360 [C],
361 { code_type(C,Type) }.
362
363alpha_num_char(C) -->
364 type_char(alnum,C).
365alpha_num_char(0'_) -->
366 "_".
367
368
369layout_char(C) -->
370 type_char(space,C).
371
372
373capital_letter_char(C) -->
374 type_char(upper,C).
375
376
377is_operator(Op) :-
378 atom(Op),
379 current_op(_,_,Op).
380
381infix_operator(Op,P,LeftP,RightP) :-
382 current_op(P,Spec,Op),
383 Op \= '.',
384 ( Spec = xfx ->
385 LeftP is P-1,
386 RightP is P-1
387 ; Spec = xfy ->
388 LeftP is P-1,
389 RightP is P
390 ; Spec = yfx ->
391 LeftP is P,
392 RightP is P-1
393 ).
394
395postfix_operator(Op,P,LeftP) :-
396 current_op(P,Spec,Op),
397 ( Spec = xf ->
398 LeftP is P-1
399 ; Spec = yf ->
400 LeftP is P
401 ).
402
403prefix_operator(Op,P,RightP) :-
404 current_op(P,Spec,Op),
405 ( Spec = fx ->
406 RightP is P-1
407 ; Spec = fy ->
408 RightP is P
409 ).
410
411
412nl -->
413 "\n".
414
415indent -->
416 " ".