1:- module(parser, []). 2
3:- use_module(library(yall)). 4:- use_module(library(clpfd)). 5:- use_module(library(lists), [append/3, member/2]). 6:- use_module(library(option), [merge_options/3, option/2, option/3]). 7:- use_module(library(apply), [maplist/2]). 8
9:- use_module(plammar/util). 10:- use_module(plammar/environments). 11:- use_module(plammar/library_operators). 12
13%:- style_check(-singleton).
14
15is_priority(P) :-
16 P #>= 0,
17 P #=< 1201.
18
19is_operator(Op0, Options) :-
20 Op0 = op(Prec, Spec, Name0),
21 % remove leading space if present
22 ( atom_concat(' ', Name, Name0) ; Name = Name0 ), !,
23 Op = op(Prec, Spec, Name),
24 Prec #>= 0,
25 Prec #=< 1200, % strictly less than 1201
26
27 % get relevant options
28 option(specified_operators(Specified_Operators), Options, _),
29 option(operators(Operators), Options, []),
30 option(targets(Targets), Options, []),
31 option(infer_operators(Inferred_Ops), Options, no),
32 option(disallow_operators(Disallow_Operators), Options, []),
33
34 ( % Option I: it is part of the specified_operators(_) option
35 % of operators given in the source code
36 open_member(Op, Specified_Operators)
37 ; % Option II: it is part of the operators(_) option
38 member(Op, Operators)
39 ; % Option III: it is part of the operators defined in the target
40 Targets = [Target], %% TODO: Support more than one target, e.g.
41 %% `targets([swi,gnu])`, to throw warnings
42 %% for operators that are not defined in
43 %% all target systems
44 target_ops(Target, Target_Ops),
45 member(Op, Target_Ops)
46 ; % Option IV: operators should be inferred
47 Inferred_Ops \== no,
48 memberchk(Op, Inferred_Ops)
49 ),
50 % must not be in `disallow_operators` option
51 \+ member(Op, Disallow_Operators).
52
53not_operator(Op0, Options) :-
54 Op0 = op(Prec, Spec, Name0),
55 56 ( atom_concat(' ', Name, Name0) ; Name = Name0 ), !,
57 Op = op(Prec, Spec, Name),
58
59 60 option(specified_operators(Specified_Operators), Options, _),
61 option(operators(Operators), Options, []),
62 option(targets(Targets), Options, []),
63 option(infer_operators(Inferred_Ops), Options, no),
64
65 ( 66 67 not_member(Op, Specified_Operators)
68 , 69 \+ member(Op, Operators)
70 , 71 \+ (Targets = [Target], target_ops(Target, Target_Ops), member(Op, Target_Ops))
72 , 73 ( Inferred_Ops == no ; not_member(Op, Inferred_Ops))
74 ).
75
76
77not_member(_, Ys) :-
78 var(Ys), !.
79not_member(_, []).
80not_member(X, [Y|Ys]) :-
81 X \= Y,
82 not_member(X, Ys).
83
84open_member(X, Xs) :-
85 nonvar(Xs),
86 Xs = [X|_],
87 !.
88open_member(X, [_|Xs]) :-
89 nonvar(Xs),
90 open_member(X, Xs),
91 !.
92
93
94principal_functor(term(_), indef).
95principal_functor(term(Spec, [_, op(Atom_Tree), _]), Atom) :-
96 member(Spec, [xfx, yfx, xfy]),
97 atom_tree(Atom, Atom_Tree).
98principal_functor(term(Spec, [_, op(Atom_Tree)]), Atom) :-
99 member(Spec, [yf, xf]),
100 atom_tree(Atom, Atom_Tree).
101principal_functor(term(Spec, [op(Atom_Tree), _]), Atom) :-
102 member(Spec, [fy, fx]),
103 atom_tree(Atom, Atom_Tree).
104
105atom_tree(Atom, atom(name(L))) :-
106 ( L = [name_token(Atom, _)]
107 ; L = [_, name_token(Atom, _)] ).
108
109atom_tree('[]', atom([open_list(_),close_list(_)])).
110atom_tree('{}', atom([open_curly(_),close_curly(_)])).
111
112atom_tree('|', ht_sep(_)).
113
114get_operators(Opts, Term_Tree) :-
115 ( Term_Tree = term(fx, [op(_), term(Term)]),
116 Term = [atom(name(Name)), open_ct(_), arg_list(Arg_List0), close(_)],
117 append(_, [name_token(Op, _)], Name) ->
118 ( Op = op ->
119 get_operator_from_term(Opts, term(Term))
120 ; Op = module,
121 Arg_List0 = [arg(_), comma(_), arg_list(arg(Arg1))],
122 123 Arg1 = term([open_list(_), Items, close_list(_)]) ->
124 get_operators_from_items(Opts, Items)
125 ; member(Op, [use_module, ensure_loaded]),
126 Arg_List0 = arg(term([atom(name(Name_List1)), open_ct(_), arg_list(Arg_List1), close(_)])),
127 ( Name_List1 = [Name_Token1] ; Name_List1 = [_, Name_Token1] ),
128 Name_Token1 = name_token(library, _),
129 ( Arg_List1 = arg(term(atom(name(Name_List2)))),
130 ( Name_List2 = [Name_Token2] ; Name_List2 = [_, Name_Token2] ),
131 Name_Token2 = name_token(Library_Name, _) ->
132 get_operators_from_library(Opts, Library_Name)
133 ; Arg_List1 = arg(term(yfx, [
134 term(atom(name(Name_List3))),
135 op(atom(name(Name_List2))),
136 term(atom(name(Name_List4)))
137 ])),
138 ( Name_List2 = [Name_Token2] ; Name_List2 = [_, Name_Token2] ),
139 Name_Token2 = name_token('/', _),
140 ( Name_List3 = [Name_Token3] ; Name_List3 = [_, Name_Token3] ),
141 Name_Token3 = name_token(Left, _),
142 ( Name_List4 = [Name_Token4] ; Name_List4 = [_, Name_Token4] ),
143 Name_Token4 = name_token(Right, _) ->
144 get_operators_from_library(Opts, Left/Right)
145 ; otherwise ->
146 true
147 )
148 ; otherwise ->
149 true
150 )
151 ; otherwise ->
152 true
153 ).
154
155get_operator_from_term(Opts, term(Term)) :-
156 ( Term = [atom(name(Name)), open_ct(_), arg_list(Arg_List0), close(_)],
157 append(_, [name_token(op, _)], Name),
158 Arg_List0 = [arg(Arg0), comma(_), arg_list(Arg_List1)],
159 Arg_List1 = [arg(Arg1), comma(_), arg_list(Arg_List2)],
160 Arg_List2 = arg(Arg2),
161 162 Arg0 = term(integer(Integer0)),
163 append(_, [integer_token(Prec_Atom, _)], Integer0),
164 atom_number(Prec_Atom, Prec),
165 166 Arg1 = term(atom(name(Name1))),
167 append(_, [name_token(Spec, _)], Name1),
168 169 Arg2 = term(atom(name(Name2))),
170 append(_, [name_token(Functor, _)], Name2)
171 ->
172 Op = op(Prec,Spec,Functor),
173 option(specified_operators(Open_List), Opts, _),
174 memberchk(Op, Open_List)
175 ; otherwise ->
176 true
177 ).
178get_operator_from_term(_Opts, term(_,_)).
179
180get_operators_from_items(Opts, items([arg(Arg), comma(_), Items])) :-
181 get_operator_from_term(Opts, Arg),
182 get_operators_from_items(Opts, Items).
183get_operators_from_items(Opts, items(arg(Arg))) :-
184 get_operator_from_term(Opts, Arg).
185
186get_operators_from_library(Opts, Library_Name) :-
187 ( library_operators(Library_Name, Ops) ->
188 maplist(set_operator_from_library(Opts), Ops)
189 ; otherwise ->
190 true
191 ).
192
193set_operator_from_library(Opts, Op) :-
194 option(specified_operators(Open_List), Opts, _),
195 memberchk(Op, Open_List).
196
197
199
200prolog(Opts, prolog(PT), A) :-
201 nonvar(A), !,
202 ( A = [shebang(PT_Shebang)|B] ->
203 PT0 = [shebang(PT_Shebang)]
204 ; otherwise ->
205 A = B,
206 PT0 = []
207 ),
208 *(p_text(Opts), PT_PText, B, C),
209 append(PT0, PT_PText, PT1),
210 ( C = [],
211 PT = PT1
212 ; C = [layout_text_sequence(_)],
213 append(PT1, C, PT)
214 ).
215
216prolog(Opts, prolog(PT), A) :-
217 nonvar(PT), !,
218 ( PT = [shebang(PT_Shebang)|PT0] ->
219 A = [shebang(PT_Shebang)|B]
220 ; otherwise ->
221 PT = PT0,
222 A = B
223 ),
224 ( append(PT_PText, [layout_text_sequence(LTS)], PT0),
225 C = [layout_text_sequence(LTS)]
226 ; C = [],
227 PT0 = PT_PText
228 ),
229 *(p_text(Opts), PT_PText, B, C).
230
231/*
232prolog(Opts) -->
233 *p_text(Opts).
234*/
235p_text(Opts, PT, A, C) :-
236 nonvar(A), !,
237 P #=< 1201,
238 term(P, Opts, Term_Tree, A, B),
239 B = [end(PT_End)|C],
240 principal_functor(Term_Tree, Principal_Functor),
241 ( Principal_Functor = (:-)
242 -> Tree_Name = directive_term,
243 get_operators(Opts, Term_Tree)
244 ; Tree_Name = clause_term ),
245 PT =.. [Tree_Name, [Term_Tree, end(PT_End)]].
246
247p_text(Opts, PT, A, C) :-
248 nonvar(PT), !,
249 PT =.. [Tree_Name, [Term_Tree, end(PT_End)]],
250 term(P, Opts, Term_Tree, A, B),
251 ( Tree_Name = directive_term ->
252 get_operators(Opts, Term_Tree)
253 ; otherwise ->
254 true
255 ),
256 B = [end(PT_End)|C],
257 % end_(Opts, end(PT_End), B, C),
258 P #=< 1201.
259
260end_(_Opts, end([end_token(end_char('.'))]), [name([name_token('.', graphic_token([graphic_token_char(graphic_char('.'))]))])|B], B).
261end_(_Opts, end([Layout_Text_Sequence,end_token(end_char('.'))]), [name([Layout_Text_Sequence,name_token('.', graphic_token([graphic_token_char(graphic_char('.'))]))])|B], B).
262
263
265
266:- discontiguous plammar:term/5. 267:- discontiguous plammar:term_/5. 268
270
272
273term_(0, _Opts) -->
274 [ integer(_) ].
275
276term_(0, _Opts) -->
277 [ float_number(_) ].
278
280
281term_(0, _Opts) -->
282 negative_sign_name
283 , [ integer(_) ].
284
285term_(0, _Opts) -->
286 negative_sign_name
287 , [ float_number(_) ].
294negative_sign_name(negative_sign_name(T), [T|Out], Out) :-
295 T = name(L),
296 Name_Token = name_token(
297 graphic_token([
298 graphic_token_char(
299 graphic_char('-')
300 )]
301 )
302 ),
303 append(Pre, [Name_Token], L),
304 ( Pre = []
305 ; Pre = [Layout_Text_Sequence], is_whitespace(Layout_Text_Sequence)).
306
307is_whitespace(A) :-
308 A = layout_text_sequence([_]).
309
311
312term_(0, Opts, term_(Atom_Tree), In, Out) :-
313 phrase(atom(Atom_Tree), In, Out),
314 atom_tree(Atom, Atom_Tree),
315 not_operator(op(_,_,Atom), Opts).
316
317term_(Prec, Opts, term_(Atom_Tree), In, Out) :-
318 option(allow_operator_as_operand(Allow_Operator_As_Operand), Opts, no),
319 ( no(Allow_Operator_As_Operand) ->
320 Prec = 1201
321 ; otherwise ->
322 Prec = 0
323 ),
324 phrase(atom(Atom_Tree), In, Out),
325 atom_tree(Atom, Atom_Tree),
326 once(is_operator(op(_,_,Atom), Opts)).
327
328atom -->
329 [ name(_) ].
330
331atom -->
332 [ open_list(_) ]
333 , [ close_list(_) ].
334
335atom -->
336 [ open_curly(_) ]
337 , [ close_curly(_) ].
338
340
341term_(0, _Opts) -->
342 [ variable(_) ].
343
345
346term_(0, Opts) -->
347 atom
348 , [ open_ct(_) ]
349 , arg_list(Opts)
350 , [ close(_) ].
351
352term_(0, Opts, term_([PT_Atom, open_ct(PT_Open_Ct), close(PT_Close)]), A, Z) :-
353 option(allow_compounds_with_zero_arguments(Allow_Compounds_With_Zero_Arguments), Opts, no),
354 yes(Allow_Compounds_With_Zero_Arguments),
355 atom(PT_Atom, A, B),
356 B = [open_ct(PT_Open_Ct), close(PT_Close)|Z].
357
358term_(0, Opts, term_(T), A, Z) :-
359 option(allow_variable_name_as_functor(Allow), Opts),
360 yes(Allow),
361 T = [variable(VT), open_ct(H),L|N],
362 A = [variable(VT), open_ct(H)|M],
363 arg_list(Opts, L, M, [close(Q)|Z]),
364 N = [close(Q)].
365
377arg_list(Opts, arg_list(Inner), A, Z) :-
378 nonvar(A),
379 arg(Opts, Arg, A, B),
380 ( B = Z,
381 Inner = Arg
382 ; B = [comma(Comma)|C],
383 arg_list(Opts, Arg_List, C, Z),
384 Inner = [ Arg, comma(Comma), Arg_List ]
385 ).
386arg_list(Opts, arg_list(arg(Arg)), A, Z) :-
387 nonvar(Arg),
388 arg(Opts, arg(Arg), A, Z).
389arg_list(Opts, arg_list([Arg, Comma, Arg_List]), A, Z) :-
390 nonvar(Arg),
391 arg(Opts, Arg, A, [Comma|B]),
392 arg_list(Opts, Arg_List, B, Z).
393
394/* 6.3.3.1 Arguments */
395
396arg(Opts0, arg(PT), In, Out) :-
397 nonvar(In)
398 , option(allow_arg_precedence_geq_1000(Allow_Arg_Precedence_Geq_1000), Opts0, no)
399 , ( no(Allow_Arg_Precedence_Geq_1000) ->
400 % ISO 6.3.3.1: Priority must be less than 1000
401 P #< 1000,
402 Opts = Opts0
403 ; otherwise ->
404 P #=< 1200,
405 merge_options([allow_comma_op(no)], Opts0, Opts)
406 )
407 , phrase(term(P, Opts, Term_Tree), In, Out)
408 , ( Term_Tree = term(Atom_Tree),
409 Atom_Tree = atom(_),
410 atom_tree(Atom, atom(Atom_Tree)),
411 once(is_operator(op(_,_,Atom), Opts0)) ->
412 PT = Atom_Tree
413 ; otherwise ->
414 PT = Term_Tree
415 ).
416
417% This is only needed for logical purity
418arg(Opts, arg(PT), In, Out) :-
419 nonvar(PT)
420 , option(allow_arg_precedence_geq_1000(Allow_Arg_Precedence_Geq_1000), Opts, no)
421 , ( no(Allow_Arg_Precedence_Geq_1000) ->
422 % ISO 6.3.3.1: Priority must be less than 1000
423 P #< 1000
424 ; otherwise ->
425 P #=< 1200
426 %% TODO: Do not allow comma at top-level to disambigue
427 %% terms like a(b :- c, d)
428 )
429 , ( functor(PT, atom, _) ->
430 phrase(atom(PT), In, Out),
431 atom_tree(Atom, PT),
432 once(is_operator(op(_,_,Atom), Opts))
433 ; functor(PT, term, _) ->
434 phrase(term(P, Opts, PT), In, Out)
435 ).
436
437
438/* 6.3.4 Compund terms - operator notation */
439
440/* 6.3.4.1 Operand */
441
442%% Note that we do not distinguish between
443%% `term` and `lterm` to avoid trivial
444%% non-termination because of left-recursion
445/*
446term_(0, Opts) -->
447 [ open(_) ]
448 , term(P, Opts)
449 , [ close(_) ]
450 , { P #=< 1201 }.
451
452term_(0, Opts) -->
453 [ open_ct(_) ]
454 , term(P, Opts)
455 , [ close(_) ]
456 , { P #=< 1201 }.
457*/
458term_(0, Opts0, term_(Inner), A, Z) :-
459 member(Open_Symbol, [open, open_ct]),
460 Opening =.. [Open_Symbol, _Open_Tree],
461 Inner = [Opening, Term_Tree, close(Close_Tree)],
462 A = [Opening|B],
463 merge_options([allow_comma_op(yes)], Opts0, Opts),
464 term(P, Opts, Term_Tree, B, C),
465 C = [close(Close_Tree)|Z],
466 P #=< 1201.
467
469
470:- op(300, xfx, '@'). 471
472term(P, Opts, Res, A, Z) :-
473 nonvar(A),
474 term_(Term1_P, Opts, term_(Term1_Tree_), A, B),
475 lterm(Opts, term(Term1_Tree_)@Term1_P, Res@P, B, Z).
476
477term(P, Opts, Res, A, Z) :-
478 nonvar(A),
479 op(Op_P, Type, Opts, Op_Tree, A, B),
480 481 B \= [open_ct(_)|_],
482 spec_class(Type, prefix),
483 prec_constraints(Type, Op_P, P_Term),
484 term(P_Term, Opts, Term_Tree, B, C),
485 lterm(Opts, term(Type, [Op_Tree, Term_Tree])@Op_P, Res@P, C, Z).
486
487lterm(_Opts, Term_Tree@P, Term_Tree@P, A, A).
488
489lterm(Opts, Term1_Tree@Term1_P, Res@P, A, Z) :-
490 op(Op_P, Type, Opts, Op_Tree, A, B),
491 ( spec_class(Type, infix),
492 prec_constraints(Type, Op_P, Term1_P, Term2_P),
493 term(Term2_P, Opts, Term2_Tree, B, C),
494 lterm(Opts, term(Type, [Term1_Tree, Op_Tree, Term2_Tree])@Op_P, Res@P, C, Z)
495 ; spec_class(Type, postfix),
496 prec_constraints(Type, Op_P, Term1_P),
497 lterm(Opts, term(Type, [Term1_Tree, Op_Tree])@Op_P, Res@P, B, Z) ).
498
499term(0, Opts, Res, A, Z) :-
500 nonvar(Res),
501 ( Res = term(Inner),
502 term_(_, Opts, term_(Inner), A, Z)
503 ; Res = term(Type, [Term_Tree1, Op_Tree, Term_Tree2]),
504 term(_P_Term1, Opts, Term_Tree1, A, B),
505 op(_P_Op, Type, Opts, Op_Tree, B, C),
506 term(_P_Term2, Opts, Term_Tree2, C, Z)
507 ; Res = term(Type, [Term_Tree, Op_Tree]),
508 member(Type, [xf, yf]),
509 term(_P_Term, Opts, Term_Tree, A, B),
510 op(_P_Op, Type, Opts, Op_Tree, B, Z)
511 ; Res = term(Type, [Op_Tree, Term_Tree]),
512 member(Type, [fx, fy]),
513 op(_P_Op, Type, Opts, Op_Tree, A, B),
514 term(_P_Term, Opts, Term_Tree, B, Z)
515 ).
516
517prec_constraints(xfx, P_Op, P_Term1, P_Term2) :-
518 P_Term1 #< P_Op,
519 P_Term2 #< P_Op.
520prec_constraints(yfx, P_Op, P_Term1, P_Term2) :-
521 P_Term1 #=< P_Op,
522 P_Term2 #< P_Op.
523prec_constraints(xfy, P_Op, P_Term1, P_Term2) :-
524 P_Term1 #< P_Op,
525 P_Term2 #=< P_Op.
526prec_constraints(xf, P_Op, P_Term) :-
527 P_Term #< P_Op.
528prec_constraints(yf, P_Op, P_Term) :-
529 P_Term #=< P_Op.
530prec_constraints(fx, P_Op, P_Term) :-
531 P_Term #< P_Op.
532prec_constraints(fy, P_Op, P_Term) :-
533 P_Term #=< P_Op.
534
536
537op(P, Spec, Opts, op(Atom_Tree), In, Out) :-
538 phrase(atom(Atom_Tree), In, Out)
539 , atom_tree(Atom, Atom_Tree)
540 , is_operator(op(P, Spec, Atom), Opts).
545op(1000, xfy, Opts, op(comma(A)), [comma(A)|B], B) :-
546 option(allow_comma_op(Allow_Comma_Op), Opts, yes)
547 , yes(Allow_Comma_Op).
548
549op(P, Spec, Opts, op(ht_sep(A)), [ht_sep(A)|B], B) :-
550 is_operator(op(P, Spec, '|'), Opts).
551
553
554term_(0, Opts) -->
555 [ open_list(_) ]
556 , items(Opts)
557 , [ close_list(_) ].
558
560items(Opts) -->
561 arg(Opts)
562 , [ comma(_) ]
563 , items(Opts).
564
566items(Opts) -->
567 arg(Opts)
568 , [ ht_sep(_) ]
569 , arg(Opts).
570
572items(Opts) -->
573 arg(Opts).
574
576
578term_(0, Opts) -->
579 [ open_curly(_) ]
580 , term(_P, Opts)
581 , [ close_curly(_) ].
582
584
585term_(0, _Opts) -->
586 [ double_quoted_list(_) ].
587
588
590
592term_(0, _Opts) -->
593 [ back_quoted_string(_) ].
594
596
598term_(0, Opts, term_([Tag, Open_Curly, close_curly(PT_Close_Curly)]), A, Z) :-
599 option(dicts(Dicts), Opts, no),
600 yes(Dicts),
601 Open_Curly = open_curly([open_curly_token(open_curly_char('{'))]),
602 A = [Tag, Open_Curly, close_curly(PT_Close_Curly)|Z],
603 604 member(Tag, [name(_), variable(_)]).
605
607term_(0, Opts, term_([Tag, Open_Curly, PT_Key_Value_List, close_curly(PT_Close_Curly)]), A, Z) :-
608 option(dicts(Dicts), Opts, no),
609 yes(Dicts),
610 Open_Curly = open_curly([open_curly_token(open_curly_char('{'))]),
611 A = [Tag, Open_Curly|B],
612 key_value_list(Opts, PT_Key_Value_List, B, C),
613 C = [close_curly(PT_Close_Curly)|Z],
614 615 member(Tag, [name(_), variable(_)]).
616
617key_value_list(Opts) -->
618 key_value(Opts).
619
620key_value_list(Opts) -->
621 key_value(Opts)
622 , [ comma(_) ]
623 , key_value_list(Opts).
624
625key_value(Opts, key_value([PT_Key, name(PT_Colon), PT_Arg]), A, Z) :-
626 627 ( atom(PT_Key, A, B)
628 ; A = [PT_Key|B],
629 PT_Key = integer(_)
630 ),
631 B = [name(PT_Colon)|C],
632 ( PT_Colon = [PT_Colon_Name_Token] ; PT_Colon = [_LTS, PT_Colon_Name_Token] ),
633 PT_Colon_Name_Token = name_token(':', graphic_token([graphic_token_char(graphic_char(':'))])),
634 arg(Opts, PT_Arg, C, Z)